この notebook の目標
２次曲線の標準形 (Subscript[η, 1])(X^2)+ (Subscript[η, 2])(Y^2)=1 から焦点をもとめる。

(i)  (Subscript[η, 1])>(Subscript[η, 2])>0 のとき 楕円
　　焦点の座標は (±((1/(Subscript[η, 2]))- (1/(Subscript[η, 1]))),  0) 
(ii)  (Subscript[η, 2])>(Subscript[η, 1])>0 のとき 楕円
　    焦点の座標は (0,  ±((1/(Subscript[η, 1]))- (1/(Subscript[η, 2])))) 
(iii) (Subscript[η, 1])>0, (Subscript[η, 2])<0 のとき双曲線
    　焦点の座標は (±((1/(|(Subscript[η, 1])|))+ (1/(|(Subscript[η, 2])|))),  0) 
(iv) (Subscript[η, 1])<0, (Subscript[η, 2])>0 のとき双曲線
    　焦点の座標は (0,±((1/(|(Subscript[η, 1])|))+ (1/(|(Subscript[η, 2])|))))     
(v) (Subscript[η, 1])<0, (Subscript[η, 2])<0 のとき空集合

A=(({{64, -100}, {-100, 64}})); F=(({{146, -182}})); c=-59; (Subscript[C, 0])= Expand[ (({{x, y}})).A.(({{x}, {y}}))+2 F.(({{x}, {y}}))+c][[1]][[1]];(*　(Subscript[２次曲線C, 0])==0を与える　*) (Subscript[C, 0])==0

Eigenvalues[A];

(Subscript[λ, 1]) =%[[1]]; (Subscript[λ, 2]) =%[[2]];

Eigenvectors[A];

u=%[[1]]/Sqrt[FullSimplify[Norm[%[[1]]]^2]];

R={{u[[1]],-u[[2]]},{u[[2]],u[[1]]}} ;

(Subscript[D, λ])={{(Subscript[λ, 1]),0},{0,(Subscript[λ, 2])}};(Subscript[D, λ])//MatrixForm(* 行列 (Subscript[D, λ]) *) ;

{f',g'}=(F.R)[[1]] ;(* f', g' を計算する*)

O'=-{%[[1]]/(Subscript[λ, 1]),%[[2]]/(Subscript[λ, 2])}//FullSimplify;(* C'の中心　*)

C'= FullSimplify[ (({{X, Y}})).(Subscript[D, λ]).(({{X}, {Y}}))+2 (({{f', g'}})).(({{X}, {Y}}))+c][[1]][[1]];

c'=FullSimplify[-c+f'^2/(Subscript[λ, 1])+g'^2/(Subscript[λ, 2])];

焦点を求める。

C''= FullSimplify[ (1/(c'))(({{X, Y}})).(Subscript[D, λ]).(({{X}, {Y}}))-1][[1]][[1]]//Expand(* 標準形　C''=0 *)

{(Subscript[η, 1]),(Subscript[η, 2])}={Coefficient[C'',X^2] ,Coefficient[C'',Y^2]}

焦点　(Focus)

Focus=If[(Subscript[η, 2])>0&&(Subscript[η, 1])>(Subscript[η, 2]),{{0,Sqrt[1/(Subscript[η, 2])-1/(Subscript[η, 1])]},-{0,Sqrt[1/(Subscript[η, 2])-1/(Subscript[η, 1])]}},
If[(Subscript[η, 1])>0&&(Subscript[η, 2])>(Subscript[η, 1]),{{Sqrt[ 1/(Subscript[η, 1])-1/(Subscript[η, 2])],0},-{Sqrt[1/(Subscript[η, 1])-1/(Subscript[η, 2])],0}},
If[(Subscript[η, 1])>0&&(Subscript[η, 2])<0,{{Sqrt[ 1/(Subscript[η, 1])+1/Abs[(Subscript[η, 2])]],0},-{Sqrt[ 1/(Subscript[η, 1])+1/Abs[(Subscript[η, 2])]],0}},
If[(Subscript[η, 2])>0&&(Subscript[η, 1])<0,{{0, Sqrt[1/Abs[(Subscript[η, 1])]+1/(Subscript[η, 2])]},-{0,Sqrt[ 1/Abs[(Subscript[η, 1])]+1/(Subscript[η, 2])]}}
   ]]]]

X0=5; ContourPlot[{C''==0},{X,-X0,X0},{Y,-X0,X0},Axes->True,Epilog->Point[Focus]]