4
$\begingroup$

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]

enter image description here

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

enter image description here

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?

$\endgroup$
3
  • $\begingroup$ By the time you post this question, get responses, check them out, etc., your slow code would be long finished. So why ask here? $\endgroup$ Feb 19 at 16:33
  • 2
    $\begingroup$ @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". $\endgroup$
    – sam wolfe
    Feb 19 at 16:36
  • $\begingroup$ 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 $\endgroup$ Feb 19 at 16:54

2 Answers 2

2
$\begingroup$

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]

enter image description here

With q=7.

enter image description here

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]

enter image description here

20 layers (q=20).

enter image description here

$\endgroup$
7
  • $\begingroup$ This looks good, but it does not have the kind of symmetry I am looking for (mirrored and six-fold) $\endgroup$
    – sam wolfe
    Feb 19 at 20:31
  • $\begingroup$ @sam wolfe: What prevents you from changing the colors as you want them? $\endgroup$ Feb 19 at 21:43
  • $\begingroup$ This is great, but I am afraid it does not seem to be more efficient than my code (check with AbsoluteTiming or RepeatedTiming). $\endgroup$
    – sam wolfe
    Feb 20 at 15:55
  • $\begingroup$ @sam wolfe: How large n you want your code to be used on? $\endgroup$ Feb 20 at 16:50
  • $\begingroup$ 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. $\endgroup$
    – sam wolfe
    Feb 20 at 17:01
1
$\begingroup$

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.

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.