Inversion of Elementary Algebraic Curves with Respect to a Circle

by
Stefan Welke

Mathematica in Education and Research
Volume 4 Number 2
Copyright 1995 TELOS/Springer-Verlag

Introduction

This notebook contains the code used in the article. Evaluate the complete notebook or evaluate step by step.

Inversion of algebnraic curves

inversion[{x_, y_}]:={x,y}/(x^2+y^2) ; 

inversion[{2,0}]

parabola:=x^2 - y ; 

invparabola:=parabola/.Thread[{x,y}->inversion[{x,y}]] ;

invparabola

invparabola':=invparabola //Together//Numerator ;

invparabola'

<<Geometry`invers`

?InversionAlgebraic

First examples

list1:={"1.","2.","3.","4.","5.","6.","7."} ;

list2:={ -2 + (-2+x)^2 + (1+y)^2 ,

         -1 + x^2 + (-1+y)^2 ,

          1 + 2*x - y ,

          x + 3*y ,

         -x/2 + y^2 ,

         -1 + x^2 - y^2 ,

         -1 + x^2/4 + 4*y^2/9 } ;


TableForm[{#,InversionAlgebraic[#,{x,y}]}& /@ list2 ,

           TableHeadings->{list1,{"Curve", "Image curve"}} ]

Anticonformality and invariance of the set of generalized circles

JacobiMatrix[expr_,vars_]:=D[expr,#]& /@ vars ;
DInv:=JacobiMatrix[inversion[{x,y}],{x,y}]//Together ;
DInv//MatrixForm

M:=DInv/.Thread[{x,y}->r*{Cos[phi],Sin[phi]}] //Simplify ;
M //MatrixForm

(M.{a,b}).(M.{c,d}) //Simplify

Det[M]//Simplify

gc:=a*(x^2+y^2)+b*x+c*y+d

invgc:=InversionAlgebraic[ gc, {x,y} ] ;
invgc

Further examples

The strophoid

strophoid:=y^2*(x-a)+x^2*(a+x) 
InversionAlgebraic[strophoid, {x,y}]

a:=1 ; 
InversionPlot[ strophoid, {x,y}, {-3,3} ]

The limacon of Pascal

InversionAlgebraic[ (x^2+y^2-b*x)^2-c^2*(x^2+y^2), {x,y} ]

<<Graphics`Graphics`
params:={1.1 , 2. , 2.7} ;
r[phi_,c_]:=2*Cos[phi]+c ;
Off[Power::infy , ParametricPlot::pptr] ;

plt6:=Block[{$DisplayFunction=Identity},
	PolarPlot[ {1,r[phi,#],1/r[phi,#]}//Evaluate, {phi,0,2*Pi},
	PlotRange->{-3.5,3.5}, Axes->False,
	PlotStyle->{GrayLevel[.5],Dashing[{.015}],GrayLevel[0]},   
	AspectRatio->Automatic ]& /@ params ] ;
Show[GraphicsArray[plt6], PlotLabel->"Figure 6" ]

Cassinian curves

cassini[a_,c_]:=(x^2+y^2)^2-2*c^2*(x^2-y^2)-a^4+c^4 ;
params3:={3. , 2.35 , 2. , 1.6 , 1.2} ;
plt8:=Block[{$DisplayFunction=Identity},
ImplicitPlot[ cassini[#,2]==0,{x,-4,4},
	Axes->False,AspectRatio->Automatic ]& /@ params3 ] ;
Show[ plt8, PlotLabel->"Figure 8" ]

cassini:=(x^2+y^2)^2-2*c^2*(x^2-y^2)+d ;
invcassini:=InversionAlgebraic[ cassini, {x,y} ] ;
invcassini

{ cassini, invcassini }/.{d->0}

invcassini/d //Expand

?InversionPlot

c:=1 ; d:=-1 ;
InversionPlot[ cassini, {x,y}, {-1.6 , 1.6} ]

Figures and Tables

This notebook contains all the code for the figures in the article "Inversion of elementary algebraic curves with respect to a circle". The code is independent of the code presented in the article. I made no efforts to produce elegant code.

How to use

(1) Open the notebook, all cells with code are initialization cells
(2) Call fig1, fig2, ... , fig9 for the figures and table1 for the table with the expressions for the conic sections.

General requirements

Needs["Graphics`ImplicitPlot`"]
Needs["Graphics`Graphics`"]
Needs["Graphics`Arrow`"]

inversion[expr_]:= 
	(expr/.{x->x/(x^2+y^2), y->y/(x^2+y^2)})//Together//Numerator
r := (2Cos[#1] + #2)&;

Figure 1

M := {0,0};
P := {3.,.4};
P':= P/P.P;
Q := {-.4,.2};
Q':= Q/Q.Q;

uc := Circle[{0,0}, 1];
lP := Line[{M, P}] ; 

plist := Point/@{M, P, P'};

txt := Graphics/@{Text[FontForm["M",{"Times-Italic",10}],  M-.15],
                  Text[FontForm["P",{"Times-Italic",10}],  P-.15],
                  Text[FontForm["P'",{"Times-Italic",10}], P'+.15]};

obj1 := Graphics /@ {lP, uc, {PointSize[.015], plist}} ; 

Show[{obj1, txt}, AspectRatio->Automatic]

Figure 2

parabola := x^2 - y
invparabola := parabola//inversion
ImplicitPlot[invparabola==0, {x,-2,2},
	AspectRatio -> Automatic]

Table of conic sections and their inversions

list1 := {"1.","2.","3.","4.","5.","6.","7."}
list2 := { -2 + (-2+x)^2 + (1+y)^2,
         -1 + x^2 + (-1+y)^2 ,
          1 + 2*x - y ,
          x + 3*y ,
         -x/2 + y^2 ,
         -1 + x^2 - y^2 ,
         -1 + x^2/4 + 4*y^2/9}
TableForm[{#,#//inversion}& /@ list2,
	TableHeadings->{list1,{"Curve", "Image curve"}} ]

Figure 3

ivPlot[expr_, {a_,b_}, l_:None]:=
Module[{},
	ImplicitPlot[{x^2+y^2==1, expr==0, inversion[expr]==0},
		{x,a,b}, DisplayFunction->Identity,
		AspectRatio->Automatic, Axes->False,  
	PlotStyle-> {{GrayLevel[.5]},
	             {Thickness[.007],Dashing[{.015}],GrayLevel[0]},
				 {Thickness[.007],GrayLevel[0]}  },
	Epilog->{{GrayLevel[.5],PointSize[.01],Point[{0,0}]}}]] ;

ga3:={Table[ivPlot[list2[[k]],{-3,3},k], {k,1,4}],
      Table[ivPlot[list2[[k]],{-3,3},k], {k,5,7}]}

Show[GraphicsArray[ga3]]

Figure 4

P := {Cos[#],Sin[#]}& @ .7
orth := {-#[[2]],#[[1]]}&
M2 := .9*P+.6*(P//orth)
d[A_,B_] := (A-B).(A-B) //Sqrt

c1 := Circle[{0,0}, 1, {-.3,3.4}]
c2 := Circle[M2, d[P,M2]]
v1 := Arrow[P, P+(P-M2//orth)]
v2 := Arrow[P, P-(P-M2//orth)]
v3 := Arrow[P, P+(.6*P//orth)]

txt4:={Text[FontForm["v",{"Times-Italic",10}],P+(P-M2//orth)+{0,.1}],
       Text[FontForm["w",{"Times-Italic",10}],P+(.6*P//orth)+{0,.1}],
       Text[FontForm["v*",{"Times-Italic",10}],P-(P-M2//orth)-{0,.13}],
       Text[FontForm["P",{"Times-Italic",10}],P+{.1,0}],
       Text[FontForm["Unit circle",{"Times-Bold",10}],{1.25,0}],
       Text[FontForm["Invariant circle",{"Times-Bold",10}],1.65*M2]}

Show[Graphics[{{Dashing[{.015}],c1},c2,v1,v2,v3,txt4}],
	AspectRatio->Automatic, Axes->False, PlotRange->All ]

Figure 5

strophoid := y^2 (x-1) + x^2 (x+1)
Show[ivPlot[strophoid, {-3,3}],
	DisplayFunction->$DisplayFunction]

Figure 6

eqs := {1, #, 1/#}&
params := {1.1, 2., 2.7}
plt6 = PolarPlot[eqs[r[t,#]]//Evaluate, {t,0,2*Pi},
	PlotRange->{-3.5,3.5}, Axes->False,
	PlotStyle->{GrayLevel[.5],Dashing[{.015}], GrayLevel[0]},
	AspectRatio->Automatic,
	DisplayFunction->Identity]& /@ params

Show[GraphicsArray[plt6]]

Figure 7

params2 := {1.1, 1.4, 1.7, 2., 2.3, 2.6}
layer1 :=
PolarPlot[Evaluate[r[t,#]& /@ params2],
	{t, 0, 2*Pi},
	AspectRatio->Automatic,
	DisplayFunction->Identity]

layer2 :=
PolarPlot[Evaluate[(1/r[t,#])& /c@ Take[params2,-2]],
	{t, 0, 2*Pi},AspectRatio->Automatic,
	DisplayFunction->Identity]

epsi1 := .1
layer3 :=
PolarPlot[Evaluate[(1/r[t,#])& @ params2[[4]] ],
	{t, -Pi+epsi1, Pi-epsi1},
	AspectRatio->Automatic,
	DisplayFunction->Identity]

limacons := ((x^2+y^2-2*x)^2-c^2*(x^2+y^2)) /.
	{c -> Take[params2,3]}

layer4 :=
ImplicitPlot[(inversion[#]==0)& /@ limacons, {x,-4,5},
	AspectRatio->Automatic,
	DisplayFunction->Identity]

layer5 :=
Graphics[{Dashing[{0.015}], Circle[{0,0}, 1]},
	AspectRatio->Automatic]

Show[{layer1,layer2,layer3,layer4,layer5},
	Axes -> False, DisplayFunction -> $DisplayFunction]

Figure 8

cassini[a_,c_] := (x^2+y^2)^2-2*c^2*(x^2-y^2)-a^4+c^4
params3 := {3., 2.35, 2., 1.6, 1.2}
plt := 
ImplicitPlot[cassini[#,2]==0, {x,-4,4},
	Axes -> False,
	AspectRatio -> Automatic,
	DisplayFunction->Identity]& /@ params3

Show[plt,DisplayFunction->$DisplayFunction]

Figure 9

cass := (x^2 + y^2)^2 - 2(x^2 - y^2) - 1
Show[ivPlot[cass, {-1.6, 1.6}],
	DisplayFunction -> $DisplayFunction]