New fractal based on the Golden mean/ Fibonacci numbers
- To: mathgroup at smc.vnet.net
- Subject: [mg65290] New fractal based on the Golden mean/ Fibonacci numbers
- From: Roger Bagula <rlbagulatftn at yahoo.com>
- Date: Fri, 24 Mar 2006 00:59:47 -0500 (EST)
- Sender: owner-wri-mathgroup at wolfram.com
I was thumbing through my book on Continuum Mechanics looking for a
specific fact when I saw Mohr circles.
I said:" wow, those are half plane modular form tessellation just like
in the Elliptic curves book."
They are forming half plane "triangles" in the Moebius/ bilinear
transform sense.
A little thought and a minimum of consultation in the Mathematica
reference book
and I had a Mohr circle based Fibonacci tessellation
that represents an actual physical application of the golden mean.
I've done a Goggle search and it appears nobody has thought of this before
or put this set of 2 plus 2 together and got 4!
I tried it for the next higher Bonaccis and it doesn't give this pleasing
well formed set of curves.
As most people in complex analysis know there is a classical half plane
to disk transform
that makes tessellations like this into tiling of the unit disk.
These remind one of Ford circles, but they are definitely their kind
that seems to be both unique and new.
Here is the very simple notebook for generating this marvel:
Clear[c, r, n]
(* centers of Mohr stresses*)
c[n_, 3] := (Fibonacci[n] + Fibonacci[n + 1])/2
c[n_, 2] := (Fibonacci[n] + Fibonacci[n + 2])/2
c[n_, 1] := (Fibonacci[n + 1] + Fibonacci[n + 2])/2
(* radius of Shear Stress*)
r[n_, 0] := Abs[(Fibonacci[n + 1] - Fibonacci[n + 2])/2]
r[n_, 1] := Abs[Fibonacci[n] - (Fibonacci[n + 1] + Fibonacci[n + 2])/2]
r[n_, 2] := Abs[(Fibonacci[n] - Fibonacci[n + 2])/2]
r[n_, 3] := Abs[Fibonacci[n + 1] - (Fibonacci[n] + Fibonacci[n + 2])/2]
r[n_, 4] := Abs[(Fibonacci[n] - Fibonacci[n + 1])/2]
r[n_, 5] := Abs[Fibonacci[n + 2] - (Fibonacci[n] + Fibonacci[n + 1])/2]
a = Flatten[Table[{Circle[{c[n, i + 1], 0}, r[n, 2*i +
j], {0, Pi}]}, {i, 0, 2}, {j, 0, 1}, {n, 1, 25}]];
Show[Graphics[a], AspectRatio -> Automatic, PlotRange -> All]
Roger L. Bagula { email: rlbagula at sbcglobal.net or rlbagulatftn at yahoo.com }
11759 Waterhill Road,
Lakeside, Ca. 92040 telephone: 619-561-0814