Quadriken und Hauptachsentransformation: n=2

Beispiel 8.9

A={{2,1},{1,2}}

Q=(∑_(j=1)^2)(∑_(k=1)^2)A[[j,k]](Subscript[x, j])(Subscript[x, k])-3

ContourPlot[Q==0,{(Subscript[x, 1]),-10,10},{(Subscript[x, 2]),-10,10}]

sys=Eigensystem[A]

B=Transpose[Table[sys[[2,k]],{k,2}]]

Inverse[B]

Inverse[B].A.B

T=Transpose[Table[((sys[[2,k]])/(Norm[sys[[2,k]]])),{k,2}]]

Inverse[T]

Transpose[T]

Q2=Q/.MapThread[Rule,{{(Subscript[x, 1]),(Subscript[x, 2])},T.{(Subscript[y, 1]),(Subscript[y, 2])}}]//Expand

ContourPlot[Q2==0,{(Subscript[y, 1]),-5,5},{(Subscript[y, 2]),-5,5}]

Q3=Q/.MapThread[Rule,{{(Subscript[x, 1]),(Subscript[x, 2])},B.{(Subscript[y, 1]),(Subscript[y, 2])}}]//Expand

ContourPlot[Q3==0,{(Subscript[y, 1]),-5,5},{(Subscript[y, 2]),-5,5}]

Quadriken und Hauptachsentransformation: n=3

Beispiel 8.10

A={{1,1,1},{1,1,-1},{1,-1,0}}

Q=(∑_(j=1)^3)(∑_(k=1)^3)A[[j,k]](Subscript[x, j])(Subscript[x, k])-1

ContourPlot3D[Q==0,{(Subscript[x, 1]),-10,10},{(Subscript[x, 2]),-10,10},{(Subscript[x, 3]),-10,10}]

sys=Eigensystem[A]

B=Transpose[Table[sys[[2,k]],{k,3}]]

Inverse[B]

Inverse[B].A.B

T=Transpose[Table[((sys[[2,k]])/(Norm[sys[[2,k]]])),{k,3}]]

Inverse[T]

Transpose[T]

Q2=Q/.MapThread[Rule,{{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])},T.{(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3])}}]//Expand

ContourPlot3D[Q2==0,{(Subscript[y, 1]),-5,5},{(Subscript[y, 2]),-5,5},{(Subscript[y, 3]),-5,5}]

Q3=Q/.MapThread[Rule,{{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])},B.{(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3])}}]//Expand

ContourPlot3D[Q3==0,{(Subscript[y, 1]),-5,5},{(Subscript[y, 2]),-5,5},{(Subscript[y, 3]),-5,5}]

Weiteres Beispiel

A={{2,4,1},{4,-1,4},{1,4,2}}

Q=(∑_(j=1)^3)(∑_(k=1)^3)A[[j,k]](Subscript[x, j])(Subscript[x, k])+1

ContourPlot3D[Q==0,{(Subscript[x, 1]),-10,10},{(Subscript[x, 2]),-10,10},{(Subscript[x, 3]),-10,10}]

sys=Eigensystem[A]

B=Transpose[Table[sys[[2,k]],{k,3}]]

6 Inverse[B]

Inverse[B].A.B

T=Transpose[Table[((sys[[2,k]])/(Norm[sys[[2,k]]])),{k,3}]]

Inverse[T]

Transpose[T]

Q2=Q/.MapThread[Rule,{{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])},T.{(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3])}}]//Expand

ContourPlot3D[Q2==0,{(Subscript[y, 1]),-5,5},{(Subscript[y, 2]),-5,5},{(Subscript[y, 3]),-5,5}]

Q3=Q/.MapThread[Rule,{{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])},B.{(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3])}}]//Expand

ContourPlot3D[Q3==0,{(Subscript[y, 1]),-5,5},{(Subscript[y, 2]),-5,5},{(Subscript[y, 3]),-5,5}]