Lösungen

1

Remove["Global`*"]

B = {{1, 2}, {3, 4}};   B // MatrixForm

mD = {{1, 0}, {0, 2}};   mD // MatrixForm

a

B1 = Inverse[B];
B1 // MatrixForm

b

A = B . mD . Inverse[B];
A // MatrixForm

c

Eigenvalues[A]

λ1 = Eigenvalues[A][[1]]

λ2 = Eigenvalues[A][[2]]

d

Die Eigenwerte von A sind die Diagonalelemente von D

e

Eigenvectors[A]

x1 = Eigenvectors[A][[1]]

x2 = Eigenvectors[A][[2]]

Eigensystem[A]

f

Der zweite Eigenvektor ist die erste Spalte von A, der erste Eigenvektor ist bis auf einen Faktor (=0.5) die zweite Spalte von A. Die Eigenvektoren sind nur bis auf einen Faktor bestimmt. Die Reihenfolge hängt von der Auswahl des Betrachters ab.

2

Remove["Global`*"]

B = {{1, 2, 3}, {2, 3, 4}, {3, 4, 4}};   B // MatrixForm

Inverse[B] // MatrixForm

mD = {{1, 0, 0}, {0, 2, 0}, {0, 0, 3}};  mD // MatrixForm

a

Inverse[B] // MatrixForm

b

A = B . mD . Inverse[B];
A // MatrixForm

c

IdentityMatrix[3] // MatrixForm

CharacteristicPolynomial[A,  λ]

Det[A - λ IdentityMatrix[3]]

Det[mD - λ IdentityMatrix[3]]

Det[A - λ IdentityMatrix[3]] == 
      Det[mD - λ IdentityMatrix[3]]

d

Eigensystem[A]

Eigenvalues[A]

Eigenvectors[A]

Eigensystem[mD]

Eigenvalues[mD]

Eigenvectors[mD]

Die Eigenwektoren von mD sind die Vektoren in den Achsenrichtungen (hier auf 1 normiert).

e

sum = Apply[Plus, Eigenvalues[A]]

CoefficientList[
      CharacteristicPolynomial[A,  λ], λ]

CoefficientList[CharacteristicPolynomial[A,  λ], λ] // 
      Reverse

Reverse[
        CoefficientList[
          CharacteristicPolynomial[
            A,  λ], λ]][[2]]

f

Det[A]

Det[mD]

Reverse[
        CoefficientList[
          CharacteristicPolynomial[A,  λ], λ]] // 
      Last

g

CharacteristicPolynomial[A,  λ] // Factor

CharacteristicPolynomial[A,  λ] /. λ -> 
        0

Apply[Times, Eigenvalues[A]]

Apply[Times, Eigenvalues[mD]]

Die Eigenwerte von A und von mD sind dieselben. Das Produkt der Eigenwerte von mD erkennt man als Wert des charakteristischen Polynoms an der Stelle 0. Dieser Wert ist also der letzte (der konstante) Koeffizient des charakteristischen Polynoms und daher auch die Determinante von A oder von mD. Diese wird ja erzeugt, wenn man in Det(A-λE) oder in Det(mD-λE) das λ gleich 0 setzt.

3

Remove["Global`*"]

xVec[x_, y_] := {x, y};
mVec = {4, 3};  r = 2;
kreis[rVec_, r_] := rVec . rVec - r^2;

a) Pol und Polare

pol = {0, 0};
kreis[(xVec[x, y] - mVec), r] == 0

Expand[kreis[(xVec[x, y] - mVec), r]] == 0

<< Graphics`ImplicitPlot`

kPl = 
        ImplicitPlot[
          kreis[(xVec[x, y] - mVec), r] == 0, {x, 0, 
            7}];

polare[xVec_, mVec_, pol_, 
          r_] := (xVec[x, y] - mVec) . (pol - mVec) - 
          r^2;
polare[xVec, mVec, pol, r] == 0

Simplify[polare[xVec, mVec, pol, r]] == 0

solv = 
      Solve[{polare[xVec, mVec, pol, r] == 0, 
          kreis[(xVec[x, y] - mVec), r] == 0}, {x, y}]

solv1 = solv // N

pT1 = {x, y} /. solv1[[1]];
pT2 = {x, y} /. solv1[[2]];

polarePl = 
        ImplicitPlot[
          polare[xVec, mVec, pol, r] == 0, {x, 0, 7}];

Show[kPl, polarePl, 
        Graphics[{PointSize[0.04], Point[pol], Point[mVec], Point[pT2], 
            Point[pT1], Line[{pol, mVec}], Line[{pol, pT1}], 
            Line[{pol, pT2}]}]];

b) Tangente

tangente[xVec_, mVec_, pT_, 
          r_] := (xVec[x, y] - mVec) . (pT - mVec) - 
          r^2;

Chop[Expand[polare[xVec, mVec, pT1, r]]] == 0

Chop[Expand[polare[xVec, mVec, pT1, r]]] == 0 /. {x -> 0, 
        y -> 0}

