Using Degree (Degree Table[x, {x, 0, 172.5, 7.5}]) we get a good alignment on several of the points of a "concentric circle" for a special set of k.
Enter
Remove[burnsStrip]
burnsStrip[k_?NumericQ, w_?NumericQ] :=
Block[{m = RotationTransform[k, {-1, 0}]},
Polygon[{m[{-5/2, -w}], m[{1/2, -w}], m[{1/2, w}], m[{-5/2, w}]}]]
Graphics[{{Green, burnsStrip[0, 1/40]}, {Yellow,
Sequence @@ (burnsStrip[#, 1/40] & /@
(Degree Table[x, {x, 0, 172.5, 7.5}]))},
Table[k = 2 (3 n^3);
Point /@
Evaluate[
ReIm[(-1)^
k ((Flatten[Evaluate[Block[{x}, Solve[x^k == k, x]]]])[[All,
2]] - 1)]], {n, 1, 5}]}, Frame -> True, AspectRatio -> 3/3,
PlotRange -> All, PlotLabel -> "Let the sunshine in!"]
and get,
For more detail and more accuracy in the top half, try the code,
Remove[burnsStrip]
burnsStrip[k_?NumericQ, w_?NumericQ] :=
Block[{m = RotationTransform[k, {-1, 0}]},
Polygon[{m[{-5/2, -w/4}], m[{1/2, -w/4}], m[{1/2, w/4}],
m[{-5/2, w}/4]}]]
Graphics[{{Green, burnsStrip[0, 1/40]}, {Yellow,
Sequence @@ (burnsStrip[#, 1/40] & /@
(Degree Table[x, {x, 0, 180, 7.5/8}]))},
Table[k = 2 (3 n^3);
Point /@
Evaluate[
ReIm[(-1)^
k ((Flatten[Evaluate[Block[{x}, Solve[x^k == k, x]]]])[[All,
2]] - 1)]], {n, 1, 4}]}, Frame -> True, AspectRatio -> 3/3,
PlotRange -> All, PlotLabel -> "Let the sunshine in!",
ImageSize -> 2000]
for what a portion of which looks like the following:
The bottom half of which looks like the points are shifted over by one unit: