15
$\begingroup$

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.

nested Golden Triangles

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!

$\endgroup$
15
$\begingroup$

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]]]]

nested golden triangles


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]

golden triangle with spiral

$\endgroup$
10
$\begingroup$

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}]]

enter image description here

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}]}]
$\endgroup$
1
  • 1
    $\begingroup$ Here's another way to get the fixed point: First[Limit[Transpose[MatrixPower[Transpose[m], n, #] & /@ Transpose[{a, b, c}]], n -> ∞]] $\endgroup$ – J. M.'s torpor Feb 13 at 7:24
8
$\begingroup$
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]]
 ]

enter image description here

$\endgroup$
5
$\begingroup$

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]}]

enter image description here

$\endgroup$
5
$\begingroup$

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]

enter image description here

$\endgroup$

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.