Inversive Geometry

Part 1: Inverting Generalized Circles, Ellipses, Polygons, and Tilings

Jaime Rangel-Mondragón

This article explores the basic properties of inversive geometry from a computational point of view. Topics included in this part are involutions, generalized circles, and the inversion of segments, arcs, triangles, and quadrilaterals. The applications are to Nicomachus’s theorem, the inversion of tilings made by regular polygons, and an inversive spirograph.

Introduction

Geoff Smith, the author of [], describes the technique of inversion as a “dark art.” A suitable interpretation of this description is offered by [] as “an advanced technique, which can offer considerable advantage in solving certain problems.” This article examines the basic properties of inversive geometry, starting from the introduction of involutions and the family of generalized circles, the inversion of segments, arcs, triangles, and quadrilaterals with applications to Nicomachus’s theorem, the inversion of tilings made by regular polygons, and an inversive spirograph. This work extends and complements the material in [, , ].

Involutions

A transformation T that is not the identity with the property that T(T(z))=z is called an involution (or an involutory transformation, self-inverse, or of period two). Familiar examples of involutions are multiplication by -1 and taking a reciprocal in arithmetic, taking a complement in set theory, taking the conjugate of a complex number (i.e., (OverBar[x+i y])=x-i y, if x and y are real), geometrical reflection in a line, the matrix transpose and matrix inverse, and the mapping of a number x into a-x, with a an arbitrary number.

An important example of an involution involves permutations. A permutation under the operation of group composition is an involution if it is of order 2; that is, if it can be written as a product of disjoint transpositions (cycles of length 2). For example, the 7-permutation 5234176 maps 1->5, 2->2, 3->3, 4->4, 5->1, 6->7, 7->6; it factors into cycles as (15)(2)(3)(4)(67) or, leaving out the fixed points 2, 3, 4, as (15)(67).

PermutationCycles[{5,2,3,4,1,7,6}]

The number of involutory n-permutations grows quickly with n.

