# Looking for a notebook with the "glowing gasket" [closed]

I look for an implementation of the "glowing gasket" as described in the book "Indra's Pearls" in Mathematica.

Here is a typical image:

I did a look at Wolfram Demonstrations and other sources but I did not find a notebook which can be downloaded.

In case of any hint, I would be glad, thank you.

Here is an example of the "kissing Schottky group", details can be found in the book of Indra's Pearls, the version of Felix Klein on page 170.

It works as follows:

1. we have two 2x2 complex matrices a,b together with their inverse matrices which are described in the book. Both matrices correspond to Moebius tranformations. Both matrices have to fulfill certain conditions (determinants are 1, trace(ba(b^-1) a^(-1))=1).
2. Four circles are drawn which have fulfill certain conditions.
3. Next we draw all combinations of the 4 matrices ('words' like aab(a^-1)b and so on) of length 7 (or may be larger) and multiply these matrices. We can neglect cases like a (a^-1).
4. Finally, these 'words' are applied to the 4 circles (center and radius is enough to know) and colorizes the disks.

and here is the glowing gasket...

That's it...

• And what if we do not have the book? Please provide or necessary information and let us know where are you stuck.
– Kuba
Commented Dec 24, 2020 at 9:45
• The necessary information is too complex to be described here. The point is the application of a DepthFirstScan. I thought somebody has already wrote a notebook. Commented Dec 24, 2020 at 14:55
• @Kuba I added a few links, although you need access to Cambridge University Press books (unless you want to google it) Commented Dec 24, 2020 at 15:06
• Paul Nylander's website has some nice Mathematica code for various fractals, including an Apollonian Gasket. Commented Dec 24, 2020 at 21:10
• @Wolfgang123 can you please show what you have done so far in the way of finding an answer to your question? Editing your question by putting in such information as is included in your comment to the only answer so far may be better for others who wish to answer this question in the future. I think even including what your idea of an algorithm to generate such visualizations might be would be useful, and in some coded format would be even better! Looks like an interesting question—I would enjoy seeing it answered! Commented Dec 25, 2020 at 1:48

Just a start:

Graphics[{Gray, Circle[],
Disk @@@ Flatten[
Table[1/(k^2 + 2) {{(-1)^r (-k^2 + 1), -2 (-1)^j k}, 1}, {k, 0,
9}, {j, 0, 1}, {r, 0, 1}], 2]}]


by way of an old post Minimalistic code challenge on Apollonian gaskets .

Towards a more complete solution, I always find it useful to analyze what such an image (e.g., from Indra's Pearls) does graphically to better understand what one may need to do Mathematically.

So...

I started by simply drawing blue circles on top of your originally posted image to identify what appear like the separate pieces assembled to create the image.

All the circles appear as overlapped Apollonian gaskets. The top 2 circles and the horizontal line at the middle of the original image defining black area, then a smaller Apollonian gasket fit within the black area.

The original image does have more going on in it, but by identifying the distinct pieces one can begin to build something to replicate it.

More to follow...

@Wolfgang123's comment points to a more elegant solution, but until someone posts it, I continue to build on my step-by-simple-step... (updated, knowing this has gotten a little silly).

disks = Disk @@@
Flatten[Table[
1/(k^2 + 2) {{(-1)^r (-k^2 + 1), -2 (-1)^j k}, 1}, {k, 0, 9}, {j,
0, 1}, {r, 0, 1}], 2];
littleCircle = Graphics[{Black, Circle[{0, 0.25}, {0.25, 0.25}]}];
square = Graphics[{Red, Rectangle[{-1, -1}, {1, 1}]}];
outer = Graphics[{Yellow, Thick, Circle[]}];
inner = Graphics[{EdgeForm[Directive[Thick, Yellow]], Opacity[0.5],
Orange, Thick, disks}];
arc1 = Graphics[Circle[{-1, 1}, 1, {4 Pi/2.666, 2 Pi}]];
arc2 = Graphics[Circle[{1, 1}, 1, {Pi/-1, -0.5 Pi}]];
Show[square, outer, inner, littleCircle,
arc1,
arc2,
Graphics[Circle[{1, 1}, 1, {Pi/-1, -0.5 Pi}]],
Graphics[Circle[{  0.000, 0.115}, {0.115, 0.115}]],
Graphics[Circle[{  0.123, 0.310}, {0.115, 0.115}]],
Graphics[Circle[{-0.115, 0.310}, {0.115, 0.115}]],
Graphics[Line[{{-1, 0}, {1, 0}}]]]


Possible next steps for further exploration...

As I've come to understand this.

One can obtain these "Indra's pearls" by inverting four tangent circles with centers A, B, C, & G on each other iteratively.

(Non-Mathematica generated image)

The limit set of the above process = a fractal packing of tangent circles or a "gasket" resembling the Sierpinski triangle gasket.

When the central circle of inversion does not sit tangent to the 3 others, but intersects them at specific angles like pi/3, pi/4, pi/5 ... then we gets other kinds of gaskets, e.g., for pi/3

(Non-Mathematica generated image)

• One needs two complex matrices (there is a very simple recipe how to compute them in the book), a and b which correspond to Moebius transformations. Next, long sequences (e.g. of length 500 or so) are computed, e.g. ab,a^-1,b^-1,a,a,a,b, etc. Then, an arbitrary initial value z0 is used, all matrices are multiplied together as well as with the initial value z0. This is simple and can easily be done. However, the point is the generation of the sequences, here a DepthFirstScan should be used. This is one crucial point. I guess some functions should be compiled, etc. Commented Dec 24, 2020 at 15:50

I'll let someone else do the coloring and other sundry operations. Instead, I'll show how to apply a Möbius transformation to a circle (code originally adapted from here):

moebiusCircle[{{a_, b_}, {c_, d_}}, Circle[{x0_, y0_}, r_]] :=
Block[{z0 = x0 + I y0, den}, den = Abs[c z0 + d]^2 - Abs[r c]^2;
Circle[ReIm[((a z0 + b) Conjugate[c z0 + d] - a Conjugate[c] r^2)/den],
r Abs[b c - a d]/den]]


With that,

amat = {{Sqrt[2], I}, {-I, Sqrt[2]}};
bmat = {{Sqrt[2], 1}, {1, Sqrt[2]}};
ainv = Inverse[amat]; binv = Inverse[bmat];

trList = DeleteDuplicates[Dot @@@ Tuples[N[{amat, bmat, ainv, binv}, 20], 7]];

circs = {Circle[ReIm[Sqrt[2]], 1], Circle[ReIm[I Sqrt[2]], 1],
Circle[ReIm[-Sqrt[2]], 1], Circle[ReIm[-I Sqrt[2]], 1]};

Graphics[Join[circs,
DeleteDuplicates[DeleteCases[Flatten[Outer[moebiusCircle, trList, circs, 1]],
Circle[_, _?Negative]]]]]


I wrote a notebook for the illustration of the "glowing gasket",

as described in the book "Indra's Pearl's: the Vision of Felix Klein" by D. Mumford, C. Series and D. Wright

The notebook is public available and includes some comments, how it works:

https://www.wolframcloud.com/obj/e76fd8c5-ed6c-4136-a7f8-eac578361363

and here is an illustration.