New fractal based on the Golden mean/ Fibonacci numbers

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: or }

11759 Waterhill Road,
Lakeside, Ca. 92040 telephone: 619-561-0814

 

My aspect comes out two to one so that when roated 90 degrees it is
distorted, but this picture comes out fine:

(* Cartoon/ von Koch as Peak : Besicovitch - Ursell function*)
f[x_] := 0 /; 0 <= x <= 1/3
f[x_] := -2 + 6*x /; 1/3 < x <= 1/2
f[x_] := 4 - 6*x /; 1/2 < x <= 2/3
f[x_] := 0 /; 2/3 < x <= 1
ff[x_] := f[Mod[Abs[x], 1]]
Plot[f[Mod[Abs[x], 1]], {x, 0, 2}]
s0 = Log[2]/Log[3]
(* Cartoon/ as Sigmoid : Besicovitch - Ursell function*)
g[x_] := 0 /; 0 <= x <= 1/3
g[x_] := (3*x - 1) /; 1/3 < x <= 2/3
g[x_] := 1 /; 2/3 < x <= 1
gg[x_] := g[Mod[Abs[x], 1]]
ParametricPlot[{f[t], gg[t]}, {t, 0, 1}, Axes -> False]
Plot[gg[t], {t, 0, 2}]
hh[x_] = Sum[gg[3^k*x]/3^(s0*k), {k, 0, 20}];
kk[x_] = Sum[ff[3^k*(x)]/3^(s0*k), {k, 0, 20}];
a = Table[{kk[n/30000], hh[n/30000]}, {n, 1, 30000}];
ga = Show[Graphics[{PointSize[0.003], Point /@ a}], Axes -> False]