Message Boards Message Boards

9
|
25335 Views
|
6 Replies
|
42 Total Likes
View groups...
Share
Share this post:

New fractal curve from golden ratio: how to generate Harriss spiral?

Vitaliy Kaurov, WOLFRAM Research
Posted 10 years ago
POSTED BY: Vitaliy Kaurov
6 Replies
Sort By:

Here is an old piece of code from many years ago that does something similar:

circlesOnCircles[?_, ?_, ?_, iter_] :=
Module[{C, ?, cp, \[ScriptD], ?, ?},
C[?[mp_, r_, {?_, ?_}, -1, i_]] :=
(cp = mp + r (\[ScriptD] = {Cos[?], Sin[?]});
? = ?.{r, 1/i}; ? = ?.{? - ?, i};
{?[cp + \[ScriptD] ?, ?, {? - Pi - ?, ? - Pi}, 1, i + 1],
 ?[cp - \[ScriptD] ?, ?, {?, ? + ?}, -1, i + 1]});
C[?[mp_, r_, {?_, ?_}, 1, i_]] :=
(cp = mp + r (\[ScriptD] = {Cos[?], Sin[?]});
? = ?.{r, 1/i}; ? = ?.{? - ?, i};
{?[cp + \[ScriptD] ?, ?, {? - Pi, ? - Pi + ?}, -1, i + 1],
 ?[cp - \[ScriptD] ?, ?, {? - ?, ?}, 1, i + 1]});
Graphics[#, PlotRange -> All]& @
{Flatten[MapIndexed[{Thickness[0.01/#2[[1]]], Circle @@ Take[#,3]&/@#}&,
NestList[Flatten[C /@ #]&,
    Join[?[{0, 0}, 1, ?{-1, 1} Pi/2, #, 1]& /@ {-1, 1},
         ?[{2, 0}, 1, Pi + ?{-1, 1} Pi/2, #, 1]& /@ {-1, 1}], iter]]]}]

Manipulate[
           circlesOnCircles[?, ?, ?, iter] /.
 If[dcq, c_Circle :> {Opacity[op], Disk @@ c}, {}],
           {{iter, 5, "iterations"}, 1, 10, 1, ImageSize -> Small,
 Appearance -> "Labeled"},
          Delimiter,
             {{?, 1, "start segments"}, 0.1, 2,
 ImageSize -> Small},
           {{?, {0.37, 0.25}, "radii"}, {0, 0}, {2, 2},
 ImageSize -> Small},
           {{?, {0.17, 0.31}, "opening\nangles"}, {0, 0}, {1,
  1}, ImageSize -> Small},
          Delimiter,
         Row[{Control[{{dcq, False, "fill"}, {True, False}}], "  ",
  Control[{{op, 0.4, ""}, 0, 1, ImageSize -> Small}]}],
ControlPlacement -> Left]

enter image description here

Attachments:
POSTED BY: Michael Trott

The sides of the Harriss rectangle assuming the basic square has side 1:

{A, B} = N[{a, b} /. Solve[a/b == b/(a - 1) == 1/(b - 1), {a, b}][[1]]]

{2.32472, 1.75488}

A/B

1.32472

Recursive code. eps is a discretization to stop the iteration. The second argument tells whether we want to show the discretization process or not. p and q in the recursive function are the corners of the next rectangle to be subdivided:

HarrissSpiral[eps_, squares_] := 
  Graphics[{EdgeForm[Black], 
    HarrissSpiralStep[{0, 0}, {A, B}, eps, squares]}, 
   AspectRatio -> Automatic];
HarrissSpiralStep[p_, q_, eps_, squares_] := 
 If[EuclideanDistance[p, q] > eps,
  With[{
    r = p + (A - 1)/
        Sqrt[A^2 + B^2] RotationMatrix[-ArcTan[A, B]].(q - p),
    s = p + B/Sqrt[A^2 + B^2] RotationMatrix[ArcTan[B, A]].(q - p),
    t = p + Sqrt[1 + (A - 1)^2]/Sqrt[A^2 + B^2] (q - p)},
   {If[squares,
     {
      Black, Arrow[{p, q}],
      White, Rectangle[p, q],
      Blue, Rectangle[r, s],
      Orange, Rectangle[t, q]
      },
     {}
     ],
    Red, AbsoluteThickness[5 Norm[s - p]], 
    Circle[p + RotationMatrix[-Pi/4].(s - p)/Sqrt[2], 
     Norm[s - p]/Sqrt[2], ArcTan @@ (s - p) + {Pi/4, 3 Pi/4}],
    HarrissSpiralStep[r, s, eps, squares],
    HarrissSpiralStep[t, q, eps, squares]
    }],
  {}
  ]

Only a few iterations:

HarrissSpiral[0.8, True]

enter image description here

More iterations:

HarrissSpiral[0.1, True]

enter image description here

Show only the quarter circles:

HarrissSpiral[0.02, False]

enter image description here

To understand the idea, the key is to follow the arrows, which determine the orientation of the rectangles. There is a blue or orange rectangle and a quarter circle per arrow. Some arrows are overlapped. All arrows are parallel or perpendicular.

Graphics[{EdgeForm[Black], Opacity[0.3],  HarrissSpiralStep[{0, 0}, {A, B}, 0.7, True]}, 
     AspectRatio -> Automatic]

enter image description here

Attachments:
POSTED BY: Jose Martin-Garcia

This is spectacular, Jose! I am trying to understand the code, but would like to ask a few questions.

1) I know iterated function systems (IFS) can be generated with AffineTransform - is there any advantage of using AffineTransform here (if it is possible)?

2) Can your code generate other spirals (via A and B values maybe)? - quoting from the end of the article:

I asked if Harriss had looked for nice spirals with any of the other ratios? “Yes, but with limited success,” he sighed. “The problem is getting a set of squares that matches up in a nice order.” Here’s what he has come up with so far:

enter image description here
POSTED BY: Sam Carrettie
POSTED BY: Jose Martin-Garcia

Sam, would you happen to have the programs or algorithms for those other figures? At the bottom, the one on the left would fit in Nightmare Before Christmas, and the middle one would be perfect for The Book Of Kells.
POSTED BY: Svein Olav Nyberg
POSTED BY: Sam Carrettie
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Tag limit exceeded
Note: Only the first five people you tag will receive an email notification; the other tagged names will appear as links to their profiles.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract