# How to efficiently duplicate and rotate a graphics object?

Consider the following code

n = 5;
vertices = Table[{Sin[2 Pi j/6], Cos[2 Pi j/6]}, {j, 0, 5}];
hexagon[x_, y_] := Polygon[{x, y} + # & /@ vertices];
theta = 4 Pi/3;
allHexagonCenters =
Flatten[Table[
RotationMatrix[theta] . {Sqrt[3] i + Sqrt[3]/2 j, 3/2 j}, {j, 0,
n - 1}, {i, 0, n - j - 1}], 1];
hexagoncenter = Select[allHexagonCenters, #[[1]] >= 0 &];
hexagondist = Norm /@ hexagoncenter;
hexagonlist = hexagon[Sequence @@ #] & /@ hexagoncenter;
hassoc =
Association @@ (#[[1, 1]] -> #[[All, 2]] & /@
GatherBy[Transpose[{hexagondist, hexagonlist}], First]);
coloredHexagons =
KeyValueMap[
Function[{key, hexagons}, {ColorData["DarkRainbow"][RandomReal[]],
hexagons}], hassoc];
slice = Graphics[{EdgeForm[{Thick, Transparent}], coloredHexagons},
PlotRange -> All]


Now I imagine I want to mirror this "half slice" and duplicate it 5 times by rotating it around a focal cell, to generate the following

What is the most efficient way of doing this?

My attempt: The previous image was generated with the following code

slicem =
Show[slice,
Graphics[
GeometricTransformation[First@slice, ReflectionTransform[{1, 0}]],
Sequence @@ Rest@slice ]];
rotatedSlices =
Table[Graphics[
GeometricTransformation[First@slicem,
RotationTransform[j Pi/3, {0, 0}]],
Sequence @@ Rest@slicem ], {j, 1, 5}];
completeHexagon = Show[slicem, rotatedSlices, PlotRange -> All]


However, when n is large, this will get really slow. What would be the best approach to optimizing this procedure?

• By the time you post this question, get responses, check them out, etc., your slow code would be long finished. So why ask here? Feb 19 at 16:33
• @DavidG.Stork The purpose of this question is to hopefully improve my code to be highly efficient for large values of n, and that is why I used the tag "performance-tuning". Feb 19 at 16:36
• I suggest doing something like this: hex[center_, rotation_, color_]:= With[{pts = CirclePoints[6],poly = Polygon[Range[6]]}, GraphicsComplex[RotationMatrix[rotation].#&,points] + Threaded[center],{color,poly}]] and similar for reflections, etc Feb 19 at 16:54

Update:

With mirror symmetry

q = 20;
po = (Polygon@(CirclePoints[#, {1/Sqrt[3], π/6}, 6])) &;
Graphics[{po@{0, 0},
Table[Riffle[(color = (Table[
ColorData["DarkRainbow", RandomReal[]], {k,
Floor[(n + 2)/2]}]))~Join~
Reverse[color][[Mod[n, 2, 1] ;; -2]],
po /@ # & /@
Transpose[
Most@Subdivide[##, n] & @@@
Partition[CirclePoints[{n, 0}, 6], 2, 1, {1, 1}]]], {n, q}]}]
Clear[q, po]


With q=7.

Old version:

Without any rotations.

7 layers.

q = 7;
po = (Polygon@(CirclePoints[#, {1/Sqrt[3], π/6}, 6])) &;
Graphics[{po@{0, 0},
Table[Riffle[Table[ColorData["DarkRainbow", RandomReal[]], {k, n}],
po /@ # & /@
Transpose[
Most@Subdivide[##, n] & @@@
Partition[CirclePoints[{n, 0}, 6], 2, 1, {1, 1}]]], {n, q}]}]
Clear[q, po]


20 layers (q=20).

• This looks good, but it does not have the kind of symmetry I am looking for (mirrored and six-fold) Feb 19 at 20:31
• @sam wolfe: What prevents you from changing the colors as you want them? Feb 19 at 21:43
• This is great, but I am afraid it does not seem to be more efficient than my code (check with AbsoluteTiming or RepeatedTiming). Feb 20 at 15:55
• @sam wolfe: How large n you want your code to be used on? Feb 20 at 16:50
• In the thousands, that's where my code struggled. I understand if this might become a memory issue, but I would be happy with a low-res export of the overall pattern. Feb 20 at 17:01

Consider the prime factorization of n.

If n is some power of 2, create a picture of 2, 4,.. copies of the rotated original image and use them to get the whole picture.

If 3 is contained in the prime factorization, you may either do like above up to the closets power of 2 and get the rest an additional rotated image. Or you can do the same trick with 3,9,.. copies

For an arbitrary prime numbers, choose an suitable strategy of powers of primes.