Table[Length[Select[Permutations[Range[n]],PermutationOrder[#]==2&]],{n,8}]

These numbers can also be readily obtained by solving a recurrence equation [].

Module[{a,n},RecurrenceTable[{a[1]==0,a[2]==1,a[n]==a[n-1]+(1+a[n-2])(n-1)},a[n],{n,20}]]

Consider reversion, f(z)=1/z, an involution that maps a nonzero complex number to its reciprocal. Let U be the unit circle given by the equation |z|=1 or (x^2)+(y^2)=1, with z=x+y i. It is easy to see that f maps the interior of U to its exterior and vice versa; that is, |z|>1 iff |f(z)|<1. Moreover, |f(z)|=1 iff |z|=1. Reversion maps the number z=x+y i into the number (Overscript[z, -])/|z((|)^2), where (Overscript[z, -]) is the conjugate of z. Considering a complex number as a point in the complex plane, if a point is close to the origin, its reversion is far away, and vice versa.

Here is the reversion of a complex number.

ComplexExpand[(1/(x+y I))]

Inversion, f(z)=1/(Overscript[z, -]), is an involution similar to reversion. For inversion, 0,z and f(z) are collinear for nonzero z. The point  z=x+y i inverts to the point z/|z((|)^2).

ComplexExpand[Conjugate[(1/(x+y I))]]

The following Manipulate compares reversion, inversion, and some similar transformations. Drag the point z; the arrow starts at z and ends at f(z) for the chosen transformation f; the interior of U is colored blue.

Manipulate[
Module[
{x,y,r,q},
If[Chop[Norm[Z]]==0,Z={0,.001}];
{x,y}=Z;
r=Norm[Z];
q=Switch[T,1,{x,- y}/(r^2),2,{x, y}/(r^2),3,{x,y}/r,4,{(x^2)-(y^2),-2 x y}/(r^4), 5,{(x^2)-(y^2),2 x y}/(r^4),6,{Cos[(1/2) ArcTan[x,y]],- Sin[(1/2) ArcTan[x,y]]}/(Sqrt[r])];
Graphics[{EdgeForm[Thick],ColorData[2,6],Disk[],Blue,Arrow[{Z,q}],Red,Disk[Z,.05],Disk[q,.05],Style[{Text[TraditionalForm[z],Z,{0,-1.5}],Text[TraditionalForm[f[z]],q,{-2,0}]},Black,14]},
Axes->True,PlotRange->3]
],
{{Z,{.5,.3}},Locator,Appearance->None},
Row[{Control@{{T,1,"f(z) ="},{1->1/z,2->(OverBar[(1/z)]) ,3->(z/(\[LeftBracketingBar]z\[RightBracketingBar])),4->(1/(z^2)) ,5->(OverBar[(1/(z^2))]) ,6->(1/(Sqrt[z]))},SetterBar},Spacer[20],"Drag the point z."}
],
TrackedSymbols:>{T,Z}]

Generalized Circles and Ellipses

A linear transformation maps the family of lines to itself. The following theorem suggests a family that may be preserved by inversion.

Theorem 1

Points (x,y) that satisfy the equation A((x^2)+(y^2))+B x+C y+D=0, with A, B, C, D real numbers, invert into points that satisfy the equation D((x^2)+(y^2))+B x+C y+A=0.

To verify this, apply the transformation corresponding to inversion of Cartesian points.

Simplify[A((x^2)+(y^2))+B x+C y+D /. {x->x/((x^2)+(y^2)),y->y/((x^2)+(y^2))}]

Let ⊖(A,B,C,D) be the set of points that satisfy the first equation in theorem 1. This four-parameter family includes points (for instance, when A=1 and D=(B^2)+(C^2)), lines (when A=0), circles (when A=1), the whole plane (when A=B=C=D=0), and the empty set (when A=B=C=0, D=1).

Define a generalized circle to be a line or circle. (The function generalizedCircle defined below constructs the graphics objects to draw the line or circle.) Under inversion, the generalized circle ⊖(A,B,C,D) transforms into the generalized circle ⊖(D,B,C,A). If A=0, (and A, B are not simultaneously 0), then ⊖(A,B,C,D) is a line. If A≠0, the equation A((x^2)+(y^2))+B x+C y+D=0 corresponds to a circle with center -(B,C)/(2A) and radius (Sqrt[(B^2)+(C^2)-4A D])/|2A|, provided that (B^2)+(C^2)≥4A D. If D=0, ⊖(A,B,C,D) passes through the origin. For any nonzero k, ⊖(A,B,C,D) is the same as ⊖(k A,k B,k C,k D).

Other families of polynomials in two variables that include generalized circles do not transform their members into members of the same family; that is, they are not closed under inversion. For instance, the six-parameter family of equations A (x^2)+B (y^2)+C x y+D x+F y+G=0 includes conic sections, but some invert into quartics.

Simplify[A (x^2)+B (y^2)+C x y+D x+F y+G/. {x->x/((x^2)+(y^2)),y->y/((x^2)+(y^2))}]

Theorem 2

A line passing through different points ((Subscript[x, 1]),(Subscript[y, 1])) and ((Subscript[x, 2]),(Subscript[y, 2])) corresponds to the generalized circle ⊖(0,(Subscript[y, 2])-(Subscript[y, 1]),(Subscript[x, 1])-(Subscript[x, 2]),(Subscript[x, 2])(Subscript[y, 1])-(Subscript[x, 1])(Subscript[y, 2])) if (Subscript[y, 1])≠(Subscript[y, 2]) and ⊖(0,0,1,-(Subscript[y, 1])) otherwise.

The parameters needed to describe such a line are obtained by solving the following equation.

Solve[x1+c y1+d==x2+c y2+d==0,{c,d}]

Theorem 3

A circle with center (α,β) and radius ρ corresponds to the generalized circle ⊖(1,-2α,-2β,(α^2)+(β^2)-(ρ^2)).

This result is readily obtained by expanding the Cartesian equation of such a circle.

Expand[(((x-α))^2)+(((y-β))^2)==(ρ^2)]

From a structural point of view, if a generalized circle is mapped to itself, it is said to be preserved by inversion. (Warning: that is not the same as saying that a point on a generalized circle is mapped to itself; for instance, a rotation about the center of a circle preserves the circle but moves each point of the circle.) In that case, A=D. If A=D=0, the line passes through the origin and each point is inverted into its negative. If A=D≠0, and (B^2)+(C^2)≥4(A^2), the circle A((x^2)+(y^2))+B x+C y+A=0 is preserved. Assume its center is at a point of the form (h,0). Then, in particular, the point (h-ρ,0) is inverted into the point (h+ρ,0).

Quiet@Solve[((d-ρ)/(((d-ρ))^2))==d+ρ,{d,ρ}]

Hence (ρ^2)+1=(d^2); that is, the origin, center, and either of the two intersection points of the circle and the unit circle U form a right triangle; hence the circle is orthogonal to U. This condition turns out to be necessary and sufficient for a generalized circle to be preserved. Theorem 1 implies the following results, which also apply conversely.

Any circle not passing through the origin inverts into a circle not passing through the origin (in fact passing through its intersection points with the unit circle U, if any).

Any circle passing through the origin inverts into a line not passing through the origin (in fact passing through its intersection points with U, if any; in general, this line is parallel to the tangent of the circle at the origin).

Any line passing through the origin is preserved by inversion (any point is mapped into its negative).

Any line not passing through the origin inverts into a circle passing through the origin (and its intersection points with U, if any).

To make inversion continuous, define the inversion of the origin to be a legal point, the “point at infinite,” ∞, making the phrase “nonzero” unnecessary when talking about inversion. Inversion is thus a one-to-one map of the extended plane.

Conversions of generalized circles to and from graphics primitives are handled by the following functions.

generalizedCircle[{}]={};

generalizedCircle[{0,B_,C_,D_}]:=If[Chop[B]==0,If[Chop[C]==0,{},Line[{{0,-D/C},{1,-D/C}}]],
If[Chop[C]==0,Line[{{-D/B,0},{-D/B,1}}],Line[{{0,-D/C},{1,(D-B)/C}}]]]

generalizedCircle[{A_,B_,C_,D_}]:=If[Chop[(B^2)+(C^2)-4 A D]<0,{},Circle[-{B,C}/(2 A),(Sqrt[(B^2)+(C^2)-4A D])/Abs[2A]]]

toGeneralizedCircle[{}]={};

toGeneralizedCircle[Circle[{α_,β_},ρ_]]:={1,-2α,-2β,(α^2)+(β^2)-(ρ^2)}

toGeneralizedCircle[Line[{{x1_,y1_},{x2_,y2_}}]]:=If[(Chop[x1-x2]==0)∧(Chop[y1-y2]==0),{},
If[Chop[y1-y2]==0,{0,0,1,-y1},If[Chop[x1-x2]==0,{0,1,0,-x1},{0,y2-y1,x1-x2,x2 y1-x1 y2}]]]

invert[{}]={};

invert[{A_?NumericQ,B_,C_,D_}]:={D,B,C,A}

For example, the following Manipulate shows how a line and a circle behave under inversion. To vary their positions, drag the two small disks. For a line, the disks are points on the line; for a circle, one disk is the center and the other is on the circumference. You can also choose a family of parallel lines or a family of concentric circles. The arrows show the action of the inversion on the two control points.

Manipulate[
Module[
{p,q,u,v,w,i,o1,o2},
{p,q}=pq;
If[Chop[Det[pq]]==0,p=p+{0,.01};q=q+{.01,0}];
{u,v}={p-100Normalize[q-p],p+100Normalize[q-p]};
w={{0,-1},{1,0}}.Normalize[v-u];
o1=Switch[op,1,{Line[{u,v}]},2,{Circle[p,Norm[p-q]]},3,Table[Line[{u+i w,v+i w}],{i,-6,6,.5}],4,Table[Circle[p,i Norm[p-q]],{i,.2,6,.2}]];
o2=Map[generalizedCircle[invert[toGeneralizedCircle[#]]]&,o1];
Graphics[
{EdgeForm[Thick],ColorData[2,6],Disk[],Red,o1,Blue,o2,Disk[#,.05]&/@{p,q},Black,If[arrows,{Arrow[{p,p/((Norm[p])^2)}],Arrow[{q,q/((Norm[q])^2)}]},{}]},
Axes->(op<3),PlotRange->3]
],
{{pq,{{2,1},{-2,2}}},Locator,Appearance->None},
Row[{
Control@{{op,1,""},{1->" line ",2->" circle ",3->" parallel lines ",4->" concentric circles "}},
Spacer[20],
Control@{arrows,{True,False}},Spacer[10],"Drag a point."
}],
SaveDefinitions->True]

Concentric circles do not invert into concentric circles, and the center of a circle does not invert into the center of its inversion (although the two centers are collinear with the origin). The center of the inverted circle can even be outside the original circle! (This particularly applies to U; its interior gets mapped into its exterior and its center gets mapped to ∞.) The next section shows how to locate the center of the inversion of a given circle.

As a circle is a particular kind of ellipse, it is interesting to see the inversion of a general ellipse. The following Manipulate shows such an inversion; you can drag the center of the ellipse with a locator and vary the lengths of its axes with a pair of sliders. Contour lines showing concentric ellipses are optional; increase the zoom slider if the display is all one color.

Manipulate[
Module[
{cx,cy},
{cx,cy}=c;
Show[Graphics[{EdgeForm[Thick],ColorData[2,6],Disk[{0,0},1],Opacity[.5],ColorData[2,5],Disk[c,{a,b}]},PlotRange->z],
If[cl,
If[cl1==1,ContourPlot[((((-cx+x))^2)/(a^2))+((((-cy+y))^2)/(b^2)),{x,-8,8},{y,-8,8},Contours->10],
ContourPlot[((((-cx+(x/((x^2)+(y^2)))))^2)/(a^2))+((((-cy+(y/((x^2)+(y^2)))))^2)/(b^2)),{x,-8,8},{y,-8,8}]
],
ContourPlot[((((-cx+(x/((x^2)+(y^2)))))^2)/(a^2))+((((-cy+(y/((x^2)+(y^2)))))^2)/(b^2))==1,{x,-8,8},{y,-8,8}]
]
]
],
"Drag the locator.",
{{a,1,"horizontal axis"},.1,4,Appearance->"Labeled"},
{{b,.6,"vertical axis"},.1,4,Appearance->"Labeled"},
{{c,{-.1,0}},Locator},
Dynamic@Row[{Control[{{cl,False,"contour lines"},{True,False}}],
If[cl,Control[{{cl1,1,""},{1->"family",2->"family inverted"}}],""]}],
{{z,4,"zoom"},2,8,Appearance->"Labeled"}]

Inversion in an Arbitrary Circle

Up to now, inversion has been in the unit circle; it can be generalized to use any circle M. Assume M=⊙(γ,ρ), which means M has center γ and radius ρ>0. The generalization takes three steps: first transform M into U by translating γ to the origin and scaling by 1/ρ. Second, invert in U. Third, scale back by ρ and translate back by γ. As these operations are rigid motions, all the properties of inversion apply to the generalized inversion.

The function squareDistance computes the square of the Euclidean distance between two given points. (It is more convenient to use the following definition than the built-in Mathematica function SquaredEuclideanDistance.)

squareDistance[h_,k_]:=Chop[(k-h).(k-h)]

Thus, operating with Cartesian coordinates, the function inver inverts a given point p in M=⊙(γ,ρ).

invert[Circle[γ_,_],γ_]=∞;

invert[Circle[γ_,_],∞]=γ;

invert[Circle[γ_,ρ_],p:{_,_}]:=γ+(((ρ^2)(p-γ))/(squareDistance[p,γ]))

An interesting property of inversion is adopted by many authors as an alternative way of defining inversion. Let q be the inversion of the point p≠γ in the circle M=⊙(γ,ρ). It is easy to verify that the product of the distance of p to γ and the distance of q to γ is a constant equal to (ρ^2).

Simplify[(Norm[γ-invert[Circle[γ,ρ],p]]Norm[γ-p]/.{p->{px,py},γ->{γx,γy}})/.((Abs[xx_])^2)->(xx^2),((((px-γx))^2)+(((py-γy))^2)>0)∧ρ>0]

Therefore, define the point q as the inverse of p if q is that unique point such that its distance to γ times the distance of p to γ is (ρ^2) [].

When the points a, b, and c are collinear (which includes the case of two or all of them being equal), the function perturb[{a,b,c}] applies a small random displacement to them to give three new noncollinear points.

perturb[{a_,b_,c_}]:=
If[Chop[Det[{b-a,c-a}]]===0,
{a,b,c}+RandomReal[{-0.01,0.01},{3,2}],
{a,b,c}
]

The function circleABC computes the circle passing through three given points a, b, c.

circleABC[{a_,b_,c_}]:=Module[{a1,b1,c1,center,x,y},
{a1,b1,c1}=perturb[{a,b,c}];
center=First[{x,y}/.Quiet[If[And@@NumericQ/@Flatten[{a,b,c}],NSolve,Solve][squareDistance[{x,y},a1]==squareDistance[{x,y},b1]==squareDistance[{x,y},c1],{x,y}]]];
Circle[center,Norm[center-a1]]]

Before obtaining the Cartesian coordinates corresponding to inverting circles and lines, first consider the following problem. What is the center of the circle through three different noncollinear points a, b, c?

For example, here are explicit formulas for the center and radius of such a circle through a=((Subscript[x, 1]),(Subscript[y, 1])), b=((Subscript[x, 2]),(Subscript[y, 2])), and c=((Subscript[x, 3]),(Subscript[y, 3])).

circleABC[{{x1,y1},{x2,y2},{x3,y3}}]/.((Abs[xx_])^2)->(xx^2)

The denominators of the expressions for the center and radius contain a factor that is zero only when a, b, and c are collinear.

Module[{a,b,c},Det[{c-a,b-a}/.{a->{x1,y1},b->{x2,y2},c->{x3,y3}}]]

Now consider an arbitrary circle V that does not pass through the center γ of M. Invert γ in V to γ' and then invert γ' in M to γ''. Then the inversion of V in M is a circle with center γ''. The equality of the following two results verifies this property.

FullSimplify[invert[M,invert[V,γ]]/.{γ->{γx,γy},M->Circle[{γx,γy},ρ],V->Circle[{vx,vy},vr]}]

Module[{M=Circle[{γx,γy},ρ]},
FullSimplify[First@circleABC[{invert[M,{vx+vr,vy}],invert[M,{vx-vr,vy}],invert[M,{vx,vy+vr}]}]]]

Theorem 4

If the circle V=⊙(c,σ) inverts in M=⊙(γ,ρ) into the circle W, then the center of W is γ+(c-γ)(ρ^2)/(|c-γ((|)^2)-(σ^2)) and its radius is σ (ρ^2)/| | c-γ((|)^2)-(σ^2)|.

The vertical bars in the last expression have two different meanings: the modulus of a vector and the absolute value of a number. Theorem 4 arises from using the property mentioned in the previous paragraph. First we obtain the square of the radius of W.

rule1={γ->{γx,γy},M->Circle[{γx,γy},ρ],c->{cx,cy},V->Circle[{cx,cy},σ]};

FullSimplify[squareDistance[invert[M,invert[V,γ]],invert[M,{cx+σ,cy}]]/. rule1 /.((Abs[xx_])^2)->(xx^2)]

Match the center of W with c to get the following.

FullSimplify@Reduce[(c==invert[M,invert[V,γ]])/. rule1]

So a circle V=⊙(c,σ) is inverted into a concentric circle if c is outside the circle of inversion M=⊙(γ,ρ) and |c-γ|=(σ^2)+(γ^2). This implies that M and V are orthogonal. Therefore, a circle inverts into a concentric circle (and necessarily of the same radius, i.e. itself) iff it is orthogonal to M. To visualize these ideas, consider the following Manipulate that inverts a pattern of tangent circles.

invert[M:Circle[γ_,ρ_],Circle[cV_,rV_]]:=Module[
{n=squareDistance[cV,γ]-(rV^2),h,k},
If[n==0,
h=invert[M,cV+rV Normalize[cV-γ]];
k={{0,-1},{1,0}}.Normalize[cV-γ];
InfiniteLine[{h+k,h-k}],
Circle[γ+(cV-γ)(ρ^2)/n,rV (ρ^2)/Abs[n]]
]
]

Manipulate[
Module[
{g,i,j},
g=Join[Flatten[Table[{{i,j}-(n+1)/2,.5},{i,n},{j,n}],1],Flatten[Table[{{i,j}-(n+1)/2+.5{1,1},.2071},{i,n-1},{j,n-1}],1]];
Graphics[{EdgeForm[Thick],Opacity[.5],ColorData[2,6],Disk[γ,ρ],ColorData[5,7],If[io,Map[(invert[Circle[γ,ρ],Circle@@#]/.Circle->Disk)&,g],{}],Black,If[go,Circle@@#&/@g,{}]},PlotRange->z,ImagePadding->1]
],
Row[{"Drag the locator.",Spacer[50],Control@{{n,4,"complexity"},Range[10],Setter}}],
{{ρ,.5,"radius of circle of inversion"},0,5,Appearance->"Labeled"},
Row[{
Control[{{go,True,"grid"},{True,False}}],Spacer[3],Control[{{io,True,"inversion"},{True,False}}],Spacer[4],Control[{{z,2,"zoom"},.01,6,Appearance->"Labeled"}]
}],
{{γ,{0,0}},Locator},
SaveDefinitions->True]

Inverting Segments and Arcs

The inversion of a polygon is a closed sequence of arcs of circles that go through the center of inversion. Consider the problem of finding an arc through three noncollinear points a, b, and c. As stated, this problem has many solutions; by assuming one of the points is not an endpoint of the arc, there is a unique answer. The function arcABC constructs such an arc and includes an argument to control whether the arc passes through the point b.

arcABC[a_,b_,c_,over_]:=Module[{ce,aa,ac,at},
at[{x_,y_}]:=With[{u=ArcTan[x,y]},u+If[u<0,2π,0]];
ce=N[First@circleABC[{a,b,c}]];
{aa,ac}=at/@{a-ce,c-ce};
If[aa>ac,ac=ac+2π];
If[Det[{b-a,c-a}]<0,{aa,ac}={ac,aa};If[aa>ac,aa=aa-2π]];
If[!over,{aa,ac}={ac,aa+2π}];
Circle[ce,Norm[ce-a],{aa,ac}]
]

The following Manipulate applies the function arcABC to any three noncollinear points, optionally passing through one of them.

Manipulate[
Module[{a,b,c,ce},
{a,b,c}=abc;
If[Chop[Det[{b-a,c-a}]]==0,{a,b,c}=abc=abc+RandomReal[{-.01,.01},{3,2}]];
ce=N[First@circleABC[{a,b,c}]];
Graphics[{Thick,{Dotted,Circle[ce,Norm[ce-a]]},arcABC[a,b,c,ox==1],Red,
EdgeForm[Thin],Disk[a,.03],Disk[c,.03],Text[Style["\[Cross]",Bold,30],b]},PlotRange->1]
],
{{abc,{{-.2,-.8},{.5,-.2},{-.1,.4}}},Locator,Appearance->None},
Row[{Control@{{ox,1,"passing over x?"},{1->" yes ",2->" no "}},Spacer[30],"Drag a red point."}],
SaveDefinitions->True]

Let the inversion of the point h be h' and the point k be k'. There are four cases for the inversion of the finite line segment h k in the circle M=⊙(γ,ρ).

If h=k, the segment is a point and inverts into the point h'=k'.

If h≠k and h=γ, the segment h k inverts into a ray starting at k', going away from q.

If h, k, and q are collinear, there are two subcases:

If q is in between h and k, the inverse is the union of two rays, one starting at h', the other starting at k', and both going away from γ.

Otherwise, h and k are on the same side of γ, and the inverse of h k is a line segment joining h' and k' on the same side of γ as h and k, but now switched around.

If h and k are not collinear with γ, consider the circle passing through γ,  h', and k'. The inversion of h k is the arc joining h' and k' that does not pass through γ.

Similar results apply to the inversion of an arc. The following Manipulate shows all these cases as they apply to line segments and arcs. The initial segments or arcs are shown in red and their inversions in blue. Control locators are drawn in red. When a segment/arc is such that its corresponding line/circle passes through γ, say that it does so directly if γ is part of the segment/arc and indirectly otherwise.

Manipulate[
Module[{M=Circle[{0,0},1],h,k,i,u,v},
{h,k,i}=hki;
(* h, k, i and {0, 0} must be all different *)
If[Length[Union[Chop/@{h,k,i,{0,0}}]]<4,
hki={h,k,i}={h,k,i}+RandomReal[{-.01,.01},{3,2}]
];
{u,v}={invert[M,h],invert[M,k]};
Graphics[{EdgeForm[Black],ColorData[2,6],Disk[],Thick,Black,
Switch[cases,
1,{Style[Text["both ends equal",{0,-2.8},{0,0}],15],Arrow[{h,u}],coloredDisk[h,1],coloredDisk[u,2]},
2,{
Style[Text["an end on the center of inversion",{0,-2.8},{0,0}],15],
If[
segArcs==1,
{coloredLine[{h,{0,0}},1],coloredLine[{u,u+100Normalize[u]},2],coloredDisk[u,2]},
{Red,arcABC[{0,0},h,k,True],coloredDisk[k,1],coloredLine[{u+100Normalize[u-v],v},2]}
],
coloredDisk[h,1]
},
3,{
Style[Text["directly covering the center of inversion",{0,-2.7},{0,0}],15],
If[
segArcs==1,
{
k=-Abs[k.Normalize[h]]Normalize[h];
v=invert[M,k];
coloredLine[{h,k},1],
coloredLine[{u,u+100Normalize[u]},2],
coloredLine[{v,v+100Normalize[v]},2]
},
{
Red,arcABC[h,{0,0},k,True],
coloredLine[{u,u+100Normalize[u-v]},2],
coloredLine[{v,100Normalize[v-u]},2]
}
],
coloredDisk[h,1],coloredDisk[k,1],coloredDisk[u,2],coloredDisk[v,2]
},
4,{
Style[Text["indirectly covering the center of inversion",{0,-2.7},{0,0}],15],
If[
segArcs==1,
{
k=Abs[k.Normalize[h]]Normalize[h];
v=invert[M,k];
coloredLine[{h,k},1],
coloredLine[{u,v},2]
},
{Red,arcABC[h,{0,0},k,False],coloredLine[{u,v},2]}
],
coloredDisk[h,1],coloredDisk[k,1],coloredDisk[u,2],coloredDisk[v,2]
},
5,{
Style[Text["not passing through the center of inversion",{0,-2.7},{0,0}],15],
If[
segArcs==1,
{coloredLine[{h,k},1],arcABC[u,invert[M,(h+k)/2],v,True]},
{
Red,arcABC[h,i,k,False],
ColorData[2,7],arcABC[u,invert[M,i],v,False],
coloredDisk[i,1]}],coloredDisk[h,1],coloredDisk[k,1],coloredDisk[u,2],coloredDisk[v,2]
}
],
Brown,Disk[{0,0},.05]},PlotRange->3]
],
{{segArcs,1,Spacer[30]},{1->" line segments ",2->" arcs "}},
Row[{Control@{{cases,1},{1->" 1 ",2->" 2 ",3->" 3a ",4->" 3b ",5->" 4 "}},
Spacer[30],"Drag a red point."}],
{{hki,{{-1.5,-1},{-1,-1},{2,2}}},Locator,Appearance->None},Initialization:>(coloredDisk[p_,col_]:={If[col==1,Red,ColorData[2,7]],Disk[p,.08]};
coloredLine[s_,col_]:={If[col==1,Red,ColorData[2,7]],Line[s]}),
SaveDefinitions->True]

Inverting a Triangle and a Quadrilateral

The function invSeg encapsulates the four cases appearing in the inversion of a segment mentioned in the previous section.

invert[M_,segment[{h_,h_}]]:=invert[M,h]

invert[M:Circle[γ_,_],segment[{γ_,k_}]]:=Module[{u=invert[M,k]},Line[{u,u+100Normalize[k-γ]}]]

invert[M:Circle[γ_,_],segment[{h_,γ_}]]:=invert[M,segment[{γ,h}]]

invert[M:Circle[γ_,_],segment[{h_,k_}]]:=Module[{h1,k1},(* h,k,γ collinear *)
{h1,k1}={invert[M,h],invert[M,k]};
If[
Norm[h-γ]+Norm[k-γ]==Norm[h-k], (* q is between h and k *)
{Line[{h1,h1+100Normalize[h-γ]}],Line[{k1,k1+100Normalize[k-γ]}]},
Line[{h1,k1}]
]
]/;Det[{h-γ,k-γ}]==0

invert[M_,segment[{h_,k_}]]:=Module[{a,c,ce,aa,ac}, (* h,k,γ not collinear *)
{h1,k1}={invert[M,h],invert[M,k]};
arcABC[h1,invert[M,(h+k)/2],k1,True]
]

invert[M_,p:{{_,_}..}]:=Quiet@Map[invert[M,segment[#]]&,Partition[p,2,1,1]]

The function invert is extended here to invert a general triangle and a general quadrilateral. As mentioned before, the inversion of a polygon is a figure made by adjoining arcs of circles that pass through q. (The geometry of coincident arcs is the same as the geometry of polygons. Just invert them!) However, the interior of a polygon does not invert to the interior of its inverse. The function fill fills this interior for aesthetics.

fill[{
Circle[c1_,r1_,{α1_,β1_}],
Circle[c2_,r2_,{α2_,β2_}],
Circle[c3_,r3_,{α3_,β3_}]
}]:=
Module[{t,t1,t2,t3,t4,mi,d1,d2,d3,d4},
t1=Table[c1+r1{Cos[t],Sin[t]},{t,α1,β1,.01(β1-α1)}];
t2=Table[c2+r2{Cos[t],Sin[t]},{t,α2,β2,.01(β2-α2)}];
t3=Table[c3+r3{Cos[t],Sin[t]},{t,α3,β3,.01(β3-α3)}];
{d1,d2,d3,d4}=Norm/@{Last[t1]-First[t2],Last[t1]-Last[t2],Last[t1]-First[t3],Last[t1]-Last[t3]};
mi=Min[d1,d2,d3,d4];
t4=Join[t1,Which[mi==d1,t2,mi==d2,Reverse[t2],mi==d3,t3,True,Reverse[t3]]];
If[(mi==d3)∨(mi==d4),t3=t2];
{d1,d2}=Norm/@{Last[t4]-First[t3],Last[t4]-Last[t3]};
mi=Min[d1,d2];
Polygon[Join[t4,Which[mi==d1,t3,True,Reverse[t3]]]]
]

fill[
{
Circle[c1_,r1_,{α1_,β1_}],
Circle[c2_,r2_,{α2_,β2_}],
Circle[c3_,r3_,{α3_,β3_}],
Circle[c4_,r4_,{α4_,β4_}]}]:=
Module[{t,t1,t2,t3,t4,t5,t6,mi,d1,d2,d3,d4,d5,d6},
t1=Table[c1+r1{Cos[t],Sin[t]},{t,α1,β1,.01(β1-α1)}];
t2=Table[c2+r2{Cos[t],Sin[t]},{t,α2,β2,.01(β2-α2)}];
t3=Table[c3+r3{Cos[t],Sin[t]},{t,α3,β3,.01(β3-α3)}];
t4=Table[c4+r4{Cos[t],Sin[t]},{t,α4,β4,.01(β4-α4)}];
{d1,d2,d3,d4,d5,d6}=Norm/@{Last[t1]-First[t2],Last[t1]-Last[t2],Last[t1]-First[t3],Last[t1]-Last[t3],Last[t1]-First[t4],Last[t1]-Last[t4]};
mi=Min[d1,d2,d3,d4,d5,d6];
t5=Join[t1,
Which[
mi==d1,t2,
mi==d2,Reverse[t2],
mi==d3,t3,
mi==d4,Reverse[t3],
mi==d5,t4,
True,Reverse[t4]
]
];
If[(mi==d3)∨(mi==d4),t3=t2];
If[(mi==d5)∨(mi==d6),t4=t2];
{d1,d2,d3,d4}=Norm/@{Last[t5]-First[t3],Last[t5]-Last[t3],Last[t5]-First[t4],Last[t5]-Last[t4]};
mi=Min[d1,d2,d3,d4];
t6=Join[t5,Which[mi==d1,t3,mi==d2,Reverse[t3],mi==d3,t4,True,Reverse[t4]]];
If[(mi==d3)∨(mi==d4),t4=t3];
{d1,d2}=Norm/@{Last[t6]-First[t4],Last[t6]-Last[t4]};
mi=Min[d1,d2];
Polygon[Join[t6,Which[mi==d1,t4,True,Reverse[t4]]]]
]

The following Manipulate shows a triangle or quadrilateral and the corresponding filled inversion. You can zoom by changing the radius of the circle of inversion M. For what positions of q do the sides of a given triangle invert into three congruent circles? Hint: it has something to do with its incircle. What about a quadrilateral?

Manipulate[
Module[{v,c,iA,M},
(* all locators must be different *)
If[Length[Union[Chop/@cpqrs]]<5,cpqrs=cpqrs+RandomReal[{-.01,.01},{5,2}]];
v=Take[Rest[cpqrs],op];
c=First[cpqrs];
M=Circle[c,r];
iA=invert[M,v];
Graphics[{EdgeForm[Thin],Opacity[.5],ColorData[2,6],Disk[c,r],ColorData[4,3],Polygon[v],Opacity[1],Red,Disk[#,.07]&/@v,Disk[c,.07],Black,Map[Arrow[{#,invert[M,#]}]&,v],Opacity[.7],Yellow,fill[iA],Black,Thick,iA,{Red,Red,Disk[#,.07]&/@v,Disk[c,.07]}},PlotRange->3]
],
{{cpqrs,1.{{0,0},{-1.5,2},{-1,-2.5},{2,-1},{2.5,0}}},Locator,Appearance->None},
{{r,1,"radius of inversive circle"},.001,3,Appearance->"Labeled"},
Row[{Spacer[140],"Drag a red point."}],
{{op,3,""},{3->" triangle ",4->" quadrilateral "}},
SaveDefinitions->True]

Inverting the Visual Proof of Nicomachus’s Theorem

Nicomachus’s theorem [, ] states that (∑_(k=1)^n)(k^3)=((((∑_(k=1)^n)k))^2). This section inverts a well-known pattern showing a proof without words of this identity.

To justify the identity, consider the pattern made by half-squares and squares of increasing integer side lengths. The area of the big square is the square of the sum of the side lengths on the base 1+2+3+…+7. On the other hand, this area is the sum of the individual areas of the interior squares, taking into account that two half-squares make a whole square: 1+2×(2^2)+3×(3^2)+…+7 (7^2). Logically these quantities are the same; hence Nicomachus’s theorem.

Module[{b,n=7},
Graphics[{EdgeForm[Thin],White,
Table[
b=i(i-1)/2;
{
Rectangle[{b,0},{b+i,i/2}],
Table[Rectangle[{b,i/2+i j},{b+i,i/2+i(j+1)}],{j,0,i/2-1}],
Rectangle[{0,b},{i/2,b+i}],
Table[Rectangle[{i/2+i j,b},{i/2+i(j+1),b+i}],{j,0,i/2-2}]
},{i,2,n,2}
],
Table[b=i(i-1)/2;
{
Table[Rectangle[{b,i j},{b+i,i j+i}],{j,0,i/2}],
Table[Rectangle[{i j,b},{i j+i,b+i}],{j,0,i/2-1}]},{i,1,n,2}
]
}]
]

In order to get a symmetrical version, promote the half-squares into squares.

Module[{b,n=7},
Graphics[{EdgeForm[Thin],White,
Table[b=i(i-1)/2;
{
Rectangle[{b,-i/2},{b+i,i/2}],
Table[Rectangle[{b,i/2+i j},{b+i,i/2+i(j+1)}],{j,0,i/2-1}],
Rectangle[{-i/2,b},{i/2,b+i}],
Table[Rectangle[{i/2+i j,b},{i/2+i(j+1),b+i}],{j,0,i/2-2}]
},
{i,2,n,2}],
Table[b=i(i-1)/2;
{
Table[Rectangle[{b,i j},{b+i,i j+i}],{j,0,i/2}],
Table[Rectangle[{i j,b},{i j+i,b+i}],{j,0,i/2-1}]
},{i,1,n,2}]
}]
]

Add replicas around the lower-left vertex of the unit square made by rotating this pattern 90, 180, and 270 degrees to obtain a symmetrical pattern. Then eliminate repeated squares; moreover, eliminate repeated segments from adjacent squares using filter.

filter={
{x___,{a:{ax_,ay_},{bx_,ay_}},y___,{{bx_,ay_},c:{cx_,ay_}},z___}:>{x,{a,c},y,z},
{x___,{{bx_,ay_},c:{cx_,ay_}},y___,{a:{ax_,ay_},{bx_,ay_}},z___}:>{x,{a,c},y,z},
{x___,{a:{ax_,ay_},b:{bx_,ay_}},y___,{{cx_,ay_},{dx_,ay_}},z___}:>{x,{a,b},y,z}/;ax≤cx≤dx≤bx
};

The function NicomachusSegments computes the segments needed to form the next pattern shown, which gives a visual proof of Nicomachus’s theorem [].

NicomachusSegments[n_]:=Module[{m={{0,-1},{1,0}},g,h,a,b,ax,ay,bx,by,h2,xx,yy,u,i},
g={
Table[b=i(i-1)/2;
{
Rectangle[{b,-i/2},{b+i,i/2}],
Table[Rectangle[{b,i/2+i j},{b+i,i/2+i(j+1)}],{j,0,i/2-1}],
Rectangle[{-i/2,b},{i/2,b+i}],
Table[Rectangle[{i/2+i j,b},{i/2+i(j+1),b+i}],{j,0,i/2-2}]
},
{i,2,n,2}],
Table[b=i(i-1)/2;
{
Table[Rectangle[{b,i j},{b+i,i j+i}],{j,0,i/2}],
Table[Rectangle[{i j,b},{i j+i,b+i}],{j,0,i/2-1}]
},
{i,1,n,2}]
};
h=Union[
Flatten[{
g,
g/.Rectangle[a_,b_]:>Rectangle[m.a,m.b],
g/.Rectangle[a_,b_]:>Rectangle[m.m.a,m.m.b],
g/.Rectangle[a_,b_]:>Rectangle[m.m.m.a,m.m.m.b]
}]/.Rectangle[{ax_,ay_},{bx_,by_}]:>Rectangle[{Min[ax,bx],Min[ay,by]},{Max[ax,bx],Max[ay,by]}] 
];
h2=Union[Flatten[h/. Rectangle[{ax_,ay_},{bx_,by_}]:>
{
{{ax,ay},{bx,ay}},
{{bx,ay},{bx,by}},
{{ax,by},{bx,by}},
{{ax,ay},{ax,by}}},1]
];
u=Cases[h2,{{_,xx_},{_,xx_}}]//. filter;
Join[u,u/.{xx_,yy_Integer}->{-yy,xx}]
]

Graphics[Line/@NicomachusSegments[7]]

The function NicomachusSegments computes the minimum number of segments necessary to produce the pattern. This is the number of segments up to n=10.

Table[Length[NicomachusSegments[n]],{n,10}]

The (n^th) pattern has 2((n^2)-n+3) segments and 2n(n+1) squares. Not removing unnecessary segments would give 8n(n+1) segments, so for large n, removing unnecessary segments is more than four times better. The following Manipulate shows Nicomachus’s pattern in gray along with its inversion in red. You can change M and thus q by dragging the locator, and you can vary r with the slider.

Manipulate[
Module[{nico,iA},
nico=NicomachusSegments[n];
If[io,iA=Map[invert[Circle[c,r],segment[#]]&,nico]];
Graphics[{EdgeForm[Thick],If[ic,{Opacity[.5],ColorData[2,6],Disk[c,r]},{}],Gray,If[go,Line/@nico,{}],Red, Thick,If[io,iA,{}]},PlotRange->z]
],
{{c,{0,0}},Locator},
Row[{"Drag the locator.",Spacer[40],Control@{{n,2,"squares on the side"},Range[7],Setter}}],
{{r,1.3,"radius of circle of inversion"},.01,5,Slider,Appearance->"Labeled"},
Row[{
Control[{{go,True,"show grid"},{True,False}}],Spacer[3],
Control[{{io,True,"show its inversion"},{True,False}}],Spacer[3],
Control[{{ic,True,"show circle of inversion"},{True,False}}]
}],
{{z,2,"zoom"},.01,15,Slider,Appearance->"Labeled"},
SaveDefinitions->True]

Inversive Tiling with Equilateral Triangles, Squares, and Hexagons

There are only three ways to tile the plane with a regular polygon: using an equilateral triangle, a square, or a regular hexagon. The goal of this section is to show the patterns arising from inverting these tilings. To that end, the functions ring3, ring4, and ring6 generate the corresponding set of pieces in a ring surrounding the circle of inversion (in red).

Here is the triangular case for the first level of complexity n=1.

expand3[{x_,y_}]:=Module[{s=(Sqrt[3])},{{x+2,y},{x+1,y+s},{x-1,y+s},{x-2,y},{x-1,y-s},{x+1,y-s}}]

ring3[n_]:=Union@Flatten[NestList[Flatten[Join[expand3/@#],1]&,{{0,0}},n],1]

rule2={s->(Sqrt[3]),M->Circle[{1,1/(Sqrt[3])},1/(Sqrt[3])]};

Graphics[{EdgeForm[Thin],Opacity[.5],Orange,Map[Polygon[{#,#+{2,0},#+{1,(Sqrt[3])}}]&,ring3[1]],Red,Disk@@(M/.rule2)}]

The corresponding function invert, with an extra argument with possible values 3, 4 or 5, inverts each of the segments forming the tiling. For instance, here is the pattern for the triangular case.

invert[M_,v_,3]:=Module[{s=(Sqrt[3]),m1=M/.rule2},
{
invert[m1,segment[{v,v+{2,0}}]],
invert[m1,segment[{v+{2,0},v+{1,s}}]],
invert[m1,segment[{v+{1,s},v}]]
}
]

Graphics[Map[invert[M/.rule2,#,3]&,ring3[1]]]

Although the interiors of triangles are not preserved by inversion, they are filled to show the interference patterns they produce. The idea is shown in the next figure; to avoid clutter, only the first four members of ring3[1] are drawn. Lines join the vertices of the triangles to their inversions.

With[{u=Take[ring3[1],4],s=(s/.rule2),M=M/.rule2},
Graphics[{EdgeForm[Thin],Orange,Opacity[.5],
Map[Polygon[{#,#+{2,0},#+{1,s}}]&,u],Pink,fill/@Map[invert[M,#,3]&,u],Black,Circle@@M,Map[{Line[{#,invert[M,#]}],Line[{#+{2,0},invert[M,#+{2,0}]}],Line[{#+{1,s},invert[M,#+{1,s}]}]}&,u]}
]
]

Although the triangles do not overlap, the interiors of their inverses do. In fact, the inversion of the central triangle contains the interiors of all the rest. The next level of complexity renders the following pattern.

With[{M=(M/.rule2),u=ring3[2]},
Graphics[{EdgeForm[Thin],ColorData[5,6],Opacity[.5],fill/@Map[invert[M,#,3]&,u],Black,Circle@@M}]
]

Finally, a detail showing the sixth level.

With[{M=(M/.rule2),u=ring3[6]},
Graphics[{EdgeForm[Thin],ColorData[5,6],Opacity[.5],fill/@Map[invert[M,#,3]&,u]},
PlotRange->{{.725,1.275},{.357,.87}}]
]

Similarly, in the case of tiling with squares, here are the corresponding functions.

expand4[{x_,y_}]:={
{x+1,y},
{x+1,y+1},
{x,y+1},
{x-1,y+1},
{x-1,y},
{x-1,y-1},
{x,y-1},
{x+1,y-1}
}

ring4[n_]:=Union@Flatten[NestList[Flatten[Join[expand4/@#],1]&,{{0,0}},n],1]

invert[M_,v_,4]:=With[{m1=(M/.rule2)},
{
invert[m1,segment[{v,v+{1,0}}]],
invert[m1,segment[{v+{1,0},v+1}]],
invert[m1,segment[{v+1,v+{0,1}}]],
invert[m1,segment[{v+{0,1},v}]]
}
]

With[{M=Circle[{1,1}/2.,1/2.],u=ring4[2]},
GraphicsRow[{
Graphics[{EdgeForm[Thin],Opacity[.5],Orange,Map[Polygon[{#,#+{1,0},#+1,#+{0,1}}]&,ring4[1]],Red,Disk@@M}],
Graphics[{EdgeForm[Thin],ColorData[5,6],Opacity[.5],fill/@Map[invert[M,#,4]&,u],Black,Circle@@M}]
}]
]

Here is a detail corresponding to the first four squares of the arrangement ring4[1].

With[{u=Take[ring4[1],4],M=Circle[{1,1}/2.,1/2.]},
Graphics[{EdgeForm[Thin],Orange,Opacity[.5],Map[Polygon[{#,#+{1,0},#+1,#+{0,1}}]&,u],Pink,fill/@Map[invert[M,#,4]&,u],Black,Circle@@M,
Map[{
Line[{#,invert[M,#]}],
Line[{#+{1,0},invert[M,#+{1,0}]}],
Line[{#+1,invert[M,#+1]}],
Line[{#+{0,1},invert[M,#+{0,1}]}]
}&,u]
}]
]

And here is a detail of the sixth level. (The color assignment has to be made explicit and does not rely only on overlapping as it did before.)

Module[{M=Circle[{1,1}/2.,1/2.],u=ring4[6],i=0},
Graphics[{
EdgeForm[Thin],Opacity[.5],
Map[
{ColorData[2,If[EvenQ[i],4,5]],i++;fill[#]}&,
Map[invert[M,#,4]&,u]
]
},PlotRange->{{.25,.75},{.25,.75}}]
]

The tiling using regular hexagons cannot be colored with two colors, and there are too many segments to place the center of M. So here is a line pattern.

expand6[{x_,y_}]:=With[{s=(Sqrt[3])},
{
{x+3,y-s},
{x+3,y+s},
{x,y+2s},
{x-3,y+s},
{x-3,y-s},
{x,y-2s}
}]

ring6[n_]:=Union@Flatten[NestList[Flatten[Join[expand6/@#],1]&,{{0,0}},n],1]

invert[M_,v_,6]:=Module[{s=(Sqrt[3])},
{invert[M,segment[{v,v+{2,0}}]],
invert[M,segment[{v+{2,0},v+{3,s}}]],invert[M,segment[{v+{3,s},v+{2,2s}}]],invert[M,segment[{v+{2,2s},v+{0,2s}}]],invert[M,segment[{v+{0,2s},v+{-1,s}}]],
invert[M,segment[{v+{-1,s},v}]]}]

With[{s=(Sqrt[3]),M=Circle[{1,1/(Sqrt[3])},1/(Sqrt[3])]},
Graphics[{EdgeForm[Thin],Opacity[.5],Orange,Map[Polygon[{#,#+{2,0},#+{3,s},#+
{2,2s},#+{0,2s},#+{-1,s}}]&,ring6[2]],Red,Disk@@M}]]

The second level of complexity corresponding to the above pattern is the following.

With[{M=Circle[{1,1/(Sqrt[3])},1/(Sqrt[3])]},Graphics[{Map[invert[M,#,6]&,ring6[2]],Black,Circle@@M}]]

This detail shows the sixth level of complexity, made with shapes formed with six arcs, all passing indirectly through q.

With[{M=Circle[{1,1/(Sqrt[3])},1/(Sqrt[3])]},Graphics[Map[invert[M,#,6]&,ring6[6]],PlotRange->{{.8,1.2},{.47,.7}}]]

An Inversive Spirograph

Finally, the following Manipulate shows an animated circle (orange) rotating inside a circle (pale brown) and the patterns generated by a point at the end of a line at a variable distance from the center of the circle. By varying the center and radius of the inversive circle, you can zoom in; the rotating radial line inverts into an arc orthogonal to the inversive path. You can enlarge the inversion by dragging the center of the inversive circle (light blue).

Manipulate[
Module[{M,center,u},
center=(1-a){Cos[t],Sin[t]};
M=Circle[q,r];
Show[
Graphics[{EdgeForm[Thin],Opacity[.5],
If[w≠2,
{ColorData[2,5],Disk[],ColorData[2,3],Disk[center,a],{Opacity[1],Black,Line[{center,u=center+arm{Cos[t/a],-Sin[t/a]}}],Disk[u,.04]}},
{}
],
If[w>1,
{ColorData[2,6],Disk[q,r],Red,Disk[q,.05],ColorData[2,5],invert[M,Circle[{0,0},1]],invert[M,spiro[center,a]],Black,{Opacity[1],invert[M,segment[{center,center+arm{Cos[t/a],-Sin[t/a]}}]]}},
{}
]},PlotRange->3],
If[w≠2,
ParametricPlot[(1-a){Cos[u],Sin[u]}+arm{Cos[u/a],-Sin[u/a]},{u,0,n π},PlotPoints->100],
{}
],
Quiet@If[w>1,
ParametricPlot[invert[M,(1-a){Cos[u],Sin[u]}+arm{Cos[u/a],-Sin[u/a]}],{u,0,n π},PlotPoints->300],
{}
]
]
],
{{a,0.5,"radius of rotating circle"},0,1,Appearance->"Labeled"},
{{arm,0.5,"length of rotating arm"},.01,2,Appearance->"Labeled"},
{{q,{1,2}},Locator,Appearance->None},
Row[{Control@{{r,1,"radius of inversive circle"},.01,3,Appearance->"Labeled",ImageSize->Small},Spacer[5],"Drag the red point."}],
{{n,3,"number of turns"},Range[10],Setter},Delimiter,
{{w,3,""},{1->" spirograph only ", 2->" inversion only ",3->" both "}},
{{t,0,"rotate"},0,n π,Appearance->"Labeled"},
Initialization:>(invert[Circle[q_,r_],spiro[Ac_,Ar_]]:=With[{n=squareDistance[Ac,q]-(Ar^2)},
Disk[q+(Ac-q)(r^2)/n,Ar (r^2)/Abs[n]]]),SaveDefinitions->True]

References

G. Smith, A Mathematical Olympiad Primer, London: United Kingdom Mathematics Trust, 2008.

A. Goucher. “Complex Projective 4-Space.” (Jun 24, 2013). cp4space.wordpress.com/2012/11/04/final-chapter-of-moda.

J. Rangel-Mondragon, “Inversive Patterns, Part I: Complex Inversion,” Mathematica in Education and Research, 12(2), 2007 pp. 162–183.

J. Rangel-Mondragon, “Inversive Patterns, Part II: Fundamental Properties of Inversion,” Mathematica in Education and Research, 12(4), 2007 pp. 330–354.

J. Rangel-Mondragon, “Inversive Patterns, Part III: Common Tangents, Mandalas and Gothic Windows,” Mathematica in Education and Research, 12(4), 2007 pp. 355–376.

N. J. A. Sloane. seq. A001189 in The On-Line Encyclopedia of Integer Sequences. oeis.org.

H. S. M. Coxeter and S. L. Greitzer, Geometry Revisited, New York: Random House, 1967.

E. W. Weisstein. “Nicomachus’s Theorem” from Wolfram MathWorld—A Wolfram Web Resource. mathworld.wolfram.com/NicomachussTheorem.html.

M Schreiber. “A Visual Proof of Nicomachus’s Theorem” from the Wolfram Demonstrations Project—A Wolfram Web Resource. demonstrations.wolfram.com/AVisualProofOfNicomachussTheorem.