Tell me more ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.
up vote 14 down vote favorite
11

How to generate a picture like this? I'd like the surface of the manifold to randomly distort.

share|improve this question
Apparently this is from Patakk's Tumblr blog. – Rahul Narain Dec 15 '12 at 23:27
next challenge could be to reproduce the whole page patakk.tumblr.com/tagged/gif ;-) keep us busy for a little while, not to mention copyright! – chris Dec 16 '12 at 8:52

2 Answers

up vote 30 down vote accepted 
Needs["PolyhedronOperations`"]
poly = Geodesate[PolyhedronData["Dodecahedron", "Faces"], 4];

amplitude = 0.15;
twist = 4;
verts = poly[[1]];
faces = poly[[2]];
phases = RandomReal[2 Pi, Length[verts]];
newverts[t_] := 
  MapIndexed[{Sequence @@ (RotationMatrix[twist Last[#1]].Most[#1]), 
      Last[#1]} (1 + amplitude Sin[t + phases[[First@#2]]]) &, 
   verts];
newpoly[t_] := GraphicsComplex[newverts[t], faces];

duration = 1.5;
fps = 24;
frames = Most@
   Table[Graphics3D[{EdgeForm[], newpoly[t]}, 
     PlotRange -> Table[{-(1 + amplitude), (1 + amplitude)}, {3}], 
     ViewPoint -> Front, Background -> Black, Boxed -> False], {t, 0, 
     2 Pi, 2 Pi/(duration fps)}];
ListAnimate[frames, fps]

enter image description here

The next thing you need is global illumination, but Mathematica doesn't have that as far as I know.

share|improve this answer
Nice :) If anyone's interested, "RedBlueTones" or "ThermometerColors" will provide a decent approximation to the original colors. Choosing the color (from this palette) for each face based on the azimuthal angle might work. – rm -rf♦ Dec 16 '12 at 0:49
Adding something like Lighting -> {{"Point", RGBColor[255/255, 89/255, 126/255], {-2, -1, -0.5}}, {"Point", RGBColor[88/255, 210/255, 220/255], {2, -0.5, 0.5}}} gives better lighting and maybe add some gray light. – jenson Dec 16 '12 at 7:32
quite nice! How did you upload the movie? – chris Dec 16 '12 at 8:49
@chris I used Export["ani.gif", frames, "DisplayDurations" -> 0.05]. If you literally mean upload there is an image button in the editor window toolbar which will let you select between uploading an image from your machine and using a URL. – Mr.Wizard♦ Dec 16 '12 at 8:58
1  
A nice integration of POV-ray into Mathematica workflow would push the limits of this rendering – P. Fonseca Dec 16 '12 at 15:36
up vote 4 down vote

This is a starter

dat = Table[x^2 + y^2 + z^2, {x, -1, 1, 0.125}, {y, -1, 1, 0.125}, {z, -1, 1,  0.125}];

plots = Table[
noise = RandomVariate[NormalDistribution[0, 0.05], Dimensions[dat]];
Do[noise[[All, All, i]] *= 2, {i, 2, Length[noise] - 1, 2}];
ListContourPlot3D[dat + noise, Contours -> 1/2, Mesh -> False, 
Boxed -> False, Axes -> False, ContourStyle -> White ], {25}];

Export["test.gif", plots]

Mathematica graphics

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.