How to do this Padovan spiral using Mathematica?Area of Generalized Koch SnowflakeUlam's Spiral with Opperman's diagonals (quarter-squares)How can I shorten this code to rotate a line segment around its center?How can this image (optical illusion) be created with Mathematica?Can anyone re-produce this result related to the spectrum of Riemann Zeta using error term generated from MangoldtLambda?Is it possible to draw this figure using Mathematica?How to create this spikey in Mathematica?Drawing a figure showing an $n$-gon and its direction into trianglesEllipse - Weyl's law - MathematicaPentagonal spiral in MathematicaHow to use the Mathematica

​Cuban​ ​Primes

Is Precocious Apprentice enough for Mystic Theurge?

multiline equation inside a matrix that is a part of multiline equation

Is there a method to separate iron from mercury?

Why are lawsuits between the President and Congress not automatically sent to the Supreme Court

How does this piece of code determine array size without using sizeof( )?

What is this rubber on gear cables

Why does string strummed with finger sound different from the one strummed with pick?

Why is the A380’s with-reversers stopping distance the same as its no-reversers stopping distance?

How can I make dummy text (like lipsum) grey?

Is there any deeper thematic meaning to the white horse that Arya finds in The Bells (S08E05)?

Why is vowel phonology represented in a trapezoid instead of a square?

Why use a retrograde orbit?

Physically unpleasant work environment

How to handle professionally if colleagues has referred his relative and asking to take easy while taking interview

Would it be fair to use 1d30 (instead of rolling 2d20 and taking the higher die) for advantage rolls?

Five Powers of Fives Produce Unique Pandigital Number...Solve for X..Tell me Y

Pedaling at different gear ratios on flat terrain: what's the point?

Cycling to work - 30mile return

Why does Taylor’s series “work”?

Square spiral in Mathematica

Canadian citizen who is presently in litigation with a US-based company

What are the effects of eating many berries from the Goodberry spell per day?

Solenoid fastest possible release - for how long should reversed polarity be applied?



How to do this Padovan spiral using Mathematica?


Area of Generalized Koch SnowflakeUlam's Spiral with Opperman's diagonals (quarter-squares)How can I shorten this code to rotate a line segment around its center?How can this image (optical illusion) be created with Mathematica?Can anyone re-produce this result related to the spectrum of Riemann Zeta using error term generated from MangoldtLambda?Is it possible to draw this figure using Mathematica?How to create this spikey in Mathematica?Drawing a figure showing an $n$-gon and its direction into trianglesEllipse - Weyl's law - MathematicaPentagonal spiral in MathematicaHow to use the Mathematica













6












$begingroup$


enter image description here



how to do this unusual pendovan spriral? can anyone help me ?










share|improve this question











$endgroup$











  • $begingroup$
    What have you tried?
    $endgroup$
    – David G. Stork
    May 5 at 3:16






  • 3




    $begingroup$
    There is this very graphic as a demo in the Wolfram Demonstrations Project
    $endgroup$
    – ciao
    May 5 at 8:07















6












$begingroup$


enter image description here



how to do this unusual pendovan spriral? can anyone help me ?










share|improve this question











$endgroup$











  • $begingroup$
    What have you tried?
    $endgroup$
    – David G. Stork
    May 5 at 3:16






  • 3




    $begingroup$
    There is this very graphic as a demo in the Wolfram Demonstrations Project
    $endgroup$
    – ciao
    May 5 at 8:07













6












6








6


1



$begingroup$


enter image description here



how to do this unusual pendovan spriral? can anyone help me ?










share|improve this question











$endgroup$




enter image description here



how to do this unusual pendovan spriral? can anyone help me ?







graphics geometry number-theory education






share|improve this question















share|improve this question













share|improve this question




share|improve this question








edited May 5 at 17:06









C. E.

51.9k3101208




51.9k3101208










asked May 5 at 2:35









pigeonpigeon

461




461











  • $begingroup$
    What have you tried?
    $endgroup$
    – David G. Stork
    May 5 at 3:16






  • 3




    $begingroup$
    There is this very graphic as a demo in the Wolfram Demonstrations Project
    $endgroup$
    – ciao
    May 5 at 8:07
















  • $begingroup$
    What have you tried?
    $endgroup$
    – David G. Stork
    May 5 at 3:16






  • 3




    $begingroup$
    There is this very graphic as a demo in the Wolfram Demonstrations Project
    $endgroup$
    – ciao
    May 5 at 8:07















$begingroup$
What have you tried?
$endgroup$
– David G. Stork
May 5 at 3:16




$begingroup$
What have you tried?
$endgroup$
– David G. Stork
May 5 at 3:16




3




3




$begingroup$
There is this very graphic as a demo in the Wolfram Demonstrations Project
$endgroup$
– ciao
May 5 at 8:07




$begingroup$
There is this very graphic as a demo in the Wolfram Demonstrations Project
$endgroup$
– ciao
May 5 at 8:07










3 Answers
3






active

oldest

votes


















17












$begingroup$

You can do this rather nicely with GeometricScene.



scene = GeometricScene[
a, b, c, d, e, f, g, h, i, j, k, l, m, n,
RegularPolygon[a, b, c], RegularPolygon[b, d, c],
RegularPolygon[b, e, d],
RegularPolygon[a, f, e], RegularPolygon[f, g, e],
RegularPolygon[g, h, d],
RegularPolygon[c, h, i],
RegularPolygon[a, i, j],
RegularPolygon[f, j, k],
RegularPolygon[k, l, g],
RegularPolygon[l, m, h],
RegularPolygon[m, n, i],
GeometricAssertion[a, b, c, b, d, c, b, e, d, a, f, e, f,
g, e, g, h, d, c, h, i, a, i, j, f, j, k, k, l,
g, l, m, h, m, n, i, "Clockwise"]

]

