9
$\begingroup$

For my math class I am trying to recreate a mathematical GIF. Here is the GIF I wish to make:

the GIF At this point I think I have a 3D function that would work to lay the hexagons on to.

Manipulate[Show[ParametricPlot3D[{t Cos[s], Cos[a - t] Sinc[t], t Sin[s]}, {t, 0, 5}, {s, 0, 2 Pi}, PlotRange -> All], PlotRange -> All], {a, 0 , 2 Pi}]

While this might not be the perfect function but I think it will work. The next step is getting the hexagons to lay on the surface as it moves.

What would be the best way to have the hexagon on the surface? A quick clarification. I want to know how to get the hexagons on to the surface I will turn it in to a real GIF once I get that to work.

$\endgroup$
  • $\begingroup$ You could define plane hexagons and move the vertices vertically according to your function. $\endgroup$ – Yves Klett Oct 15 '14 at 14:53
  • 1
    $\begingroup$ possible duplicate of Rotating 3DPlot into animated gif $\endgroup$ – Öskå Oct 15 '14 at 14:57
  • $\begingroup$ Thank you Yves. I will try to do this. $\endgroup$ – Andrew Mueller Oct 15 '14 at 15:09
  • $\begingroup$ Related 27202 $\endgroup$ – xyz Oct 15 '14 at 15:09
  • 3
    $\begingroup$ I do not agree that this is a duplicate of that other post. The question is What would be the best way to have the hexagon on the surface? not How can I animate this function? $\endgroup$ – C. E. Oct 15 '14 at 17:35
16
$\begingroup$

an approach using graphics primitives:

 rmax = 10;
 na=100;
 p=Select[Flatten[Table[Partition[
     Table[ {Sin[#],Cos[# ]}&@ (n Pi/3) +
       {Sqrt[3](1+2 j +  Boole[EvenQ[i]]),3i}/2+{0,0},
                      {n,2,5}],2,1],
            {i,-rmax,rmax},{j,-rmax,rmax}],2], Max[Norm/@#]<rmax&];
 cf[x_] := Hue[ 2/3 (1-Exp[-5 (Norm[x]-1)/rmax])]
 df[a_,x_]:=  (2 Cos[a-#/2] Sinc[#/4]&@(10 Norm[x]/rmax))
 Export["test.gif",z=Table[
   Graphics3D[{Thick,Rotate[Line[ Append[#,df[4 Pi a/na,#]]&/@# , 
                        VertexColors->cf/@ #],2 Pi a/na,{0,0,1}] }&/@p,
              PlotRange->{{-rmax,rmax},{-rmax,rmax},{-2,2}},Boxed->False],{a,1,na}]]

enter image description here

$\endgroup$
  • $\begingroup$ +1. But now colour your lines according to the (dynamic) height. $\endgroup$ – wxffles Oct 15 '14 at 21:51
  • 1
    $\begingroup$ Thank you now that is exactly what I was looking for. Any chance you could explain what that code is doing? Beyond the rotation I do not understand what the codes say. $\endgroup$ – Andrew Mueller Oct 16 '14 at 3:13
  • $\begingroup$ p is a 2d grid of lines and we simply Append a third coordinate according to the function. To use the same function for the color define cf something like cf[a_,x_]:=Hue[ scale df[a,x] ] and do VertexColors->cf[a,#]&/@ # &] $\endgroup$ – george2079 Oct 16 '14 at 11:36
  • $\begingroup$ note this is inefficiently computing the displacement separately for each segment end (ie 3 times for each vertex). It shouldn't be too much trouble to fix that if performance is an issue. $\endgroup$ – george2079 Oct 16 '14 at 11:40
11
$\begingroup$

Here is my version. I took the function df from george2079's answer.

nodes = Nest[DeleteDuplicates@Flatten[Table[# + 2 Cos[Pi/6] {Cos[theta], Sin[theta]}, {theta, Pi/6, 2 Pi, Pi/3}] & /@ #, 1] &, {{0, 0}}, 8];
edges = Table[# + {Cos[theta], Sin[theta]}, {theta, 0, 2 Pi, Pi/3}] & /@ nodes;
edges3D[t_] := MapAt[{First@#, Last@#, df[t, Norm@#]} &, edges, {All, All}]
linePrimitives[t_] := Map[Line[#, VertexColors -> {cf[#[[1, 3]]/2 // N], cf[#[[2, 3]]/2]} // N] &, Map[Partition[#, 2, 1] &, edges3D[t]], {2}];

cf[x_] := Blend[{RGBColor[0, 1, 1], Blue, Green}, Abs@x]

Manipulate[
 Graphics3D[
  linePrimitives[t], PlotRange -> {{-10, 10}, {-10, 10}, {-2, 2}}, 
  Boxed -> False, Background -> Black
  ], {t, 0, 2 Pi}]

Animation

To understand what each line does I recommend executing the following lines:

(* The centers of the hexagons. *)
Point@nodes // Graphics
(* The points at the corner of the hexagons. *)
ListLinePlot[edges, AspectRatio -> 1]

The third line adds the corresponding z value to each pair of x and y values.

The last line is there to divvy up the coordinates of the edges so that I can recast them in the format Line[pt1,pt2,VertextColors-> colors depending on z values], and to do that (there are two Map.)

$\endgroup$
3
$\begingroup$

Replace Manipulate to Table to generate many picture;

gif = Table[
   Show[ParametricPlot3D[{t Cos[s], Cos[a - t] Sinc[t], t Sin[s]}, {t,
   0, 5}, {s, 0, 2 Pi}, PlotRange -> All], PlotRange -> All], {a, 0, 2 Pi, .1}];
 Export["a.gif", gif]

Animation

$\endgroup$
  • $\begingroup$ Fixing the plotrange might give an even better animation. Still +1 $\endgroup$ – Ajasja Oct 15 '14 at 15:04
  • $\begingroup$ gif = Table[ Show[ParametricPlot3D[{t Cos[s], Cos[a - t] Sinc[t], t Sin[s]}, {t, 0, 5}, {s, 0, 2 Pi}, PlotRange -> All], PlotRange -> {{-5, 5}, {-3, 3}, {-5, 5}}], {a, 0, 2 Pi, .1}];Export["a.gif", gif] $\endgroup$ – xyz Oct 15 '14 at 15:04
  • $\begingroup$ @Pickett,The size of gif file was bigger than 2M,BTW, how to restrict the size of the file that be exported? $\endgroup$ – xyz Oct 15 '14 at 15:07
  • 2
    $\begingroup$ The Last time I had to reduce gif size I used gifsicle lcdf.org/gifsicle $\endgroup$ – Ajasja Oct 15 '14 at 15:16
  • $\begingroup$ I tried using gifsicle (through the program ImageOptim, which uses it), however that didn't help much in this case. So I simply reduced the number of frames by two, i.e. changed 0.1 to 0.2 in Table. $\endgroup$ – C. E. Oct 15 '14 at 15:48

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.