Rotating squares animation

Question

Reference link: https://www.geogebra.org/m/RHYH3UQ8 , https://www.geogebra.org/m/xkzsqcyx , https://www.netpad.net.cn/svg.html#posts/55789

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]

Answer 1

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.

Answer 2

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, π}]

Answer 3

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:

Answer 4

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]

Answer 5

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

ClearAll[p, nextpt, redsquares, greensquares]

nextpt = AssociationThread[pts, RotateRight[pts]];

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]

Answer 6

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