RandomInstance[scene]


enter image description here



We can use Style to colour the triangles:



GeometricScene[a, b, c, d, e, f, g, h, i, j, k, l, m, n,
Style[RegularPolygon[a, b, c], White],
Style[RegularPolygon[b, d, c], LightBlue],
Style[RegularPolygon[b, e, d], White],
Style[RegularPolygon[a, f, e], LightBlue],
Style[RegularPolygon[f, g, e], White],
Style[RegularPolygon[g, h, d], LightBlue],
Style[RegularPolygon[c, h, i], White],
Style[RegularPolygon[a, i, j], LightBlue],
Style[RegularPolygon[f, j, k], White],
Style[RegularPolygon[k, l, g], LightBlue],
Style[RegularPolygon[l, m, h], White],
Style[RegularPolygon[m, n, i], LightBlue],
GeometricAssertion[a, b, c, b, d, c, b, e, d, a, f, e, f,
g, e, g, h, d, c, h, i, a, i, j, f, j, k, k, l,
g, l, m, h, m, n, i, "Clockwise"]

] // RandomInstance


enter image description here



Now, because this is a full geometric solver, we can assign the Area of each triangle to a variable, and set the area of the smallest triangles (the centre pieces) to 1, and we can see that the area of each subsequent triangle is the square of its spiral position:



scene = GeometricScene[a, b, c, d, e, f, g, h, i, j, k, l, m, 
n, ar1, ar2, ar3, ar4, ar5, ar7, ar9, ar12, ar16,
Area@RegularPolygon[a, b, c] == Area@RegularPolygon[b, d, c] ==
Area@RegularPolygon[b, e, d] == ar1 == 1,
Area@RegularPolygon[a, f, e] == Area@RegularPolygon[f, g, e] ==
ar2,
Area@RegularPolygon[g, h, d] == ar3,
Area@RegularPolygon[c, h, i] == ar4,
Area@RegularPolygon[a, i, j] == ar5,
Area@RegularPolygon[f, j, k] == ar7,
Area@RegularPolygon[k, l, g] == ar9,
Area@RegularPolygon[l, m, h] == ar12,
Area@RegularPolygon[m, n, i] == ar16,
GeometricAssertion[a, b, c, b, d, c, b, e, d, a, f, e, f,
g, e, g, h, d, c, h, i, a, i, j, f, j, k, k, l,
g, l, m, h, m, n, i, "Clockwise"]

]

inst = RandomInstance[scene]

inst["Quantities"][[13 ;; 21]]



ar1 -> 1., ar2 -> 4., ar3 -> -9., ar4 -> 16., ar5 -> 25., 
ar7 -> -49., ar9 -> 81., ar12 -> 144., ar16 -> 256.



