How to plot a figure like this - Mathematica Stack Exchange most recent 30 from mathematica.stackexchange.com 2019-09-22T05:04:41Z https://mathematica.stackexchange.com/feeds/question/38076 https://creativecommons.org/licenses/by-sa/4.0/rdf https://mathematica.stackexchange.com/q/38076 24 How to plot a figure like this xslittlegrass https://mathematica.stackexchange.com/users/1364 2013-11-30T20:53:17Z 2015-07-20T20:41:37Z <p>I saw a beautiful figure illustrating the optical lattice clock, and would like to make a similar one.</p> <p>This is the figure (taken from <a href="http://www.nature.com/nphoton/journal/v5/n4/covers/index.html">here</a>)</p> <p><img src="https://i.stack.imgur.com/2kZ2P.gif" alt="enter image description here"></p> <p>Is it possible to make a similar one using Mathematica?</p> <p>Here is my try:</p> <pre><code>Show[ Plot3D[0.05 (Cos[3 x] Cos[ 3 y])^4, {x, -\[Pi], \[Pi]}, {y, -\[Pi], \[Pi]}, PlotRange -&gt; {All, All, {-0.1, 0.1}}, PlotPoints -&gt; 200, Mesh -&gt; 60, MeshStyle -&gt; Gray, ColorFunction -&gt; (ColorData["GreenPinkTones"][0.5 #3 + 0.5] &amp;)], Graphics3D[{Darker[Green], Scale[Sphere[{0, 0, -0.5}], 0.25 {\[Pi]/3, \[Pi]/3, .1}, {0, 0, 0}]}, Lighting -&gt; "Neutral"], ImageSize -&gt; {651.1743427005708`, 484.8`}, Lighting -&gt; "Neutral", Method -&gt; {"RotationControl" -&gt; "Globe", "RotationControl" -&gt; "Globe"}, PlotRange -&gt; {All, All, {-0.1`, 0.1`}}, PlotRangePadding -&gt; {Automatic, Automatic, Automatic}, ViewAngle -&gt; 0.13079882249358044`, ViewCenter -&gt; {{0.5`, 0.5`, 0.5`}, {0.5218420229698426`, 0.6543497570242808`}}, ViewPoint -&gt; {-2.144844931539977`, 1.84186142553857`, -1.8593511526229505`}, ViewVertical -&gt; {0.`, 0.`, -1.`}] </code></pre> <p><img src="https://i.stack.imgur.com/Ht29K.png" alt="enter image description here"></p> https://mathematica.stackexchange.com/questions/38076/-/38082#38082 22 Answer by Kuba for How to plot a figure like this Kuba https://mathematica.stackexchange.com/users/5478 2013-11-30T22:45:49Z 2013-11-30T23:22:19Z <p>My pc is rather old so there was not much I could do. Maybe no as pretty as in the link but I'm happy because of the result:</p> <pre><code>r = 35; p = Show[ Plot3D[-Sum[2 Exp[-((x - xo)^2 + (y - yo)^2)], {xo, -24, 8, 4}, {yo, -28, 8, 4}], {x, -r, r - 4}, {y, -r, r - 4}, Evaluated -&gt; True, PlotRange -&gt; All, PlotPoints -&gt; 200, Mesh -&gt; 300, ImageSize -&gt; 800, ColorFunction -&gt; (Blend[{White, White, White, Purple}, -#3] &amp;), ColorFunctionScaling -&gt; False, MeshStyle -&gt; Directive[Thick, GrayLevel@.4] ], Graphics3D[{Specularity[White, 15], Green, Sphere[{{-4, -4, .2}, {4, 4, .2}, {0, 8, .2}}, 1]} ], BoxRatios -&gt; Automatic, Boxed -&gt; False, Axes -&gt; False, Lighting -&gt; "Neutral", ViewVector -&gt; {{10, 20, 11}, {0, 0, 0}}, ViewAngle -&gt; .5]; p = ImageResize[Rasterize[p, "Image", ImageResolution -&gt; 3 72], Scaled[1/3]] </code></pre> <p>manual blurring :)</p> <pre><code>Table[ImageTake[p, {799 - i, 800 - i}, All] ~ Blur ~ (i/100), {i, 0, 798,2}] // Reverse // Transpose[{#}] &amp; // ImageAssemble </code></pre> <p><img src="https://i.stack.imgur.com/8QcSu.png" alt="enter image description here"> </p> <p>I decided to not play with shadows because there is no easy way and my pc nearly died :)</p> https://mathematica.stackexchange.com/questions/38076/-/38083#38083 13 Answer by Sjoerd C. de Vries for How to plot a figure like this Sjoerd C. de Vries https://mathematica.stackexchange.com/users/57 2013-11-30T23:07:59Z 2013-11-30T23:24:05Z <p>I noticed in the original picture that the raster looks like it's painted on a rubber membrane which is stretched. You can create this effect by using <code>Texture</code>:</p> <pre><code>img = Image[ Graphics[ { Blue, Thickness[0.001], Table[Line[{{i, 0}, {i, 100}}], {i, 0, 100, 1}], Table[Line[{{0, i}, {100, i}}], {i, 0, 100, 1}] }, PlotRangePadding -&gt; 0 ], ImageSize -&gt; 2000, ImageResolution -&gt; 2000]; Show[ ParametricPlot3D[ {u, v, -2 Cos[2 u]^4 Cos[2 v]^4}, {u, 0.25 \[Pi], 3.25 Pi}, {v,0.25 \[Pi], 3.25 \[Pi]}, PlotStyle -&gt; Directive[Specularity[White, 100], Texture[img]], TextureCoordinateFunction -&gt; ({#1, #2} &amp;), Lighting -&gt; "Neutral", Mesh -&gt; None, PlotRange -&gt; All, PlotPoints -&gt; 300, Boxed -&gt; False, Axes -&gt; None], Graphics3D[ {Green, Sphere[{#1 \[Pi]/2, #2 \[Pi]/2, 0.2}, .5] &amp; @@@ RandomChoice[Flatten[Table[{i, j}, {i, 5}, {j, 5}], 1], 10] }], ImageSize -&gt; 1200, ViewPoint -&gt; {1/2, 1/2, 1/2} ] </code></pre> <p><img src="https://i.stack.imgur.com/wdmEP.jpg" alt="Mathematica graphics"></p> <p><img src="https://i.stack.imgur.com/bwQSJ.png" alt="enter image description here"></p> https://mathematica.stackexchange.com/questions/38076/-/88700#88700 0 Answer by Narasimham for How to plot a figure like this Narasimham https://mathematica.stackexchange.com/users/19067 2015-07-20T20:41:37Z 2015-07-20T20:41:37Z <p>Would n't the simple egg-crate suffice?</p> <blockquote> <p>Plot3D[- Sin[x]^4 Sin[y]^4, {x, -3 Pi, 3 Pi }, {y, -2 Pi, 2 Pi },<br> PlotRange -> {-5, 5}, Mesh -> {80, 80}, Axes -> None, Boxed -> False, PlotStyle -> Yellow]</p> </blockquote>