I was able to run it just now and it looks good. Thanks, Brad! Unfortunately I'm not enough of a Mathematica-wizard to modify Brad's code to give me what I want, namely, a morphing tessellation. I need the visuals to convey the sense that the pattern repeats throughout the whole plane. Jim On Fri, Aug 2, 2019 at 6:57 PM James Propp <jamespropp@gmail.com> wrote:
Thanks! I won’t have access to Mathematica till tomorrow, but I look forward to trying it out.
Jim
On Fri, Aug 2, 2019 at 5:16 PM Brad Klee <bradklee@gmail.com> wrote:
2D Intersection of (1,1,1) plane with unit cell and nearest neighbors:
TriVerts = Sqrt[3] {Sin[2 Pi #/3], Cos[2 Pi #/3]} & /@ Range[3];
poly[time_, or_] := Switch[{time >= 1/3, time <= -1/3}, {True, _}, Polygon[or + # & /@ (TriVerts (1 - time))], {_, True}, Polygon[or + # {1, -1} & /@ (TriVerts (time + 1))], {_, _}, Polygon[{}]]
G[t_] := Graphics[{EdgeForm[Thick], {ColorData["TemperatureMap"][t/2], poly[1/3 + (2/3) t, {0, 0}], poly[1/3 + (2/3) t, {2, 0}], poly[1/3 + (2/3) t, {1, Sqrt[3]}]}, {ColorData["TemperatureMap"][1/2 + t/2], poly[-1 + (2/3) t, {1, -Sqrt[3]/3}], poly[-1 + (2/3) t, {2, 2 Sqrt[3]/3}], poly[-1 + (2/3) t, {0, 2 Sqrt[3]/3}]}, ColorData["TemperatureMap"][1 - t], Polygon[{ poly[1/3 + (2/3) t, {0, 0}][[1, 1]], poly[1/3 + (2/3) t, {0, 0}][[1, 3]], poly[1/3 + (2/3) t, {1, Sqrt[3]}][[1, 2]], poly[1/3 + (2/3) t, {1, Sqrt[3]}][[1, 1]], poly[1/3 + (2/3) t, {2, 0}][[1, 3]], poly[1/3 + (2/3) t, {2, 0}][[1, 2]]}]}, PlotRange -> {{-2, 4}, {-2, 3}}]
ListAnimate[G[#/100] & /@ Range[0, 100]]
On Wed, Jul 31, 2019 at 7:11 AM James Propp <jamespropp@gmail.com> wrote:
Can anyone dash off such a video?
_______________________________________________ math-fun mailing list math-fun@mailman.xmission.com https://mailman.xmission.com/cgi-bin/mailman/listinfo/math-fun