Chop[Expand[polare[xVec, mVec, pT2, r]]] == 0

Chop[Expand[polare[xVec, mVec, pT2, r]]] == 0 /. {x -> 0, 
        y -> 0}

Show[kPl, polarePl, 
        Graphics[{PointSize[0.04], Point[pol], Point[mVec], Point[pT2], 
            Point[pT1], Line[{pol, mVec}], Line[{pol, pT1}], 
            Line[{pol, pT2}]}]];

c) Mittelpunktsgerade zum Pol

senkr[v_] := {-v[[2]], 
          v[[1]]};
geradePolM[xVec_, mVec_, pol_] := (xVec - mVec) . 
          senkr[pol - mVec];

    
Expand[geradePolM[xVec[x, y], mVec, pol]] == 0

yGer[x_] := 3  x/4;
gerPl = Plot[yGer[x], {x, 0, 6}];

Solve[{geradePolM[xVec[x, y], mVec, pol] == 0, 
        kreis[(xVec[x, y] - mVec), r] == 0}, {x, y}]

solv2 = 
      Solve[{geradePolM[xVec[x, y], mVec, pol] == 0, 
            kreis[(xVec[x, y] - mVec), r] == 0}, {x, y}] // 
        N

p1 = {x, y} /. solv2[[1]];
p2 = {x, y} /. solv2[[2]];

Show[kPl, polarePl, gerPl, 
        Graphics[{PointSize[0.04], Point[pol], Point[mVec], Point[pT2], 
            Point[pT1], Point[p1], Point[p2], Line[{pol, mVec}], 
            Line[{pol, pT1}], Line[{pol, pT2}]}]];

d) Apollonius

Norm[p2 - pol]/Norm[p1 - pol]

Rationalize[Norm[p2 - pol]/Norm[p1 - pol]]

Norm[p1 - pol]/Norm[p1 - {x, yGer[x]}] == 
      Norm[p2 - pol]/Norm[p2 - {x, yGer[x]}]

solv3 = 
      Solve[(Norm[p1 - pol]/
                Norm[p1 - {x, yGer[x]}])^2 == (Norm[p2 - pol]/
                Norm[p2 - {x, yGer[x]}])^2, {x}]

pol2 = {x, yGer[x]} /. solv3[[2]]

Show[kPl, polarePl, gerPl, 
        Graphics[{PointSize[0.04], Point[pol], Point[mVec], Point[pT2], 
            Point[pT1], Point[p1], Point[p2], Point[pol2], Line[{pol, mVec}], 
            Line[{pol, pT1}], Line[{pol, pT2}]}]];

e) Potenzgerade

kreis1 = (kreis[(xVec[x, y] - mVec), r] == 0)

kreis2 = (kreis[(xVec[x, y] - pol), 3  r] == 
          0)

potenz1[x_, y_] := 
        kreis[(xVec[x, y] - mVec), r];
potenz2[x_, y_] := kreis[(xVec[x, y] - pol), 3  r];

Expand[potenz1[x, y]] == potenz2[x, y]

?Reduce

Reduce[Expand[potenz1[x, y]] == potenz2[x, y], {x, y}]

solv4 = 
      Solve[Reduce[Expand[potenz1[x, y]] == potenz2[x, y], {x, y}], {y}] // 
        Flatten

potenzGer[x_] := y /. solv4

kPl2 = ImplicitPlot[kreis2, {x, -6, 7}];

plPotGer = Plot[potenzGer[x], {x, 0, 7}];

Show[kPl2, plPotGer, kPl];

Die Potenzgerade geht durch die Schnittpunkte der beiden  Kreise.

4

Remove["Global`*"]

pA = {1, 3, 2};  pB = {4, 1, 3};  pQ = {7, 7, 7};

g[t_] := 
      pA + t (pB - pA);   n = (pB - pA)
g[t]

kG[x_, y_, z_, d_] := 
        n . {x, y, z} + d; 
kG[p_, d_] := n . p + d; 
kG[x, y, z, d_] == 0

kG[pQ, d] == 0

solv1 = Solve[kG[pQ, d] == 0, {d}] // Flatten

kG[x_, y_, z_] := 
        n . {x, y, z} + d /. solv1; 
kG[p_] := n . p + d /. solv1;

Expand[kG[g[t]]] == 0

solv2 = Solve[Expand[kG[g[t]]] == 0, {t}] // Flatten

pL = g[t] /. solv2

% // N

5

Remove["Global`*"]

2  x - y + 3  z - 1 == 0;  pQ = {7, 7, 7};

n = {2, -1, 3};

kG[x_, y_, z_] := n . {x, y, z} - 1;  kG[x, y, z]

kG[p_] :=  n . p - 1;

g[t_] :=  pQ + t n;  g[t]

Expand[kG[g[t]]] == 0

solv = Solve[Expand[kG[g[t]]] == 0, {t}] // Flatten

pL = g[t] /. solv

% // N