27
$\begingroup$

How do I make the following Moiré pattern?

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]
$\endgroup$
  • 6
    $\begingroup$ 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. $\endgroup$ – Szabolcs Apr 19 '16 at 12:00
  • $\begingroup$ Several demonstrations do something similar: demonstrations.wolfram.com/search.html?query=moire $\endgroup$ – Michael E2 Apr 19 '16 at 12:14
37
$\begingroup$

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


$\endgroup$
  • $\begingroup$ I'd like to see your overkill in colors, say RGB, please? +1 anyway $\endgroup$ – user9660 Apr 19 '16 at 15:25
  • 1
    $\begingroup$ @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. $\endgroup$ – J. M. is away Apr 20 '16 at 11:23
  • 1
    $\begingroup$ I am with @J.M. on this: no need for distracting colours when the patterns speak for themselves! $\endgroup$ – gpap Apr 22 '16 at 13:21
24
$\begingroup$

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

$\endgroup$
13
$\begingroup$

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é

$\endgroup$
4
$\begingroup$
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}]
$\endgroup$
2
$\begingroup$

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.

$\endgroup$
  • $\begingroup$ How can I change a color of grid lines? $\endgroup$ – vito Apr 20 '16 at 20:32

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.