# Make a beautiful Moiré effect

How do I make the following Moiré pattern?

I tried:

A = Plot[Table[n, {n, 1, 30}], {x, 0, 31},
GridLines -> {Table[n, {n, 1, 30}], None},
GridLinesStyle -> AbsoluteThickness[1.2], PlotStyle -> Gray,
Axes -> False, AspectRatio -> 1]
B = Rotate[A, -30 Degree]
C = Rotate[A, -60 Degree]

• Build the grid directly from Line primitives. Rotate inside of Graphics. This should be straightforward. Don't use Plot and don't use the GridLines option. Apr 19, 2016 at 12:00
• Several demonstrations do something similar: demonstrations.wolfram.com/search.html?query=moire Apr 19, 2016 at 12:14

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


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


Or randomising the spacing and angle of each grid:

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


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]


• I'd like to see your overkill in colors, say RGB, please? +1 anyway
– user9660
Apr 19, 2016 at 15:25
• @Lou, maybe it's just me, but moiré designs almost always look better in monochrome or grayscale; color just takes out some of the subtle details. Apr 20, 2016 at 11:23
• I am with @J.M. on this: no need for distracting colours when the patterns speak for themselves!
– gpap
Apr 22, 2016 at 13:21

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,
ImageSize -> 360], #2] & @@@
Transpose[{(ToUpperCase /@ Alphabet[])[[;; ngrids]],
Most@Subdivide[\[Pi]/2, ngrids]}],
Alignment -> Center],
{ngrids, 3, 6}]


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]
]


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

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


(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},
ExperimentalAngularSlider[Dynamic[θl[[i]]]]], {i, Length[θl]}]]}]]]


g = Graphics@GraphicsGroup[
Table[{Line[{{x, -5}, {x, 5}}], Line[{{-5, x}, {5, x}}]},
{x, -5, 5, .25}]
];
Manipulate[
Overlay[
Table[
Rotate[g, i θ],
{i, -2, 2}],
Alignment -> Center
],
{θ, 0, π/12}]


or

g = Graphics@GraphicsGroup[
Table[{Line[{{x, -5}, {x, 5}}], Line[{{-5, x}, {5, x}}]},
{x, -5, 5, .25}]
];
Manipulate[
Overlay[
Table[
Rotate[g, i .2],
{i, -n, n}],
Alignment -> Center
],
{n, 0, 5}]


I remember playing around with clear plastic sheets with grid lines. Here's a way to simulate the real-time moving around of the sheets. Starting with gpap's function, change this to an image and set the alpha channel so that the white area is actually transparent. Then use GraphicsGrid to display multiple copies. Now you can move them around and rotate using the mouse:

lines[t_, n_] := Line /@ ({RotationMatrix[t].# & /@ {{-1, #}, {1, #}},
RotationMatrix[t].# & /@ {{#, -1}, {#, 1}}} & /@
Range[-1, 1, 2/n]) // Graphics;
img = SetAlphaChannel[Image[lines[0, 40]], ColorNegate[Image[lines[0, 40]]]];
GraphicsGrid[{{img, img}, {img, img}}]
`

The real-time moving of the moire patterns is fun.

• How can I change a color of grid lines?
– vito
Apr 20, 2016 at 20:32