Make a beautiful Moiré effect

I feel that once you start with Moire patterns, there's no ending. The way I would replicate these is by making a grid into a function (like @JasonB) but also parametrise the angle of rotation into it:

lines[t_, n_] := 
  Line /@ ({RotationMatrix[t].# & /@ {{-1, #}, {1, #}}, 
        RotationMatrix[t].# & /@ {{#, -1}, {#, 1}}} & /@ 
      Range[-1, 1, 2/n]) // Graphics;

So that you can vary the number of lines n and rotation parameter t as well. Now your image is (more or less):

lines[#, 40] & /@ Range[0, π - π/3, π/3] // Show

enter image description here

And you can play more with these two parameters. Here's what you get if you superimpose grids with very small relative angle differences:

lines[#, 100] & /@ Range[-π/300, π/300, π/300] // Show

enter image description here

Or randomising the spacing and angle of each grid:

lines[Cos[# π/30], #] & /@ RandomInteger[{1, 20}, 9] // Show

enter image description here

and -as an overkill- harmonically varying these two effects results in great gif potential

gif = Table[Show[{lines[0, Floor[10 + 9 Cos[t]]], lines[-2 π/3 Cos[t], 20], 
    lines[+2 π/3 Cos[t], 20]}, 
   PlotRange -> {{-1.5, 1.5}, {-1.5, 1.5}}, 
   ImageSize -> 200], {t, -π/2, π/2 - π/70, π/70}];
Export["moire.gif", gif]

enter image description here



Something like this:

nlines = 30;
Table[
 Overlay[
  Rotate[
     Graphics[{
       Table[{
         Line[{{0, n}, {nlines, n}}],
         Line[{{n, 0}, {n, nlines}}]},
        {n, 0, nlines}],
       Text[Style[#1, 18], {0, 0}, {-1, -1}, Background -> White]
       },
      AspectRatio -> 1,
      PlotRangePadding -> None,
      ImageSize -> 360], #2] & @@@ 
   Transpose[{(ToUpperCase /@ Alphabet[])[[;; ngrids]], 
     Most@Subdivide[\[Pi]/2, ngrids]}],
  Alignment -> Center],
 {ngrids, 3, 6}]

enter image description here

You can get an interesting effect if you use color in the grid. Here I'm using a repeating pattern of colors for the gridlines and it gives a pretty interesting effect (also, modified the code to not use Overlay, as it is always worth the effort to avoid that function)

With[{line = Line[{{0, n}, {30, n}}]},
 Show[
  Table[
   rt = RotationTransform[m \[Pi] / 16, {15, 15}];
   Graphics[{Table[{ColorData[110][n], rt /@ line, 
       rt /@ Map[Reverse, line, {1, 2}]},
      {n, 0, 30}]}], {m, 0, 7}], ImageSize -> 500]
 ]

enter image description here

or, replacing ColorData[110][n] with If[EvenQ[n], Red, Blue] gives this,

enter image description here


I like to keep things simple, so I'll skip the letter labels, but include the lines overhanging from the grid:

m = 30 (* number of mesh lines *); h = 2 (* overhang *);
lins = Join[#, Map[Reverse, #, {2}]] & @
       Outer[{##} &, ArrayPad[Range[-1, 1, 2/m], h, "Extrapolated"], {-1, 1}];

Table[Graphics[{AbsoluteThickness[1/100], 
                Table[Line[Map[RotationTransform[θ], lins, {2}]],
                      {θ, 0, π/2 - π/(2 n), π/(2 n)}]}], {n, 3, 6}] // GraphicsRow

I've seen mandalas like these. (click on the picture to see it in its full resolution splendor)


The original picture had more random orientations for grids B and C. I tried using Manipulate[] to attempt to determine those rotations, but I was not successful. If you want to play around with it yourself, have at it:

DynamicModule[{θl = {0, 0, 0}}, 
              Panel[Row[{Dynamic[
                    Graphics[{AbsoluteThickness[1/100], 
                              Table[Line[Map[RotationTransform[θ], lins, {2}]],
                                    {θ, θl}]}, ImageSize -> Medium, 
                             PlotRange -> {{-3/2, 3/2}, {-3/2, 3/2}}]], 
                    Column[Table[With[{i = i}, 
                    Experimental`AngularSlider[Dynamic[θl[[i]]]]], {i, Length[θl]}]]}]]]

playing around with moiré