33
$\begingroup$

How to generate a picture like the following (from Paolo Čerić's blog)? I'd like the surface of the manifold to randomly distort.

animation

$\endgroup$
  • 2
    $\begingroup$ Apparently this is from Patakk's Tumblr blog. $\endgroup$ – Rahul Dec 15 '12 at 23:27
  • $\begingroup$ 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! $\endgroup$ – chris Dec 16 '12 at 8:52
  • $\begingroup$ @chris Regarding copyright issues, from the blog: "My work is licensed under a Creative Commons Attribution-NonCommercial-ShareAlike 3.0 Unported License" $\endgroup$ – anderstood Aug 11 '17 at 16:23
60
$\begingroup$
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.

$\endgroup$
  • 1
    $\begingroup$ 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. $\endgroup$ – rm -rf Dec 16 '12 at 0:49
  • 1
    $\begingroup$ 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. $\endgroup$ – jens_bo Dec 16 '12 at 7:32
  • $\begingroup$ quite nice! How did you upload the movie? $\endgroup$ – chris Dec 16 '12 at 8:49
  • 1
    $\begingroup$ @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. $\endgroup$ – Mr.Wizard Dec 16 '12 at 8:58
  • 2
    $\begingroup$ A nice integration of POV-ray into Mathematica workflow would push the limits of this rendering $\endgroup$ – P. Fonseca Dec 16 '12 at 15:36
8
$\begingroup$

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

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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