How to generate a picture like the following (from Paolo Čerić's blog)? I'd like the surface of the manifold to randomly distort.
$\begingroup$
$\endgroup$
3
-
2$\begingroup$ Apparently this is from Patakk's Tumblr blog. $\endgroup$– user484Dec 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$– chrisDec 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$– anderstoodAug 11, 2017 at 16:23
Add a comment
|
2 Answers
$\begingroup$
$\endgroup$
5
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.
-
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_boDec 16, 2012 at 7:32 -
-
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$ 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$ Dec 16, 2012 at 15:36
$\begingroup$
$\endgroup$
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]
