0
$\begingroup$

I created a star pattern that I was trying to apply to a circle of pentagons, but the Translate had a slight offset, and I don't understand why. When I drew the lines, they were relative to the origin, but when I used the same CirclePoints I used for the pentagons, the star pattern didn't follow. So I tried a pentagon wrapper, and it also had a different offset. Finally, the circle wrapper solved it. What am I missing here?

If you have another solution for the star, I would like to see that, but I would like the inner lines to trisect each other. Also, I would like to get this working in Graphics3D, but that's for a different post.

.

enter image description here

p = Table[{Cos[θ], Sin[θ]} // N, {θ, π/2 + 2 π/5, -3 π/2 + 2 π/5, -2 π/5}];
mid[p1_, p2_] := p1 + (p2 - p1) .42;
m = mid[p[[#[[1]]]], p[[#[[2]]]]] & /@ {
   {1, 2}, {2, 1}, {2, 3}, {3, 2}, {3, 4}, {4, 3}, {4, 5}, {5, 4}, {5,1}, {1, 5}};

(* star only *)
star = {Line[m[[#]]] & /@ {{2, 5}, {4, 7}, {8, 1}, {6, 9}, {10, 3}}} 

(* star + Polygon[5] *)
star = {Line[m[[#]]] & /@ {{2, 5}, {4, 7}, {8, 1}, {6, 9}, {10, 3}}, 
       EdgeForm[{Thin,Black}],FaceForm[],RegularPolygon[5]}

(* star + Circle[] *)
star = {Line[m[[#]]] & /@ {{2, 5}, {4, 7}, {8, 1}, {6, 9}, {10, 3}}, Thin, Circle[]}

color = {"Purple", "Green", "Magenta", "Cyan", "Red"}
cp = CirclePoints[{2 Cos[π/5], 3 π/10}, 5];
Graphics[{
  EdgeForm[{Black, Thick}], Yellow, RegularPolygon[5],
  CapForm["Round"], Thick, Black, star, {
     Lighter[RGBColor[color[[#]]]],
     RegularPolygon[cp[[#]], {1, 3 π/10}, 5],
     Black, Rotate[Translate[star, cp[[#]]], 6 π/10]
     } & /@ Range[5]
  }]
$\endgroup$
2
  • $\begingroup$ Add code for the first two images that have a problem? $\endgroup$
    – MarcoB
    May 1 '20 at 2:39
  • $\begingroup$ star only star = {Line[m[[#]]] & /@ {{2, 5}, {4, 7}, {8, 1}, {6, 9}, {10, 3}}} star + Pentagon star = {Line[m[[#]]] & /@ {{2, 5}, {4, 7}, {8, 1}, {6, 9}, {10, 3}}, EdgeForm[{Thin,Black}],FaceForm[],RegularPolygon[5]} $\endgroup$
    – shirha
    May 1 '20 at 3:20
2
$\begingroup$

We can combine the results of this answer and this answer to obtain the desired picture.

First, we find the value of u (in the notation of the second answer) such that the lines within the polygons are mutually trisecting. As a warm-up geometric exercise, I invite you to figure out why the following snippet gives the correct answer:

sides = Partition[CirclePoints[5], 2, 1, 1];
u = ut /. RootReduce[First[Solve[Equal @@
    MapThread[Dot, {{{1/3, 2/3}, {2/3, 1/3}}, 
                    Transpose[{{1 - ut, ut}.# & /@ Take[sides, 2],
                               {ut, 1 - ut}.# & /@ Take[sides, {3, 4}]}]}], ut]]]
   (15 - Sqrt[5])/22

Then, generate the required lines:

net = Line[RootReduce[Transpose[{{1 - u, u}.# & /@ sides,
                                 RotateLeft[{u, 1 - u}.# & /@ sides, 2]}]]];

From there, we can apply the results of the first answer:

With[{cc = CirclePoints[{GoldenRatio, 3 π/10}, 5]},
     Graphics[{{Yellow, RegularPolygon[5]},
               MapThread[{Lighter[#2], RegularPolygon[#, {1, 3 π/10}, 5]} &,
                         {cc, {Purple, Green, Magenta, Cyan, Red}}],
               {net, Map[Composition[TranslationTransform[#],
                                     RotationTransform[π]], net, {2}] & /@ cc}},
              BaseStyle -> Directive[CapForm["Round"], Directive[Black, Thick], 
                                     EdgeForm[Directive[Black, Thick]]]]]

figure


A slight modification of the code above can be used to get a 3D embedding. (As another exercise, spot the differences between the previous code and the following one.)

With[{cc = PadRight[CirclePoints[{GoldenRatio, 3 π/10}, 5], {Automatic, 3}]},
     Graphics3D[{{Yellow, Polygon[PadRight[CirclePoints[5], {Automatic, 3}]]},
                 MapThread[{Lighter[#2], 
                            Polygon[PadRight[CirclePoints[Take[#, 2], {1, 3 π/10}, 5],
                                             {Automatic, 3}]]} &,
                           {cc, {Purple, Green, Magenta, Cyan, Red}}],
                 {Map[PadRight[#, {Automatic, 3}] &, net, {2}], 
                  Map[Composition[TranslationTransform[#],
                                  RotationTransform[π, {0, 0, 1}], 
                      PadRight[#, {Automatic, 3}] &], net, {2}] & /@ cc}
                  /. Line -> Tube},
                BaseStyle -> Directive[CapForm["Round"], Black,
                                       EdgeForm[Directive[Black, Thick]]],
                Boxed -> False, Lighting -> "Neutral"]]

3D diagram

$\endgroup$
2
  • $\begingroup$ There a lot I still don't understand yet like all the Thread functions. I don't know how to use ReplaceAll and the last time i heard of a dot product was in high school when Kennedy was President. I find your code fascinating but it will take me time to understand it and apply it to my project. Until then, thank you for your replay. I value it very much. $\endgroup$
    – shirha
    May 6 '20 at 20:50
  • $\begingroup$ I encourage you to take your time studying it. I would definitely encourage you to read up on dot products if you're going to be doing a lot of geometric stuff; they tend to show up a lot in the required computations, and it is vastly useful to know how to manipulate them. $\endgroup$ May 7 '20 at 9:49

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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