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

                                Club Baloncesto Breogán Índice Historia | Pavillón | Nome | O Breogán na cultura popular | Xogadores | Adestradores | Presidentes | Palmarés | Historial | Líderes | Notas | Véxase tamén | Menú de navegacióncbbreogan.galCadroGuía oficial da ACB 2009-10, páxina 201Guía oficial ACB 1992, páxina 183. Editorial DB.É de 6.500 espectadores sentados axeitándose á última normativa"Estudiantes Junior, entre as mellores canteiras"o orixinalHemeroteca El Mundo Deportivo, 16 setembro de 1970, páxina 12Historia do BreogánAlfredo Pérez, o último canoneiroHistoria C.B. BreogánHemeroteca de El Mundo DeportivoJimmy Wright, norteamericano do Breogán deixará Lugo por ameazas de morteResultados de Breogán en 1986-87Resultados de Breogán en 1990-91Ficha de Velimir Perasović en acb.comResultados de Breogán en 1994-95Breogán arrasa al Barça. "El Mundo Deportivo", 27 de setembro de 1999, páxina 58CB Breogán - FC BarcelonaA FEB invita a participar nunha nova Liga EuropeaCharlie Bell na prensa estatalMáximos anotadores 2005Tempada 2005-06 : Tódolos Xogadores da Xornada""Non quero pensar nunha man negra, mais pregúntome que está a pasar""o orixinalRaúl López, orgulloso dos xogadores, presume da boa saúde económica do BreogánJulio González confirma que cesa como presidente del BreogánHomenaxe a Lisardo GómezA tempada do rexurdimento celesteEntrevista a Lisardo GómezEl COB dinamita el Pazo para forzar el quinto (69-73)Cafés Candelas, patrocinador del CB Breogán"Suso Lázare, novo presidente do Breogán"o orixinalCafés Candelas Breogán firma el mayor triunfo de la historiaEl Breogán realizará 17 homenajes por su cincuenta aniversario"O Breogán honra ao seu fundador e primeiro presidente"o orixinalMiguel Giao recibiu a homenaxe do PazoHomenaxe aos primeiros gladiadores celestesO home que nos amosa como ver o Breo co corazónTita Franco será homenaxeada polos #50anosdeBreoJulio Vila recibirá unha homenaxe in memoriam polos #50anosdeBreo"O Breogán homenaxeará aos seus aboados máis veteráns"Pechada ovación a «Capi» Sanmartín e Ricardo «Corazón de González»Homenaxe por décadas de informaciónPaco García volve ao Pazo con motivo do 50 aniversario"Resultados y clasificaciones""O Cafés Candelas Breogán, campión da Copa Princesa""O Cafés Candelas Breogán, equipo ACB"C.B. Breogán"Proxecto social"o orixinal"Centros asociados"o orixinalFicha en imdb.comMario Camus trata la recuperación del amor en 'La vieja música', su última película"Páxina web oficial""Club Baloncesto Breogán""C. B. Breogán S.A.D."eehttp://www.fegaba.com

                                Vilaño, A Laracha Índice Patrimonio | Lugares e parroquias | Véxase tamén | Menú de navegación43°14′52″N 8°36′03″O / 43.24775, -8.60070

                                Cegueira Índice Epidemioloxía | Deficiencia visual | Tipos de cegueira | Principais causas de cegueira | Tratamento | Técnicas de adaptación e axudas | Vida dos cegos | Primeiros auxilios | Crenzas respecto das persoas cegas | Crenzas das persoas cegas | O neno deficiente visual | Aspectos psicolóxicos da cegueira | Notas | Véxase tamén | Menú de navegación54.054.154.436928256blindnessDicionario da Real Academia GalegaPortal das Palabras"International Standards: Visual Standards — Aspects and Ranges of Vision Loss with Emphasis on Population Surveys.""Visual impairment and blindness""Presentan un plan para previr a cegueira"o orixinalACCDV Associació Catalana de Cecs i Disminuïts Visuals - PMFTrachoma"Effect of gene therapy on visual function in Leber's congenital amaurosis"1844137110.1056/NEJMoa0802268Cans guía - os mellores amigos dos cegosArquivadoEscola de cans guía para cegos en Mortágua, PortugalArquivado"Tecnología para ciegos y deficientes visuales. Recopilación de recursos gratuitos en la Red""Colorino""‘COL.diesis’, escuchar los sonidos del color""COL.diesis: Transforming Colour into Melody and Implementing the Result in a Colour Sensor Device"o orixinal"Sistema de desarrollo de sinestesia color-sonido para invidentes utilizando un protocolo de audio""Enseñanza táctil - geometría y color. Juegos didácticos para niños ciegos y videntes""Sistema Constanz"L'ocupació laboral dels cecs a l'Estat espanyol està pràcticament equiparada a la de les persones amb visió, entrevista amb Pedro ZuritaONCE (Organización Nacional de Cegos de España)Prevención da cegueiraDescrición de deficiencias visuais (Disc@pnet)Braillín, un boneco atractivo para calquera neno, con ou sen discapacidade, que permite familiarizarse co sistema de escritura e lectura brailleAxudas Técnicas36838ID00897494007150-90057129528256DOID:1432HP:0000618D001766C10.597.751.941.162C97109C0155020