38
$\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$
3
  • 2
    $\begingroup$ Apparently this is from Patakk's Tumblr blog. $\endgroup$
    – user484
    Dec 15, 2012 at 23:27
  • 1
    $\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, 2012 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, 2017 at 16:23

2 Answers 2

66
$\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$
5
  • 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, 2012 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, 2012 at 7:32
  • $\begingroup$ quite nice! How did you upload the movie? $\endgroup$
    – chris
    Dec 16, 2012 at 8:49
  • 2
    $\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, 2012 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, 2012 at 15:36
9
$\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 and acknowledge you have read our privacy policy.

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