# How to generate a picture like this?

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

-
 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

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]


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

-
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
A nice integration of POV-ray into Mathematica workflow would push the limits of this rendering – P. Fonseca Dec 16 '12 at 15:36

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]
`

-