5
$\begingroup$

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

Here is a typical image:

glowing gasket (book Indra's perl)

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.

Parametrized kissing Schottky group

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...

glowing gasket

enter image description here

$\endgroup$
5
  • 10
    $\begingroup$ And what if we do not have the book? Please provide or necessary information and let us know where are you stuck. $\endgroup$
    – Kuba
    Dec 24, 2020 at 9:45
  • $\begingroup$ 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. $\endgroup$ Dec 24, 2020 at 14:55
  • 2
    $\begingroup$ @Kuba I added a few links, although you need access to Cambridge University Press books (unless you want to google it) $\endgroup$
    – Chris K
    Dec 24, 2020 at 15:06
  • 2
    $\begingroup$ Paul Nylander's website has some nice Mathematica code for various fractals, including an Apollonian Gasket. $\endgroup$ Dec 24, 2020 at 21:10
  • $\begingroup$ @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! $\endgroup$ Dec 25, 2020 at 1:48

3 Answers 3

10
$\begingroup$

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]}]

enter image description here

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...

enter image description here

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}}]]]

enter image description here

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.

enter image description here

(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

enter image description here

(Non-Mathematica generated image)

$\endgroup$
1
  • $\begingroup$ 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. $\endgroup$ Dec 24, 2020 at 15:50
3
$\begingroup$

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]]]]]

circle chain

$\endgroup$
2
$\begingroup$

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.

glowing gasket

$\endgroup$
0

Not the answer you're looking for? Browse other questions tagged or ask your own question.