Pythagoräische Gitter - bezaubernde Muster

Herleitung des Programms

Multiplikation Matrix mal Vektor

{{Cos[fi], -Sin[fi]}, {Sin[fi], Cos[fi]}} . {n, m} // 
      MatrixForm

Remove[gitter]

Funktion zur Erzeugung der Koordinaten der Gitterpunkte in Abhängigkeit vom Drehwinkel des Gitters und der Anzahl Gitterpunkte

gitter[fi_, k_] := 
      Flatten[Table[{{Cos[fi], -Sin[fi]}, {Sin[fi], Cos[fi]}} . {n, 
              m}, {n, -k, k}, {m, -k, k}], 1]

gitter[1, 2]

Plot des Gitters

?ListPlot

ListPlot[gitter[1, 2]]

p = 
        ListPlot[gitter[1, 5], 
          PlotStyle -> PointSize[0.02]];

Diverse Plots kompiniert durch Ueberlagerung

p1 = 
        ListPlot[gitter[0, 20], PlotStyle -> PointSize[0.015], 
          AspectRatio -> Automatic, Axes -> False];

p2 = 
        ListPlot[gitter[ArcTan[3/4], 20], PlotStyle -> PointSize[0.015], 
          AspectRatio -> Automatic, Axes -> False];

Show[p1, p2];

p3 = 
        ListPlot[gitter[ArcTan[-3/4], 20], 
          PlotStyle -> PointSize[0.015], AspectRatio -> Automatic, 
          Axes -> False];

Show[p1, p2, p3];

Remove[p]

Automatisierung der Ueberlagerung

?DisplayFunction

r1[w_] := 
        ListPlot[gitter[0, w], PlotStyle -> PointSize[0.015], 
          AspectRatio -> Automatic, Axes -> False, 
          DisplayFunction -> Identity];

Verwendung pythagoräischer Zahlentrippel {(u^2) + (v^2), 2 u v, (u^2) - (v^2)}

p[u_, v_, w_] := 
        ListPlot[gitter[ArcTan[2  u v/(u^2 - v^2)], w], 
          PlotStyle -> PointSize[0.015], AspectRatio -> Automatic, 
          Axes -> False, DisplayFunction -> Identity];

Show[r1[20], p[3, 5, 20], 
        DisplayFunction -> $DisplayFunction];

s[u_, v_, w_] := 
        Show[r1[w], p[u, v, w], p[-u, v, w], 
          DisplayFunction -> $DisplayFunction];

s[1, 2, 20];

s[3, 5, 20];

s[3, 7, 20];

s[3, 8, 20];

s[3, 57, 20];

h[u_, v_, w_] := 
        Show[r1[w], p[u, v, w], 
          DisplayFunction -> $DisplayFunction];

h[3, 8, 20];

Automatische Generierung

Erzeuge die Graphiken und animiere sie dann! (Serie von Graphiken am Balken rechts anklicken, Cell, Animate selected Graphics)

Table[Table[s[u, v, 20], {u, 1, v - 1}], {v, 2, 7}];

Table[Table[h[u, v, 20], {u, 1, v - 1}], {v, 2, 7}];