# Rotating squares animation

I want to generate an rotating squares animation like this, my code only workd for 3×3 squares, how can I expand to more squares ( (2n-1) × (2n-1) )?

pts = {{0, 0}, {1, 0}, {1, 1}, {0, 1}};

Manipulate[Graphics[{
EdgeForm[Gray], LightRed,
RotationTransform[θ + Pi/2, #]@pts & /@ pts // Polygon,

LightGreen, Polygon[pts],
TranslationTransform[RotationTransform[θ + Pi/2, #2]@# - #]@pts & @@@
Partition[pts, 2, 1, 1] // Polygon
}, PlotRange -> {{-2, 3}, {-2, 3}}], {θ, 0, Pi}]


Build a chessboard without rotating:

Graphics[{EdgeForm[Gray],
Table[{If[Mod[i+j, 2]==0,LightRed,LightGreen],Rectangle[{i,j}]},{i,5},{j,5}]} ]


or

ArrayPlot[Mod[Array[Plus,{5,5}],2],ColorRules->{0->LightRed,1->LightGreen},Mesh->All]


I made a similar animation once with plusses:

I changed the shape of the plus to a square. Here is the code:

\[CurlyPhi] = Tan[1/3.];
Clear[DrawPlus, MakeScene]
DrawPlus[p : {x_, y_}, \[Theta]_] := Module[{line},
(*line=Polygon[{{1,1},{3,1},{3,-1},{1,-1},{1,-3},{-1,-3},{-1,-1},{-3,-\
1},{-3,1},{-1,1},{-1,3},{1,3},{1,1}}];*)
line = Polygon[{{3, 1}, {1, -3}, {-3, -1}, {-1, 3}}];

line = GeometricTransformation[line, RotationMatrix[\[Theta]]];
GeometricTransformation[line, TranslationTransform[p]]
]
MakeScene[\[Alpha]_] := Module[{p, q, \[Theta] = \[Pi] \[Alpha], gr},
p = {1., -3.} +
Sqrt[10] {Cos[\[Theta] - \[CurlyPhi]], -Sin[\[Theta] - \
\[CurlyPhi]]};
q = {3., 1.} +
Sqrt[10] {Sin[\[Theta] - \[CurlyPhi]],
Cos[\[Theta] - \[CurlyPhi]]};
gr = Flatten[
Table[DrawPlus[i p + j q, If[EvenQ[i + j], 0, -\[Theta]]], {i, -3,
3}, {j, -3, 3}], 1];
(*gr=GeometricTransformation[gr,RotationMatrix[\[Theta]/2]];*)

Graphics[{EdgeForm[Directive[Thick, Black]], RGBColor[0, 0.5, 1],
gr}, PlotRange -> (16 {{-1, 1}, {-1, 1}}), ImageSize -> 300]
]
Manipulate[MakeScene[\[Beta]], {\[Beta], 0, 1}]


resulting in:

I think you can figure out alternate coloring and rotating the entire scene. To change the extent of the squares change the bounds of the Table function.

Probably it can be simplified because I had another geometry. But you can study the mechanism and either adopt mine or adjust your own.

• An explanation would be nice, especially how you found the expressions for q and p. Sep 21, 2019 at 11:29
• p and q can be found by some geometry, nothing special actually. They are the center-to-center 'unit vectors' of the squares in both directions. Sep 21, 2019 at 13:24

This almost, but not quite, matches the requested figure.

square = {{0, 0}, {1, 0}, {1, 1}, {0, 1}};
n = 5;
redlattice = Flatten[Table[{x, y}, {y, -n + 1, n}, {x, -n + 1, n}], 1];
greenlattice = Flatten[Table[{x, y}, {y, -n + 1, n - 1}, {x, -n + 1, n - 1}], 1];

Manipulate[
redsquares = RotationTransform[θ + π/2, #]@square & /@ redlattice;
temp = RotationTransform[θ + π/2, #]@square & /@ greenlattice;
greensquares = TranslationTransform[#[[1]] - square[[1]]]@square & /@ temp;
Graphics[{EdgeForm[Gray],
LightRed, Polygon@redsquares,
LightGreen, Polygon[square], Polygon@greensquares
}, PlotRange -> {{-2 n - 1, 2 n + 2}, {-2 n - 1, 2 n + 2}}], {θ, 0, π}]



I modified the SHuisman's code a bit. It turned out to be almost a complete match with the required animation.

\[CurlyPhi] = Tan[1/3.];
Clear[DrawPlus, MakeScene]
DrawPlus[p : {x_, y_}, \[Theta]_] :=
Module[{line}, line = Polygon[{{3, 1}, {1, -3}, {-3, -1}, {-1, 3}}];
line = GeometricTransformation[line, RotationMatrix[\[Theta]]];
GeometricTransformation[line, TranslationTransform[p]]]
MakeScene[\[Alpha]_] :=
Module[{p, q, \[Theta] = \[Pi] \[Alpha], gr},
p = {1., -3.} +
Sqrt[10] {Cos[\[Theta] - \[CurlyPhi]], -Sin[\[Theta] - \
\[CurlyPhi]]};
q = {3., 1.} +
Sqrt[10] {Sin[\[Theta] - \[CurlyPhi]],
Cos[\[Theta] - \[CurlyPhi]]};
gr = Flatten[
Table[{If[OddQ[i + j], LightRed, LightGreen],
DrawPlus[i p + j q, If[EvenQ[i + j], 0, -\[Theta]]]}, {i, -3,
3}, {j, -3, 3}], 1];
Graphics[{{EdgeForm[Directive[Thick, Blue, Opacity[.5]]],
Rotate[gr, Pi/7]}, {Red, PointSize[.01],
Point[{{0, 0}, {2, 2}}]}}, PlotRange -> (30 {{-1, 1}, {-1, 1}}),
ImageSize -> 500]]
lst = Table[MakeScene[\[Beta]], {\[Beta], 0, 1, .02}];
ListAnimate[lst]


Extending @ MelaGo answer...in spirit of OP...but needs improvement:

square = {{0, 0}, {1, 0}, {1, 1}, {0, 1}};
f[j_, k_] := Table[{u, k}, {u, -j, j}];
top[n_] := Join @@ (f @@@ Table[{n - j, j}, {j, 0, n}]);
bot[n_] := Join @@ (f @@@ Table[{n - j, -j}, {j, 1, n}]);
full[n_] := Join[top[n], bot[n]];

funr[p_] := RegionCentroid[Polygon[RotationTransform[Pi/2, p]@square]]
fung[p_] :=
RegionCentroid[
Polygon[TranslationTransform[(RotationTransform[Pi/2, p]@
square)[[1]]]@square]]
lattr[n_] := Select[full[n], funr[#][[1]] != -n - 1/2 &]
lattg[n_] := Select[full[n], fung[#][[1]] != n + 1/2 &]
vis[a_, n_] := Module[{red = lattr[n], green = lattg[n], rs, tmp, gs},
rs = RotationTransform[a + \[Pi]/2, #]@square & /@ red;
tmp = RotationTransform[a + \[Pi]/2, #]@square & /@ green;
gs = TranslationTransform[#[[1]]]@square & /@ tmp;
Graphics[{EdgeForm[Gray], LightRed, Polygon@rs, LightGreen,
Polygon@gs}, PlotRange -> {{-2 n, 2 n}, {-2 n, 2 n}}]]
Manipulate[vis[a, n], {a, 0, \[Pi]}, {n, Range[2, 7]}]


Some exported gifs:

pts = {{0, 0}, {1, 0}, {1, 1}, {0, 1}};

ClearAll[p, nextpt, redsquares, greensquares]

p[m_] := Tuples[{SparseArray[DiamondMatrix[m - 1]]["NonzeroPositions"] - m, pts}]

redsquares[t_, m_] := Rotate[Rectangle[], t + Pi/2, #] & /@ DeleteDuplicates[Total /@ p[m]]

greensquares[t_, m_] := Translate[Rectangle[],
DeleteDuplicates[RotationTransform[t + Pi/2, nextpt[#2] + #]@#2 - #2 & @@@ p[m]]]


Show one or more groups of rotating rectangles:

n = 10;
Manipulate[Row[Table[Graphics[{EdgeForm[Gray],
LightRed, redsquares[θ, m], LightGreen, Rectangle[], greensquares[θ, m]},
PlotRange -> {{-2 m, 2 m + 1}, {-2 m, 2 m + 1}},
ImageSize -> 200 m/2], {m, Sort @ ml}], Spacer[5]],
{{ml, {1}}, Range[n], TogglerBar}, {θ, 0, Pi}]


The animation above produced using

ml = {1, 2, 4};
frames = Table[Row[Table[Graphics[{EdgeForm[Gray],
LightRed, redsquares[θ, m], LightGreen, Rectangle[], greensquares[θ, m]},
PlotRange -> {{-2 m, 2 m + 1}, {-2 m, 2 m + 1}}, ImageSize -> 200 m/2],
{m, ml}], Spacer[5]], {θ, 0, Pi, Pi/64}];

Export["rotatingrectangles.gif", frames]

• Thank you @ubpdqn.
– kglr
Sep 26, 2019 at 13:50

Inspired by SHuisman, using complex number

Manipulate[
Graphics[{
Table[With[{k = Mod[i + j, 2]}, {EdgeForm[Gray], RGBColor[k, 1 - k, 0, .2],
Polygon@ReIm[(1 + I) (E^(I θ) + I) (i + I j) +  E^(I k θ) {-1-I, I-1, 1+I, 1-I}]}],
{i, -n, n}, {j, -n, n}]
}, PlotRange -> 4 n + 2
], {{n, 3}, 1, 9, 1}, {θ, 0., Pi}]


• This is a great simple and efficient code! Sep 19, 2020 at 0:02