7
$\begingroup$

For a project I need to make a little animation showing what happens when you put two hexagonal lattices on top of each other and rotate one of them(Moiré pattern), and my advisor sugested using Mathematica, as I need this for other parts of the project. I wrote a simple code that does what I want, but it is very slow, and it is just crashing if I scale up the size of lattices/number of frames. Any suggestions on how to make this run more smoothly?

cell[x_, y_] := {Gray, Line[{{x, y}, {x, y + 2/3 Sin[120 Degree]}}], 
Line[{{x, y}, {x + Cos[30 Degree]/2, y - Sin[30 Degree]/2}}], 
Line[{{x, y}, {x - Cos[30 Degree]/2, y - Sin[30 Degree]/2}}], Red, 
Disk[{x, y}, 0.1], Blue, Disk[{x, y + 2/3* Sin[120 Degree]}, 0.1]}
unitvecA = {Cos[120 Degree], Sin[120 Degree]}
unitvecB = {1, 0}
sheet = Table[cell @@ (unitvecA i + unitvecB j), {i, 1, 12}, {j, Ceiling[i/2], Ceiling[i/2] + 12}]
ListAnimate[Table[Graphics[{Rotate[sheet, x], sheet}], {x, 0, Pi, Pi/10}]]
$\endgroup$
2

1 Answer 1

12
$\begingroup$

Two things come to mind:

  1. Use Translate to create the cells instead of generating (very) long lists of graphics primitives.
  2. Use Animate instead of ListAnimate so that when you add more frames, there won't be any cost for that upfront. It will always only have one frame in memory. If it gets to the point where generating a frame is too slow to be done on the fly, then this decision will have to be reevaluated.

If you go with ListAnimate and have problems with it being too slow then using Rasterize on each frame will probably fix that. The idea with Rasterize is to keep a list of images instead of a list of instructions for how to draw the corresponding images. The former is much more memory efficient and requires no rendering on the fly at all for showing the images.

cell[x_, y_] := {
   Gray,
   Line[{{x, y}, {x, y + 2/3 Sin[120 Degree]}}],
   Line[{{x, y}, {x + Cos[30 Degree]/2, y - Sin[30 Degree]/2}}],
   Line[{{x, y}, {x - Cos[30 Degree]/2, y - Sin[30 Degree]/2}}],
   Red, Disk[{x, y}, 0.1],
   Blue, Disk[{x, y + 2/3*Sin[120 Degree]}, 0.1]
   };
unitvecA = {Cos[120 Degree], Sin[120 Degree]};
unitvecB = {1, 0};

offsets = Flatten[
   Table[
    unitvecA i + unitvecB j,
    {i, 1, 12},
    {j, Ceiling[i/2], Ceiling[i/2] + 12}
    ],
   1
   ];

Animate[
 Graphics[{
   Translate[cell[0, 0], offsets],
   Rotate[Translate[cell[0, 0], offsets], x]
   },
  PlotRange -> {{-3, 15}, {-3, 15}}],
 {x, 0, Pi, Pi/10}
 ]

Moiré demo.

$\endgroup$

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