How to create a spiral using Golden Triangles

Question

Working with students in a pre-calculus class, an application of the sine law. They are working on a question that has them create a Golden Triangle (A golden triangle is an isosceles triangle in which the ratio of the length of the longer side to the length of the shorter side is the golden ratio) (Description of a Golden Triangle)

If you bisect one of the base angles, you can then create a second Golden Triangle, and if the process is repeated, you get a set of triangles, which can be used to form a spiral.

It's always helpful to be able to illustrate the process more interactively, this would likely be a nice recursive demonstration, but I have no idea how to do this except with "brute force", one triangle at a time, graphics commands.

Any help is appreciated!

Answer 1

Here's a starting point for you:

With[{n = 6},
     Graphics[MapIndexed[{ColorData[103] @@ #2, #1} &, 
                         NestList[MapAt[Composition[
                                        TranslationTransform[AngleVector[2 π/5]/
                                                             GoldenRatio], 
                                        RotationTransform[-3 π/5], 
                                        ScalingTransform[GoldenRatio - {1, 1}]], #, 1] &, 
                                  Polygon[{{0, 0}, {1, 0},
                                           {1/2, Sqrt[5 + 2 Sqrt[5]]/2}}], n]]]]

---

Here's a version with the spiral:

tr = N[ToRadicals[
    RootReduce[
     Composition[
      TranslationTransform[AngleVector[2 π/5]/GoldenRatio], 
      RotationTransform[-3 π/5], 
      ScalingTransform[GoldenRatio - {1, 1}]]]], 20];

Graphics[{MapIndexed[{ColorData[61] @@ #2, #1} &, 
                     NestList[MapAt[tr, #, 1] &, 
                              Polygon[{{0, 0}, {1, 0},
                                       {1/2, Sqrt[5 + 2 Sqrt[5]]/2}}], 6]],
          {Orange, 
           NestList[TransformedRegion[#, tr] &, 
                    Circle[{(3 - Sqrt[5])/4, Sqrt[(5 - Sqrt[5])/2]/2}, 
                           1, {-π/5, 2 π/5}], 6]}}, Background -> LightGray]

Answer 2

Edition

{c, b, a} = SASTriangle[1, 36 Degree, 1][[1]];
α = -1 + GoldenRatio;
β = 1 - α;
(*p[n_/;n≥4]:=p[n]=α*p[n-1]+β*p[n-3];*)

m = {{0, 1, 0}, {0, 0, 1}, {β, 0, α}};
tri[1] = {a, b, c};
tri[n_] := tri[n] = m . tri[n - 1];
mat = Limit[MatrixPower[m, n], n -> Infinity];
center = mat . tri[1] // First;
p[n_] := First@tri[n];
θ[1] = ArcTan @@ N@(p[1] - center);
θ[2] = ArcTan @@ N@(p[2] - center);
result = NMaximize[{0, (c1*E^(c2*t)*{Cos[t], Sin[t]} /. 
        t -> θ[1]) == 
      p[1] - center, (c1*E^(c2*t)*{Cos[t], Sin[t]} /. 
        t -> θ[2]) == p[2] - center}, {c1, c2}][[2]];
spiral = ParametricPlot[(center + c1*E^(c2*t)*{Cos[t], Sin[t]} /. 
     result), {t, -20, θ[1]}, PlotStyle -> White, 
   Axes -> False];
Show[Graphics[{Table[{ColorData[106][i], 
     Triangle[{p[i], p[i + 1], p[i + 3]}]}, {i, 1, 8}]}, 
  Background -> GrayLevel[.8]], spiral, 
 Epilog -> Table[{White, FontSize -> 15, Text[i, p[i]]}, {i, 1, 8}]]

Original

Another starting point.

Clear[tri, gtri, a, b, c];
tri = SASTriangle[1, 36 Degree, 1];
{a, b, c} = {tri[[1, 3]], tri[[1, 2]], tri[[1, 1]]};
gtri[0] := {a, b, c};
gtri[n_] := gtri[n] = Module[{a, b, c}, {a, b, c} = gtri[n - 1];
    {b, c, (GoldenRatio - 1)*c + (2 - GoldenRatio)*a}];
Graphics[{Table[{FaceForm[RandomColor[]], Triangle[gtri[n]]}, {n, 0, 
    6}], FontSize -> Large, Text["a", a, {0, -1}], 
  Text["b", b, {-1, 0}], Text["c", c, {1, 0}]}]

Answer 3

Block[{θ = Pi/5., n = 6, c = Cos@θ, s = Sin@θ,
  f = AffineTransform[{{{c - 1, s}, {-s, c - 1}}, {-c, s}}],
  pts := NestList[f, {{0, Cot[θ/2]}, {-1, 0}, {1, 0}}, n],
  vc := Table[Hue[i/(n + 1)], {i, 0, n}, {3}]},
 Graphics[Polygon[pts, VertexColors -> vc]]
 ]

Answer 4

It's a simple method:

Graphics[Map[HalfLine, 
  Partition[
   AnglePath[
    Prepend[ 
     Table[{(2 Sin[18 Degree])^n, -108 Degree}, {n, 1, 
       10}], {1, -72 Degree}]], 2, 1]]]

But this method has a lot of extra half-lines. The following code works better:

Graphics[{Opacity[
   0.6], {Table[FaceForm[RandomColor[]], 10], 
    Map[Triangle, 
     Partition[
      AnglePath[
       Prepend[Table[{(2 Sin[18 Degree])^n, -108 Degree}, {n, 1, 
          10}], {1, -72 Degree}]], 3, 1]]}\[Transpose]}]

Answer 5

We can get the coordinates of successive triangles by finding the "AngleBisectingCevianEndpoint" using TriangleConstruct:

nextTriangle[{a_, b_, c_} ]:= 
   {TriangleConstruct[{a, b, c}, "AngleBisectingCevianEndpoint"][[1]], a, b}

Use NestList starting with N @ SASTriangle[1, 36 Degree, 1] to get n triangles:

triangleList[n_]:= NestList[nextTriangle,N@SASTriangle[1, 36 Degree, 1][[1]], n]

Example:

Graphics @ MapIndexed[{ColorData[97][#2[[1]]], Polygon @ #} &] @ triangleList[7]