(I am assuming that the negative values occur because the origin is the first point of the centre triangle, but I haven't tested.)



If we are patient enough, we can use FindGeometricConjectures to find out more interesting conjectures about our scene - for instance, that 3 sets of lines are necessarily parallel (each side of each triangle).



enter image description here






share|improve this answer











$endgroup$




















    6












    $begingroup$

    ** THIS IS AN EXTENDED COMMENT RATHER THAN AN ANSWER **



    As a start, you can find the size of the nth triangle using FindSequenceFunction



    seq = 1, 1, 1, 2, 2, 3, 4, 5, 7, 9, 12, 16;

    f[n_] = FindSequenceFunction[seq, n]


    enter image description here



    The result is expressed as Root objects. To convert to radicals with ToRadicals,



    f2[n_] = f[n] // ToRadicals // Simplify


    enter image description here



    seq2 = f /@ Range[16] // RootReduce

    (* 1, 1, 1, 2, 2, 3, 4, 5, 7, 9, 12, 16, 21, 28, 37, 49 *)

    seq2 == f2 /@ Range[16] // FullSimplify

    (* True *)


    As expected, both forms give the same result. Plotting,



    DiscretePlot[f[n], n, 1, 16]


    enter image description here



    Alternatively, using RSolve



    f3[n_] = a[n] /. 
    RSolve[a[n] == a[n - 2] + a[n - 3], a[1] == 1, a[2] == 1, a[3] == 1,
    a[n], n][[1]]


    enter image description here






    share|improve this answer









    $endgroup$




















      6












      $begingroup$

      Below is my (not quite right) attempt. However, now that we've seen the Wolfram demo link, I think that their code will be more helpful.



      nextTriangle[oppositept_, firstedge_] := Module[f = firstedge, p,
      p = (f[[1, 1]] + f[[2, 1]] + Sqrt[3.] (f[[1, 2]] - f[[2, 2]]))/2,
      (f[[1, 2]] + f[[2, 2]] - Sqrt[3.] (f[[1, 1]] - f[[2, 1]]))/2,
      (f[[1, 1]] + f[[2, 1]] - Sqrt[3.] (f[[1, 2]] - f[[2, 2]]))/2,
      (f[[1, 2]] + f[[2, 2]] + Sqrt[3.] (f[[1, 1]] - f[[2, 1]]))/2;
      firstedge[[1]], firstedge[[2]],
      Chop[First[Sort[p, EuclideanDistance[#1, oppositept] > EuclideanDistance[#2, oppositept] &]]]
      ]

      n = 12;
      triangles = 0, Sqrt[3.], -1, 0, 1, 0;
      Do[
      t = Last[triangles];
      nextedge = t[[1, 3]];
      edgefit = Fit[nextedge, 1, x, x];
      allpts = Flatten[triangles, 1];
      colinearpos = Boole[Chop[edgefit /. x -> #[[1]]] == #[[2]] & /@ allpts];
      colinearpts = Cases[Transpose[allpts, colinearpos], x_, 1 -> x];
      line = First[Sort[colinearpts, EuclideanDistance[#1, t[[3]]] > EuclideanDistance[#2, t[[3]]] &]], t[[3]];
      nextt = nextTriangle[t[[2]], line];
      AppendTo[triangles, nextt];
      , i, 1, n - 1]

      Graphics[Table[If[EvenQ[n], LightBlue, White], EdgeForm[Thin],
      Polygon[triangles[[n]]], n, 1, Length[triangles]]]


      enter image description here






      share|improve this answer











      $endgroup$













        Your Answer








        StackExchange.ready(function()
        var channelOptions =
        tags: "".split(" "),
        id: "387"
        ;
        initTagRenderer("".split(" "), "".split(" "), channelOptions);

        StackExchange.using("externalEditor", function()
        // Have to fire editor after snippets, if snippets enabled
        if (StackExchange.settings.snippets.snippetsEnabled)
        StackExchange.using("snippets", function()
        createEditor();
        );

        else
        createEditor();

        );

        function createEditor()
        StackExchange.prepareEditor(
        heartbeatType: 'answer',
        autoActivateHeartbeat: false,
        convertImagesToLinks: false,
        noModals: true,
        showLowRepImageUploadWarning: true,
        reputationToPostImages: null,
        bindNavPrevention: true,
        postfix: "",
        imageUploader:
        brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
        contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
        allowUrls: true
        ,
        onDemand: true,
        discardSelector: ".discard-answer"
        ,immediatelyShowMarkdownHelp:true
        );



        );













        draft saved

        draft discarded


















        StackExchange.ready(
        function ()
        StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f197697%2fhow-to-do-this-padovan-spiral-using-mathematica%23new-answer', 'question_page');

        );

        Post as a guest















        Required, but never shown

























        3 Answers
        3






        active

        oldest

        votes








        3 Answers
        3






        active

        oldest

        votes









        active

        oldest

        votes






        active

        oldest

        votes









        17












        $begingroup$

        You can do this rather nicely with GeometricScene.



        scene = GeometricScene[
        a, b, c, d, e, f, g, h, i, j, k, l, m, n,
        RegularPolygon[a, b, c], RegularPolygon[b, d, c],
        RegularPolygon[b, e, d],
        RegularPolygon[a, f, e], RegularPolygon[f, g, e],
        RegularPolygon[g, h, d],
        RegularPolygon[c, h, i],
        RegularPolygon[a, i, j],
        RegularPolygon[f, j, k],
        RegularPolygon[k, l, g],
        RegularPolygon[l, m, h],
        RegularPolygon[m, n, i],
        GeometricAssertion[a, b, c, b, d, c, b, e, d, a, f, e, f,
        g, e, g, h, d, c, h, i, a, i, j, f, j, k, k, l,
        g, l, m, h, m, n, i, "Clockwise"]

        ]

        RandomInstance[scene]


        enter image description here



        We can use Style to colour the triangles:



        GeometricScene[a, b, c, d, e, f, g, h, i, j, k, l, m, n,
        Style[RegularPolygon[a, b, c], White],
        Style[RegularPolygon[b, d, c], LightBlue],
        Style[RegularPolygon[b, e, d], White],
        Style[RegularPolygon[a, f, e], LightBlue],
        Style[RegularPolygon[f, g, e], White],
        Style[RegularPolygon[g, h, d], LightBlue],
        Style[RegularPolygon[c, h, i], White],
        Style[RegularPolygon[a, i, j], LightBlue],
        Style[RegularPolygon[f, j, k], White],
        Style[RegularPolygon[k, l, g], LightBlue],
        Style[RegularPolygon[l, m, h], White],
        Style[RegularPolygon[m, n, i], LightBlue],
        GeometricAssertion[a, b, c, b, d, c, b, e, d, a, f, e, f,
        g, e, g, h, d, c, h, i, a, i, j, f, j, k, k, l,
        g, l, m, h, m, n, i, "Clockwise"]

        ] // RandomInstance


        enter image description here



        Now, because this is a full geometric solver, we can assign the Area of each triangle to a variable, and set the area of the smallest triangles (the centre pieces) to 1, and we can see that the area of each subsequent triangle is the square of its spiral position:



        scene = GeometricScene[a, b, c, d, e, f, g, h, i, j, k, l, m, 
        n, ar1, ar2, ar3, ar4, ar5, ar7, ar9, ar12, ar16,
        Area@RegularPolygon[a, b, c] == Area@RegularPolygon[b, d, c] ==
        Area@RegularPolygon[b, e, d] == ar1 == 1,
        Area@RegularPolygon[a, f, e] == Area@RegularPolygon[f, g, e] ==
        ar2,
        Area@RegularPolygon[g, h, d] == ar3,
        Area@RegularPolygon[c, h, i] == ar4,
        Area@RegularPolygon[a, i, j] == ar5,
        Area@RegularPolygon[f, j, k] == ar7,
        Area@RegularPolygon[k, l, g] == ar9,
        Area@RegularPolygon[l, m, h] == ar12,
        Area@RegularPolygon[m, n, i] == ar16,
        GeometricAssertion[a, b, c, b, d, c, b, e, d, a, f, e, f,
        g, e, g, h, d, c, h, i, a, i, j, f, j, k, k, l,
        g, l, m, h, m, n, i, "Clockwise"]

        ]

        inst = RandomInstance[scene]

        inst["Quantities"][[13 ;; 21]]



        ar1 -> 1., ar2 -> 4., ar3 -> -9., ar4 -> 16., ar5 -> 25., 
        ar7 -> -49., ar9 -> 81., ar12 -> 144., ar16 -> 256.



        (I am assuming that the negative values occur because the origin is the first point of the centre triangle, but I haven't tested.)



        If we are patient enough, we can use FindGeometricConjectures to find out more interesting conjectures about our scene - for instance, that 3 sets of lines are necessarily parallel (each side of each triangle).



        enter image description here






        share|improve this answer











        $endgroup$

















          17












          $begingroup$

          You can do this rather nicely with GeometricScene.



          scene = GeometricScene[
          a, b, c, d, e, f, g, h, i, j, k, l, m, n,
          RegularPolygon[a, b, c], RegularPolygon[b, d, c],
          RegularPolygon[b, e, d],
          RegularPolygon[a, f, e], RegularPolygon[f, g, e],
          RegularPolygon[g, h, d],
          RegularPolygon[c, h, i],
          RegularPolygon[a, i, j],
          RegularPolygon[f, j, k],
          RegularPolygon[k, l, g],
          RegularPolygon[l, m, h],
          RegularPolygon[m, n, i],
          GeometricAssertion[a, b, c, b, d, c, b, e, d, a, f, e, f,
          g, e, g, h, d, c, h, i, a, i, j, f, j, k, k, l,
          g, l, m, h, m, n, i, "Clockwise"]

          ]

          RandomInstance[scene]


          enter image description here



          We can use Style to colour the triangles:



          GeometricScene[a, b, c, d, e, f, g, h, i, j, k, l, m, n,
          Style[RegularPolygon[a, b, c], White],
          Style[RegularPolygon[b, d, c], LightBlue],
          Style[RegularPolygon[b, e, d], White],
          Style[RegularPolygon[a, f, e], LightBlue],
          Style[RegularPolygon[f, g, e], White],
          Style[RegularPolygon[g, h, d], LightBlue],
          Style[RegularPolygon[c, h, i], White],
          Style[RegularPolygon[a, i, j], LightBlue],
          Style[RegularPolygon[f, j, k], White],
          Style[RegularPolygon[k, l, g], LightBlue],
          Style[RegularPolygon[l, m, h], White],
          Style[RegularPolygon[m, n, i], LightBlue],
          GeometricAssertion[a, b, c, b, d, c, b, e, d, a, f, e, f,
          g, e, g, h, d, c, h, i, a, i, j, f, j, k, k, l,
          g, l, m, h, m, n, i, "Clockwise"]

          ] // RandomInstance


          enter image description here



          Now, because this is a full geometric solver, we can assign the Area of each triangle to a variable, and set the area of the smallest triangles (the centre pieces) to 1, and we can see that the area of each subsequent triangle is the square of its spiral position:



          scene = GeometricScene[a, b, c, d, e, f, g, h, i, j, k, l, m, 
          n, ar1, ar2, ar3, ar4, ar5, ar7, ar9, ar12, ar16,
          Area@RegularPolygon[a, b, c] == Area@RegularPolygon[b, d, c] ==
          Area@RegularPolygon[b, e, d] == ar1 == 1,
          Area@RegularPolygon[a, f, e] == Area@RegularPolygon[f, g, e] ==
          ar2,
          Area@RegularPolygon[g, h, d] == ar3,
          Area@RegularPolygon[c, h, i] == ar4,
          Area@RegularPolygon[a, i, j] == ar5,
          Area@RegularPolygon[f, j, k] == ar7,
          Area@RegularPolygon[k, l, g] == ar9,
          Area@RegularPolygon[l, m, h] == ar12,
          Area@RegularPolygon[m, n, i] == ar16,
          GeometricAssertion[a, b, c, b, d, c, b, e, d, a, f, e, f,
          g, e, g, h, d, c, h, i, a, i, j, f, j, k, k, l,
          g, l, m, h, m, n, i, "Clockwise"]

          ]

          inst = RandomInstance[scene]

          inst["Quantities"][[13 ;; 21]]



          ar1 -> 1., ar2 -> 4., ar3 -> -9., ar4 -> 16., ar5 -> 25., 
          ar7 -> -49., ar9 -> 81., ar12 -> 144., ar16 -> 256.



          (I am assuming that the negative values occur because the origin is the first point of the centre triangle, but I haven't tested.)



          If we are patient enough, we can use FindGeometricConjectures to find out more interesting conjectures about our scene - for instance, that 3 sets of lines are necessarily parallel (each side of each triangle).



          enter image description here






          share|improve this answer











          $endgroup$















            17












            17








            17





            $begingroup$

            You can do this rather nicely with GeometricScene.



            scene = GeometricScene[
            a, b, c, d, e, f, g, h, i, j, k, l, m, n,
            RegularPolygon[a, b, c], RegularPolygon[b, d, c],
            RegularPolygon[b, e, d],
            RegularPolygon[a, f, e], RegularPolygon[f, g, e],
            RegularPolygon[g, h, d],
            RegularPolygon[c, h, i],
            RegularPolygon[a, i, j],
            RegularPolygon[f, j, k],
            RegularPolygon[k, l, g],
            RegularPolygon[l, m, h],
            RegularPolygon[m, n, i],
            GeometricAssertion[a, b, c, b, d, c, b, e, d, a, f, e, f,
            g, e, g, h, d, c, h, i, a, i, j, f, j, k, k, l,
            g, l, m, h, m, n, i, "Clockwise"]

            ]

            RandomInstance[scene]


            enter image description here



            We can use Style to colour the triangles:



            GeometricScene[a, b, c, d, e, f, g, h, i, j, k, l, m, n,
            Style[RegularPolygon[a, b, c], White],
            Style[RegularPolygon[b, d, c], LightBlue],
            Style[RegularPolygon[b, e, d], White],
            Style[RegularPolygon[a, f, e], LightBlue],
            Style[RegularPolygon[f, g, e], White],
            Style[RegularPolygon[g, h, d], LightBlue],
            Style[RegularPolygon[c, h, i], White],
            Style[RegularPolygon[a, i, j], LightBlue],
            Style[RegularPolygon[f, j, k], White],
            Style[RegularPolygon[k, l, g], LightBlue],
            Style[RegularPolygon[l, m, h], White],
            Style[RegularPolygon[m, n, i], LightBlue],
            GeometricAssertion[a, b, c, b, d, c, b, e, d, a, f, e, f,
            g, e, g, h, d, c, h, i, a, i, j, f, j, k, k, l,
            g, l, m, h, m, n, i, "Clockwise"]

            ] // RandomInstance


            enter image description here



            Now, because this is a full geometric solver, we can assign the Area of each triangle to a variable, and set the area of the smallest triangles (the centre pieces) to 1, and we can see that the area of each subsequent triangle is the square of its spiral position:



            scene = GeometricScene[a, b, c, d, e, f, g, h, i, j, k, l, m, 
            n, ar1, ar2, ar3, ar4, ar5, ar7, ar9, ar12, ar16,
            Area@RegularPolygon[a, b, c] == Area@RegularPolygon[b, d, c] ==
            Area@RegularPolygon[b, e, d] == ar1 == 1,
            Area@RegularPolygon[a, f, e] == Area@RegularPolygon[f, g, e] ==
            ar2,
            Area@RegularPolygon[g, h, d] == ar3,
            Area@RegularPolygon[c, h, i] == ar4,
            Area@RegularPolygon[a, i, j] == ar5,
            Area@RegularPolygon[f, j, k] == ar7,
            Area@RegularPolygon[k, l, g] == ar9,
            Area@RegularPolygon[l, m, h] == ar12,
            Area@RegularPolygon[m, n, i] == ar16,
            GeometricAssertion[a, b, c, b, d, c, b, e, d, a, f, e, f,
            g, e, g, h, d, c, h, i, a, i, j, f, j, k, k, l,
            g, l, m, h, m, n, i, "Clockwise"]

            ]

            inst = RandomInstance[scene]

            inst["Quantities"][[13 ;; 21]]



            ar1 -> 1., ar2 -> 4., ar3 -> -9., ar4 -> 16., ar5 -> 25., 
            ar7 -> -49., ar9 -> 81., ar12 -> 144., ar16 -> 256.



            (I am assuming that the negative values occur because the origin is the first point of the centre triangle, but I haven't tested.)



            If we are patient enough, we can use FindGeometricConjectures to find out more interesting conjectures about our scene - for instance, that 3 sets of lines are necessarily parallel (each side of each triangle).



            enter image description here






            share|improve this answer











            $endgroup$



            You can do this rather nicely with GeometricScene.



            scene = GeometricScene[
            a, b, c, d, e, f, g, h, i, j, k, l, m, n,
            RegularPolygon[a, b, c], RegularPolygon[b, d, c],
            RegularPolygon[b, e, d],
            RegularPolygon[a, f, e], RegularPolygon[f, g, e],
            RegularPolygon[g, h, d],
            RegularPolygon[c, h, i],
            RegularPolygon[a, i, j],
            RegularPolygon[f, j, k],
            RegularPolygon[k, l, g],
            RegularPolygon[l, m, h],
            RegularPolygon[m, n, i],
            GeometricAssertion[a, b, c, b, d, c, b, e, d, a, f, e, f,
            g, e, g, h, d, c, h, i, a, i, j, f, j, k, k, l,
            g, l, m, h, m, n, i, "Clockwise"]

            ]

            RandomInstance[scene]


            enter image description here



            We can use Style to colour the triangles:



            GeometricScene[a, b, c, d, e, f, g, h, i, j, k, l, m, n,
            Style[RegularPolygon[a, b, c], White],
            Style[RegularPolygon[b, d, c], LightBlue],
            Style[RegularPolygon[b, e, d], White],
            Style[RegularPolygon[a, f, e], LightBlue],
            Style[RegularPolygon[f, g, e], White],
            Style[RegularPolygon[g, h, d], LightBlue],
            Style[RegularPolygon[c, h, i], White],
            Style[RegularPolygon[a, i, j], LightBlue],
            Style[RegularPolygon[f, j, k], White],
            Style[RegularPolygon[k, l, g], LightBlue],
            Style[RegularPolygon[l, m, h], White],
            Style[RegularPolygon[m, n, i], LightBlue],
            GeometricAssertion[a, b, c, b, d, c, b, e, d, a, f, e, f,
            g, e, g, h, d, c, h, i, a, i, j, f, j, k, k, l,
            g, l, m, h, m, n, i, "Clockwise"]

            ] // RandomInstance


            enter image description here



            Now, because this is a full geometric solver, we can assign the Area of each triangle to a variable, and set the area of the smallest triangles (the centre pieces) to 1, and we can see that the area of each subsequent triangle is the square of its spiral position:



            scene = GeometricScene[a, b, c, d, e, f, g, h, i, j, k, l, m, 
            n, ar1, ar2, ar3, ar4, ar5, ar7, ar9, ar12, ar16,
            Area@RegularPolygon[a, b, c] == Area@RegularPolygon[b, d, c] ==
            Area@RegularPolygon[b, e, d] == ar1 == 1,
            Area@RegularPolygon[a, f, e] == Area@RegularPolygon[f, g, e] ==
            ar2,
            Area@RegularPolygon[g, h, d] == ar3,
            Area@RegularPolygon[c, h, i] == ar4,
            Area@RegularPolygon[a, i, j] == ar5,
            Area@RegularPolygon[f, j, k] == ar7,
            Area@RegularPolygon[k, l, g] == ar9,
            Area@RegularPolygon[l, m, h] == ar12,
            Area@RegularPolygon[m, n, i] == ar16,
            GeometricAssertion[a, b, c, b, d, c, b, e, d, a, f, e, f,
            g, e, g, h, d, c, h, i, a, i, j, f, j, k, k, l,
            g, l, m, h, m, n, i, "Clockwise"]

            ]

            inst = RandomInstance[scene]

            inst["Quantities"][[13 ;; 21]]



            ar1 -> 1., ar2 -> 4., ar3 -> -9., ar4 -> 16., ar5 -> 25., 
            ar7 -> -49., ar9 -> 81., ar12 -> 144., ar16 -> 256.



            (I am assuming that the negative values occur because the origin is the first point of the centre triangle, but I haven't tested.)



            If we are patient enough, we can use FindGeometricConjectures to find out more interesting conjectures about our scene - for instance, that 3 sets of lines are necessarily parallel (each side of each triangle).



            enter image description here







            share|improve this answer














            share|improve this answer



            share|improve this answer








            edited May 12 at 19:52

























            answered May 5 at 12:49









            Carl LangeCarl Lange

            6,38411547




            6,38411547





















                6












                $begingroup$

                ** THIS IS AN EXTENDED COMMENT RATHER THAN AN ANSWER **



                As a start, you can find the size of the nth triangle using FindSequenceFunction



                seq = 1, 1, 1, 2, 2, 3, 4, 5, 7, 9, 12, 16;

                f[n_] = FindSequenceFunction[seq, n]


                enter image description here



                The result is expressed as Root objects. To convert to radicals with ToRadicals,



                f2[n_] = f[n] // ToRadicals // Simplify


                enter image description here



                seq2 = f /@ Range[16] // RootReduce

                (* 1, 1, 1, 2, 2, 3, 4, 5, 7, 9, 12, 16, 21, 28, 37, 49 *)

                seq2 == f2 /@ Range[16] // FullSimplify

                (* True *)


                As expected, both forms give the same result. Plotting,



                DiscretePlot[f[n], n, 1, 16]


                enter image description here



                Alternatively, using RSolve



                f3[n_] = a[n] /. 
                RSolve[a[n] == a[n - 2] + a[n - 3], a[1] == 1, a[2] == 1, a[3] == 1,
                a[n], n][[1]]


                enter image description here






                share|improve this answer









                $endgroup$

















                  6












                  $begingroup$

                  ** THIS IS AN EXTENDED COMMENT RATHER THAN AN ANSWER **



                  As a start, you can find the size of the nth triangle using FindSequenceFunction



                  seq = 1, 1, 1, 2, 2, 3, 4, 5, 7, 9, 12, 16;

                  f[n_] = FindSequenceFunction[seq, n]


                  enter image description here



                  The result is expressed as Root objects. To convert to radicals with ToRadicals,



                  f2[n_] = f[n] // ToRadicals // Simplify


                  enter image description here



                  seq2 = f /@ Range[16] // RootReduce

                  (* 1, 1, 1, 2, 2, 3, 4, 5, 7, 9, 12, 16, 21, 28, 37, 49 *)

                  seq2 == f2 /@ Range[16] // FullSimplify

                  (* True *)


                  As expected, both forms give the same result. Plotting,



                  DiscretePlot[f[n], n, 1, 16]


                  enter image description here



                  Alternatively, using RSolve



                  f3[n_] = a[n] /. 
                  RSolve[a[n] == a[n - 2] + a[n - 3], a[1] == 1, a[2] == 1, a[3] == 1,
                  a[n], n][[1]]


                  enter image description here






                  share|improve this answer









                  $endgroup$















                    6












                    6








                    6





                    $begingroup$

                    ** THIS IS AN EXTENDED COMMENT RATHER THAN AN ANSWER **



                    As a start, you can find the size of the nth triangle using FindSequenceFunction



                    seq = 1, 1, 1, 2, 2, 3, 4, 5, 7, 9, 12, 16;

                    f[n_] = FindSequenceFunction[seq, n]


                    enter image description here



                    The result is expressed as Root objects. To convert to radicals with ToRadicals,



                    f2[n_] = f[n] // ToRadicals // Simplify


                    enter image description here



                    seq2 = f /@ Range[16] // RootReduce

                    (* 1, 1, 1, 2, 2, 3, 4, 5, 7, 9, 12, 16, 21, 28, 37, 49 *)

                    seq2 == f2 /@ Range[16] // FullSimplify

                    (* True *)


                    As expected, both forms give the same result. Plotting,



                    DiscretePlot[f[n], n, 1, 16]


                    enter image description here



                    Alternatively, using RSolve



                    f3[n_] = a[n] /. 
                    RSolve[a[n] == a[n - 2] + a[n - 3], a[1] == 1, a[2] == 1, a[3] == 1,
                    a[n], n][[1]]


                    enter image description here






                    share|improve this answer









                    $endgroup$



                    ** THIS IS AN EXTENDED COMMENT RATHER THAN AN ANSWER **



                    As a start, you can find the size of the nth triangle using FindSequenceFunction



                    seq = 1, 1, 1, 2, 2, 3, 4, 5, 7, 9, 12, 16;

                    f[n_] = FindSequenceFunction[seq, n]


                    enter image description here



                    The result is expressed as Root objects. To convert to radicals with ToRadicals,



                    f2[n_] = f[n] // ToRadicals // Simplify


                    enter image description here



                    seq2 = f /@ Range[16] // RootReduce

                    (* 1, 1, 1, 2, 2, 3, 4, 5, 7, 9, 12, 16, 21, 28, 37, 49 *)

                    seq2 == f2 /@ Range[16] // FullSimplify

                    (* True *)


                    As expected, both forms give the same result. Plotting,



                    DiscretePlot[f[n], n, 1, 16]


                    enter image description here



                    Alternatively, using RSolve



                    f3[n_] = a[n] /. 
                    RSolve[a[n] == a[n - 2] + a[n - 3], a[1] == 1, a[2] == 1, a[3] == 1,
                    a[n], n][[1]]


                    enter image description here







                    share|improve this answer












                    share|improve this answer



                    share|improve this answer










                    answered May 5 at 4:57









                    Bob HanlonBob Hanlon

                    62.5k33599




                    62.5k33599





















                        6












                        $begingroup$

                        Below is my (not quite right) attempt. However, now that we've seen the Wolfram demo link, I think that their code will be more helpful.



                        nextTriangle[oppositept_, firstedge_] := Module[f = firstedge, p,
                        p = (f[[1, 1]] + f[[2, 1]] + Sqrt[3.] (f[[1, 2]] - f[[2, 2]]))/2,
                        (f[[1, 2]] + f[[2, 2]] - Sqrt[3.] (f[[1, 1]] - f[[2, 1]]))/2,
                        (f[[1, 1]] + f[[2, 1]] - Sqrt[3.] (f[[1, 2]] - f[[2, 2]]))/2,
                        (f[[1, 2]] + f[[2, 2]] + Sqrt[3.] (f[[1, 1]] - f[[2, 1]]))/2;
                        firstedge[[1]], firstedge[[2]],
                        Chop[First[Sort[p, EuclideanDistance[#1, oppositept] > EuclideanDistance[#2, oppositept] &]]]
                        ]

                        n = 12;
                        triangles = 0, Sqrt[3.], -1, 0, 1, 0;
                        Do[
                        t = Last[triangles];
                        nextedge = t[[1, 3]];
                        edgefit = Fit[nextedge, 1, x, x];
                        allpts = Flatten[triangles, 1];
                        colinearpos = Boole[Chop[edgefit /. x -> #[[1]]] == #[[2]] & /@ allpts];
                        colinearpts = Cases[Transpose[allpts, colinearpos], x_, 1 -> x];
                        line = First[Sort[colinearpts, EuclideanDistance[#1, t[[3]]] > EuclideanDistance[#2, t[[3]]] &]], t[[3]];
                        nextt = nextTriangle[t[[2]], line];
                        AppendTo[triangles, nextt];
                        , i, 1, n - 1]

                        Graphics[Table[If[EvenQ[n], LightBlue, White], EdgeForm[Thin],
                        Polygon[triangles[[n]]], n, 1, Length[triangles]]]


                        enter image description here






                        share|improve this answer











                        $endgroup$

















                          6












                          $begingroup$

                          Below is my (not quite right) attempt. However, now that we've seen the Wolfram demo link, I think that their code will be more helpful.



                          nextTriangle[oppositept_, firstedge_] := Module[f = firstedge, p,
                          p = (f[[1, 1]] + f[[2, 1]] + Sqrt[3.] (f[[1, 2]] - f[[2, 2]]))/2,
                          (f[[1, 2]] + f[[2, 2]] - Sqrt[3.] (f[[1, 1]] - f[[2, 1]]))/2,
                          (f[[1, 1]] + f[[2, 1]] - Sqrt[3.] (f[[1, 2]] - f[[2, 2]]))/2,
                          (f[[1, 2]] + f[[2, 2]] + Sqrt[3.] (f[[1, 1]] - f[[2, 1]]))/2;
                          firstedge[[1]], firstedge[[2]],
                          Chop[First[Sort[p, EuclideanDistance[#1, oppositept] > EuclideanDistance[#2, oppositept] &]]]
                          ]

                          n = 12;
                          triangles = 0, Sqrt[3.], -1, 0, 1, 0;
                          Do[
                          t = Last[triangles];
                          nextedge = t[[1, 3]];
                          edgefit = Fit[nextedge, 1, x, x];
                          allpts = Flatten[triangles, 1];
                          colinearpos = Boole[Chop[edgefit /. x -> #[[1]]] == #[[2]] & /@ allpts];
                          colinearpts = Cases[Transpose[allpts, colinearpos], x_, 1 -> x];
                          line = First[Sort[colinearpts, EuclideanDistance[#1, t[[3]]] > EuclideanDistance[#2, t[[3]]] &]], t[[3]];
                          nextt = nextTriangle[t[[2]], line];
                          AppendTo[triangles, nextt];
                          , i, 1, n - 1]

                          Graphics[Table[If[EvenQ[n], LightBlue, White], EdgeForm[Thin],
                          Polygon[triangles[[n]]], n, 1, Length[triangles]]]


                          enter image description here






                          share|improve this answer











                          $endgroup$















                            6












                            6








                            6





                            $begingroup$

                            Below is my (not quite right) attempt. However, now that we've seen the Wolfram demo link, I think that their code will be more helpful.



                            nextTriangle[oppositept_, firstedge_] := Module[f = firstedge, p,
                            p = (f[[1, 1]] + f[[2, 1]] + Sqrt[3.] (f[[1, 2]] - f[[2, 2]]))/2,
                            (f[[1, 2]] + f[[2, 2]] - Sqrt[3.] (f[[1, 1]] - f[[2, 1]]))/2,
                            (f[[1, 1]] + f[[2, 1]] - Sqrt[3.] (f[[1, 2]] - f[[2, 2]]))/2,
                            (f[[1, 2]] + f[[2, 2]] + Sqrt[3.] (f[[1, 1]] - f[[2, 1]]))/2;
                            firstedge[[1]], firstedge[[2]],
                            Chop[First[Sort[p, EuclideanDistance[#1, oppositept] > EuclideanDistance[#2, oppositept] &]]]
                            ]

                            n = 12;
                            triangles = 0, Sqrt[3.], -1, 0, 1, 0;
                            Do[
                            t = Last[triangles];
                            nextedge = t[[1, 3]];
                            edgefit = Fit[nextedge, 1, x, x];
                            allpts = Flatten[triangles, 1];
                            colinearpos = Boole[Chop[edgefit /. x -> #[[1]]] == #[[2]] & /@ allpts];
                            colinearpts = Cases[Transpose[allpts, colinearpos], x_, 1 -> x];
                            line = First[Sort[colinearpts, EuclideanDistance[#1, t[[3]]] > EuclideanDistance[#2, t[[3]]] &]], t[[3]];
                            nextt = nextTriangle[t[[2]], line];
                            AppendTo[triangles, nextt];
                            , i, 1, n - 1]

                            Graphics[Table[If[EvenQ[n], LightBlue, White], EdgeForm[Thin],
                            Polygon[triangles[[n]]], n, 1, Length[triangles]]]


                            enter image description here






                            share|improve this answer











                            $endgroup$



                            Below is my (not quite right) attempt. However, now that we've seen the Wolfram demo link, I think that their code will be more helpful.



                            nextTriangle[oppositept_, firstedge_] := Module[f = firstedge, p,
                            p = (f[[1, 1]] + f[[2, 1]] + Sqrt[3.] (f[[1, 2]] - f[[2, 2]]))/2,
                            (f[[1, 2]] + f[[2, 2]] - Sqrt[3.] (f[[1, 1]] - f[[2, 1]]))/2,
                            (f[[1, 1]] + f[[2, 1]] - Sqrt[3.] (f[[1, 2]] - f[[2, 2]]))/2,
                            (f[[1, 2]] + f[[2, 2]] + Sqrt[3.] (f[[1, 1]] - f[[2, 1]]))/2;
                            firstedge[[1]], firstedge[[2]],
                            Chop[First[Sort[p, EuclideanDistance[#1, oppositept] > EuclideanDistance[#2, oppositept] &]]]
                            ]

                            n = 12;
                            triangles = 0, Sqrt[3.], -1, 0, 1, 0;
                            Do[
                            t = Last[triangles];
                            nextedge = t[[1, 3]];
                            edgefit = Fit[nextedge, 1, x, x];
                            allpts = Flatten[triangles, 1];
                            colinearpos = Boole[Chop[edgefit /. x -> #[[1]]] == #[[2]] & /@ allpts];
                            colinearpts = Cases[Transpose[allpts, colinearpos], x_, 1 -> x];
                            line = First[Sort[colinearpts, EuclideanDistance[#1, t[[3]]] > EuclideanDistance[#2, t[[3]]] &]], t[[3]];
                            nextt = nextTriangle[t[[2]], line];
                            AppendTo[triangles, nextt];
                            , i, 1, n - 1]

                            Graphics[Table[If[EvenQ[n], LightBlue, White], EdgeForm[Thin],
                            Polygon[triangles[[n]]], n, 1, Length[triangles]]]


                            enter image description here







                            share|improve this answer














                            share|improve this answer



                            share|improve this answer








                            edited May 5 at 12:07

























                            answered May 5 at 11:22









                            MelaGoMelaGo

                            1,23517




                            1,23517



























                                draft saved

                                draft discarded
















































                                Thanks for contributing an answer to Mathematica Stack Exchange!


                                • Please be sure to answer the question. Provide details and share your research!

                                But avoid


                                • Asking for help, clarification, or responding to other answers.

                                • Making statements based on opinion; back them up with references or personal experience.

                                Use MathJax to format equations. MathJax reference.


                                To learn more, see our tips on writing great answers.




                                draft saved


                                draft discarded














                                StackExchange.ready(
                                function ()
                                StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f197697%2fhow-to-do-this-padovan-spiral-using-mathematica%23new-answer', 'question_page');

                                );

                                Post as a guest















                                Required, but never shown





















































                                Required, but never shown














                                Required, but never shown












                                Required, but never shown







                                Required, but never shown

































                                Required, but never shown














                                Required, but never shown












                                Required, but never shown







                                Required, but never shown







                                Popular posts from this blog

                                Wikipedia:Vital articles Мазмуну Biography - Өмүр баян Philosophy and psychology - Философия жана психология Religion - Дин Social sciences - Коомдук илимдер Language and literature - Тил жана адабият Science - Илим Technology - Технология Arts and recreation - Искусство жана эс алуу History and geography - Тарых жана география Навигация менюсу

                                Bruxelas-Capital Índice Historia | Composición | Situación lingüística | Clima | Cidades irmandadas | Notas | Véxase tamén | Menú de navegacióneO uso das linguas en Bruxelas e a situación do neerlandés"Rexión de Bruxelas Capital"o orixinalSitio da rexiónPáxina de Bruselas no sitio da Oficina de Promoción Turística de Valonia e BruxelasMapa Interactivo da Rexión de Bruxelas-CapitaleeWorldCat332144929079854441105155190212ID28008674080552-90000 0001 0666 3698n94104302ID540940339365017018237

                                What should I write in an apology letter, since I have decided not to join a company after accepting an offer letterShould I keep looking after accepting a job offer?What should I do when I've been verbally told I would get an offer letter, but still haven't gotten one after 4 weeks?Do I accept an offer from a company that I am not likely to join?New job hasn't confirmed starting date and I want to give current employer as much notice as possibleHow should I address my manager in my resignation letter?HR delayed background verification, now jobless as resignedNo email communication after accepting a formal written offer. How should I phrase the call?What should I do if after receiving a verbal offer letter I am informed that my written job offer is put on hold due to some internal issues?Should I inform the current employer that I am about to resign within 1-2 weeks since I have signed the offer letter and waiting for visa?What company will do, if I send their offer letter to another company