Bipolare Kurven

Cassini’sche Kurven r'*r=(k^2)

f[r_]:=((k^2)/r)

cas=Eliminate[{(((x+e))^2)+(y^2)==((f[r])^2),(((x-e))^2)+(y^2)==(r^2),r'==f[r] }, {r,r'}]//Simplify

Direkt die y-Achsen Schnitthöhe ausrechnen

cas /.x->0

Solve[(e^4)+(y^4)==(k^4)-2 (e^2) (y^2),{y}]

Die y-Achse wird in der Höhe (h^2)=(k^2)-(e^(2 ))  geschnitten. Existiert nur für    k>=e.
k=e  folgt h=0, Lemniskate

In diese Höhe lege ich eine waagerechte Gerade

cas/.y->(Sqrt[-(e^2)+(k^2)])

Solve[(e^4)+(((-(e^2)+(k^2)+(x^2)))^2)==(k^4)+2 (e^2) ((e^2)-(k^2)+(x^2)),{x}]

diese schneidet für 2(e^2)>(k^2) zwei weitere Male, das sind dann die eingeschnürten Kurven
für 2(e^2)=(k^2) entfällt die Einschnürung, die flache Cassini’sche Kurve hat dann die Gleichung

2(e^2)-(e^2)

Der Flachpunkt ist (0,+- e)

die flache Cassini’sche Kurve hat dann die Gleichung

cas/.k->(Sqrt[2])e//Simplify

ContourPlot[Table[(3^4)+((((x^2)+(y^2)))^2)==(k^4)+2 (3^2) ((x^2)-(y^2)),{k,0,5,0.2}]//Evaluate, {x,-6,6},{y,-5,5}]

Manipulate[ContourPlot[{(3^4)+((((x^2)+(y^2)))^2)==(k^4)+2 (3^2) ((x^2)-(y^2))},{x,-6,6},{y,-5,5}],{{k,5},0,5}]

Hyperbeln r’=r+k

f[r_]:=r+k

hyp=Eliminate[{(((x+e))^2)+(y^2)==((f[r])^2),(((x-e))^2)+(y^2)==(r^2),r'==f[r] }, {r,r'}]

hyp//FullSimplify

Ellipsen r’=-r+k

f[r_]:=-r+k

elli=Eliminate[{(((x+e))^2)+(y^2)==((f[r])^2),(((x-e))^2)+(y^2)==(r^2),r'==f[r] }, {r,r'}]

elli//FullSimplify

Descartes’sche Ovale m r + n r’ == k

des= m r + n r' ==k

desc=Eliminate[{(((x+e))^2)+(y^2)==(((r'))^2),(((x-e))^2)+(y^2)==(r^2),m r + n r' ==k }, {r,r'}]//FullSimplify

Nullstellen

desc

desc/.y->0 //Simplify

Solve[(k^4)+((((e^2) (m-n) (m+n)-2 e ((m^2)+(n^2)) x+(m-n) (m+n) (x^2)))^2)==2 (k^2) ((e^2) ((m^2)+(n^2))+2 e (-(m^2)+(n^2)) x+((m^2)+(n^2)) (x^2)),x]//Simplify

we={e=3,k=5,m=1.3,n=-1}

ContourPlot[desc//Evaluate,{x,-6,45},{y,-10,30},Axes->True]

{-((k-e m+e n)/(m+n)),((k+e m-e n)/(m+n)),((-k+e (m+n))/(m-n)),((k+e (m+n))/(m-n))}

we={e=3,k=5,m=13/10,n=-1}

xo=((-k+e (m+n))/(m-n))

xo
b

xo-b

wn={e=.,k=.,m=.,n=.};

e=3;
Manipulate[ContourPlot[{(k^4)+((((e^2) (m-n) (m+n)-2 e ((m^2)+(n^2)) x+(m-n) (m+n) ((x^2)+(y^2))))^2)==2 (k^2) ((e^2) ((m^2)+(n^2))+2 e (-(m^2)+(n^2)) x+((m^2)+(n^2)) ((x^2)+(y^2))),x==xo-b},{x,-4,40},{y,-10,20}],{{k,5},1,8},{{m,1.3},-2,2},{{n,-1},-2,2}]

Suche nach der Beule

e=.;xo=((-k+e (m+n))/(m-n))

senkrechte Gerade, links von xo ist x==xo-b

{3,5,(13/10),-1}

desc

we={e=3,k=5,m=1.3,n=-1}

b=.;

test=desc/.{x->xo-b}

Solve[test,y]//Simplify//N

diskrimi=256-207b==0;

Solve[diskrimi,b]//N

{{b=1.2367149758454106`}}

b

b passt zur Zeichnung,  Ordinate dazu

0.014492753623188406` (Sqrt[416000.` +26000.` (Sqrt[256.` -207.` b])-128340.` b-4761.` (b^2)])

desc/.{x->xo-b} (* nochmal direkt *)

Solve[625+(((54.941884057971016` +0.6900000000000001` (9.116315433265655` +(y^2))))^2)==50 (36.71000000000001` +2.6900000000000004` (9.116315433265655` +(y^2))),{y}]

Das passt. Die Beule ist nur im konkreten Fall bestimmt.

we={e=3,k=5,m=1.3,n=-1}

wn={e=.,k=.,m=.,n=.};

Experimente

desc

descl=(k^4)+((((e^2) ((m^2)-(n^2))-2 e ((m^2)+(n^2)) x+((m^2)-(n^2))((x^2)+(y^2))))^2)-2 (k^2) ((e^2) ((m^2)+(n^2))-2 e ((m^2)-(n^2)) x+((m^2)+(n^2)) ((x^2)+(y^2)))

we={e=10,k=4,m=(1/2),n=2}

descl=256+(((375+85 x+(15/4) ((x^2)+(y^2))))^2)-32 (425+75 x+(17/4) ((x^2)+(y^2)))//FullSimplify//Expand

256+(((375+85 x+(15/4) ((x^2)+(y^2))))^2)-32 (425+75 x+(17/4) ((x^2)+(y^2)))

Dieses sind jedenfalls keine Kreise!

wn={e=.,k=.,m=.,n=.};