Lösungen VD E 03

1

a

Remove[f]

a[1] = 1; a[2] = 1; a[3] = 1; 
    a[n_] := a[n - 1] + 2  a[n - 2] - a[n - 3]

Table[a[n], {n, 1, 20}]

Transpose[{{g[n - 1], g[n - 2], g[n - 3]}}] // MatrixForm

{{0, 1, 0}, {0, 0, 1}, {-1, 2, 1}} . 
        Transpose[{{g[n - 3], g[n - 2], g[n - 1]}}] // MatrixForm

Remove[v]

v[1] = Transpose[{{1, 1, 1}}]

aM = {{0, 1, 0}, {0, 0, 1}, {-1, 2, 1}}

v[n_] := aM . v[n - 1]

Table[v[n] // MatrixForm, {n, 1, 20}]

v1[1] = Transpose[{{1, 1, 1}}]

v1[n_] := v[n]/v[n][[3]][[1]]

Table[N[v1[n]] // MatrixForm, {n, 1, 40}]

b

Eigenvalues[aM]

Eigenvalues[aM] // N // Chop

Eigenvectors[aM] // N // Chop

vecLen[v_] := Sqrt[v . v]

veck[k_] := Chop[N[Eigenvectors[aM]]][[k]]

Table[veck[k]/vecLen[veck[k]], {k, 1, 3}]

Eigenvectors[aM] // Transpose // N // Chop // 
      MatrixForm

c

EW, Elemente der EV: Grenzwerte der b

2

a

xM = Transpose[{{-1, 4}, {2, 3}}];  
    dM = {{1/2, 0}, {0, 2}};
Inverse[xM] // MatrixForm

N[%] // MatrixForm

m = xM . dM . Inverse[xM]

m // MatrixForm

N[%] // MatrixForm

b

m . {-1, 2}

N[%]

(m . m) . {-1, 2}

N[%]

((m . m) . m) . {-1, 2}

N[%]

(((m . m) . m) . m) . {-1, 2}

N[%]

c

Skizziere alle Vektoren!

Show[
        Graphics[{PointSize[0.02], Point[{-1, 3}], 
            Point[m . {-1, 3}], 
            Point[((m . m) . m) . {-1, 3}], 
            Point[(m . m) . {-1, 3}], 
            Point[(((m . m) . m) . m) . {-1, 3}], 
            Point[((((m . m) . m) . m) . m) . {-1, 3}], 
            Point[(((((m . m) . m) . m) . m) . 
                    m) . {-1, 3}], Line[{{0, 0}, {-1, 4}}], 
            Line[{{0, 0}, {2, 3}}]}]];

Kurve für die Punkte?

IdentityMatrix[2]

d

Löse:

x.(m-e)==x-e;
x.(m-e)-x.e=-e;
x.(m-2 e)==-e;
x=-e.Inverse[m-2e]

m

x = -Inverse[m - 2  IdentityMatrix[2]]

Keine Lösung

3

a

v1 = {1, 0, 0, 4}; v2 = {0, 0, 1, 1 + u}; v3 = {1, 2, 3, 4}; 
    v4 = {0, 0, 4, 1};
m = 
      Transpose[{v1, v2, v3, 
          v4}];  m//MatrixForm

b

Det[m]

c

v = {u, 1, 2, -u}; m . x == v;  
    x = Inverse[m] . v

v = {u, 1, 2, -u}; m . x == v;  
    x = Inverse[m] . v // Together // Simplify

System keine eindeutige Lösung: u=?
    In diesem Falle: keine Lösung oder undendlich viele Lösungen?

d

solv1 = Solve[6 + 8 u == 0, {u}] // Flatten

x /. solv1

e

Wann ist v senkrecht auf x?

Solve[v . x == 0, {u}] // N // Chop

v . x // Expand

v . x // Together

v . x /. u -> -1

4

a

Remove[z1, z2, z3, x, solv, solv1]

z1 = 3 - I; z2 = 3 + I; z3 = 4 + I;
solv = 
      Solve[x^4 == z1/z2 Conjugate[z3], {x}] // Flatten

N[%]

solvNew = Table[x /. solv[[k]], {k, 1, 4}]

Table[
      Abs[solvNew[[k]]] E^(Arg[solvNew[[k]]]), {k, 1, 
        4}]

Table[
      Abs[N[solvNew[[k]]]]  e^(N[Arg[solvNew[[k]]]]), {k, 1, 
        4}]

b

solv1 = 
      Solve[1 == x^4 *z1/z2 Conjugate[z3], {x}] // Flatten

N[%]

solvNew1 = Table[x /. solv1[[k]], {k, 1, 4}]

Table[
      Abs[solvNew1[[k]]] E^(Arg[solvNew1[[k]]]), {k, 1, 
        4}]

Table[
      Abs[N[solvNew1[[k]]]]  e^(N[Arg[solvNew1[[k]]]]), {k, 1, 
        4}]

c

Table[r[k] = x /. solv[[k]], {k, 1, 4}]

tab = 
      Table[{Re[r[k] = x /. solv[[k]]] // 
            N, 
Im[r[k] = x /. solv[[k]]] // N}, {k, 1, 
          4}]

tab1 = 
      Table[{Re[r[k] = x /. solv1[[k]]] // 
            N, 
Im[r[k] = x /. solv1[[k]]] // N}, {k, 
          1, 4}]

tab1[[4]]

Table[Point[tab[[k]]], {k, 1, 4}]

Table[Point[tab1[[s]]], {s, 1, 4}]

{PointSize[0.02], 
        Point[{-1.389963484834079, 0.3139182946195302}], 
        Point[{-0.3139182946195302, -1.389963484834079}], 
        Point[{0.3139182946195302, 1.389963484834079}], 
        Point[{1.389963484834079, -0.313918294619530}], 
        Point[{0, 
            0}], 
Point[{-0.6845279111479716, -0.15459818680969997}], 
        Point[{0.15459818680969997, -0.6845279111479716}], 
        Point[{-0.15459818680969997, 0.6845279111479716}], 
        Point[{0.6845279111479716, 0.15459818680969997}]};

Show[
        Graphics[{PointSize[0.02], 
            Point[{-1.389963484834079, 0.3139182946195302}], 
            Point[{-0.3139182946195302, -1.389963484834079}], 
            Point[{0.3139182946195302, 1.389963484834079}], 
            Point[{1.389963484834079, -0.313918294619530}], 
            Point[{0, 
                0}], 
Point[{-0.6845279111479716, -0.15459818680969997}], 
            Point[{0.15459818680969997, -0.6845279111479716}], 
            Point[{-0.15459818680969997, 0.6845279111479716}], 
            Point[{0.6845279111479716, 0.15459818680969997}], 
            Circle[{0, 0}, 1], Line[{{-2, 0}, {2, 0}}], 
            Line[{{0, -2}, {0, 2}}]}], 
        AspectRatio -> Automatic];

d

Abstände: r und 1/r

{w = x /. solv[[1]], w1 = x /. solv1[[1]]}

r = Sqrt[N[w]*N[Conjugate[w]]] // Chop

r1 = Sqrt[N[w1]*N[Conjugate[w1]]] // Chop

r*r1

e

Winkel?

Arg[w]

Arg[N[w]]

Arg[N[w1]]

Arg[N[w]] + Arg[N[w1]]

Remove[w, w1, r, r1]

5

Induktion

Zeige mit vollständiger Induktion

Sum[k^3, {k, 1, n}]

% // Expand

Sum[k, {k, 1, n}]

% // Expand

Sum[k, {k, 1, n}]^2

% // Expand

(Sum[k^3, {k, 1, n}] + Sum[k, {k, 1, n}] // 
          Expand ) == (Sum[
              k, {k, 1, n}] (Sum[k, {k, 1, n}] + 1)  // 
          Expand)

Sum[k^2, {k, 1, n}]

% // Expand

b     Sternen

Remove[p]

m = {0, 0}; 
    q[s_] = {Cos[s Pi/2 /3], 
        Sin[s Pi/2 / 3]};
vLen[v_] := Sqrt[v . v]; p[k_] := q[k]/vLen[q[k]]

r = 2;
s1 = 
        Show[Graphics[{Circle[{0, 0}, 1], Circle[{0, 0}, r], 
              Line[{p[0], -p[0]}], Line[{r p[1], -r p[1]}], 
              Line[{p[2], -p[2]}], Line[{r p[3], -r p[3]}], 
              Line[{p[4], -p[4]}], Line[{r p[5], -r  p[5]}], 
              Thickness[ .02], 
              Line[{p[0], r p[1], p[2], r p[3], p[4], r p[5], p[6], 
                  r p[7], p[8], r p[9], p[10], r p[11], p[12]}]}], 
          AspectRatio -> Automatic];

r = 3;
s1 = 
        Show[Graphics[{Circle[{0, 0}, 1], Circle[{0, 0}, r], 
              Line[{p[0], -p[0]}], Line[{r p[1], -r p[1]}], 
              Line[{p[2], -p[2]}], Line[{r p[3], -r p[3]}], 
              Line[{p[4], -p[4]}], Line[{r p[5], -r  p[5]}], 
              Thickness[ .02], 
              Line[{p[0], r p[1], p[2], r p[3], p[4], r p[5], p[6], 
                  r p[7], p[8], r p[9], p[10], r p[11], p[12]}]}], 
          AspectRatio -> Automatic];

s2 = 
        Show[Graphics[{Line[{p[0], 2  p[1], p[2], 2  p[3], p[4], 2  p[5], 
                  p[6], 2  p[7], p[8], 2  p[9], p[10], 2  p[11], p[12]}]}], 
          AspectRatio -> Automatic];

Remove[r]

q[s_, r_] = r {Cos[s Pi/2 /3], Sin[s Pi/2 / 3]}

q[1, 2] - q[1, 1]

Det[{q[0, 1], q[1, 1]}]

Det[{q[1, 2] - q[1, 1], q[1, 2] - q[0, 1]}]

6*(Det[{q[0, 1], q[1, 1]}] + 
          Det[{q[1, 2] - q[1, 1], q[1, 2] - q[0, 1]}])

r2

6*(Det[{q[0, r1], q[1, r1]}] + 
          Det[{q[1, r2] - q[1, r1], q[1, r2] - q[0, r1]}])

Det[{q[1, r2] - q[1, r1], q[1, r2] - q[0, r1]}]

Det[{q[0, r1], q[1, r1]}]

6

Dodekaeder, Kantenlänge, darin Würfel
Skizziere Würfel
Berechne Kantenlängen
Berechne Haubenhöhe (Würfel schneidet Haube weg)
Berechne Flächenwinkel

a

Remove[z1, z2, z3, z4, z5]

z[k_] := E^(I 2  Pi k/5)

tab = Table[z[k], {k, 0, 4}]

v1 = (tab[[4]] + tab[[5]])/2

v2 = (tab[[5]] + tab[[1]])/2

tab1 = Table[-(z[k] - 2 v1), {k, 0, 4}]

tab2 = Table[-(z[k] - 2 v2), {k, 0, 4}]

a

ttab = 
      Join[{PointSize[0.02]}, 
        Table[Point[{Re[z[k]] // N, 
Im[z[k]] // N}], {k, 
            0, 4}]]

ttabLine = {Line[
          Table[{Re[z[k]] // N, 
Im[z[k]] // N}, {k, 0, 
              5}]]}

ttab1 = 
      Join[{PointSize[0.02]}, 
        Table[Point[{Re[tab1[[k]]] // 
                N, 
Im[tab1[[k]]] // N}], {k, 1, 
            5}]]

ttabLine1 = {Line[
          RotateRight[
            Table[{Re[tab1[[k]]] // 
                  N, 
Im[tab1[[k]]] // N}, {k, 1, 
                5}]]]}

ttab2 = 
      Join[{PointSize[0.02]}, 
        Table[Point[{Re[tab2[[k]]] // 
                N, 
Im[tab2[[k]]] // N}], {k, 1, 
            5}]]

ttabLine2 = {Line[
          RotateLeft[
            Table[{Re[tab2[[k]]] // 
                  N, 
Im[tab2[[k]]] // N}, {k, 1, 5}], 
            0]]}

Grafik

Show[{Graphics[ttab], Graphics[ttabLine], Graphics[ttab1], 
          Graphics[ttabLine1], Graphics[ttab2], Graphics[ttabLine2]}, 
        AspectRatio -> Automatic];

<< Graphics`Polyhedra`

Show[Graphics3D[Dodecahedron[]]];

b

Table[
      pt[k] = {Re[z[k]] // N, 
Im[z[k]] // N}, {k, 0, 
        4}]

vecLen[v_] := Sqrt[v . v]

vecLen[pt[2] - pt[1]]

ptab = {Point[{Re[z[0]] // N, Im[z[0]] // N}], 
        Point[{Re[z[3]] // N, Im[z[3]] // N}], 
        Point[{Re[z[4]] // N, Im[z[4]] // N}]}

p1 = {1. , 0. }; 
    p2 = {-0.8090169943749475, -0.5877852522924731};
p3 = {0.30901699437494745, -0.9510565162951535};
p4 = {0.30901699437494745, -2.1266270208801};
p5 = {1. , -1.902113032590307};

vecLen[p3 - p1]

c

ptab1 = {Point[{Re[tab1[[3]]] // N, 
            Im[tab1[[3]]] // N}]}

ptab2 = {Point[{Re[tab2[[2]]] // N, 
            Im[tab2[[2]]] // N}]}

a[t_] := p3 + t (p3 - p2);
b[t_] := p3 + t (p3 - p1);
aS[t_] := 
        p4 + t {-(p3 - p2)[[2]], (p3 - 
                    p2)[[1]]};
bS[t_] := 
        p5 + t {-(p3 - p1)[[2]], (p3 - 
                    p1)[[1]]};
{a[t], b[t], aS[t], bS[t]}

sol1 = Solve[aS[t1] == bS[t2], {t1, t2}] // Flatten

{aS[t1], bS[t2]} /. sol1

pPar = 
        ParametricPlot[{a[t], b[t], aS[t], bS[t]}, {t, -2, 2}, 
          AspectRatio -> Automatic];

Show[{Graphics[ptab], Graphics[ptab1], Graphics[ptab2]}, 
        AspectRatio -> Automatic];

Show[{Graphics[ptab], Graphics[ptab1], Graphics[ptab2], pPar}, 
        AspectRatio -> Automatic];

aSz[t_, s_] := aS[t]; bSz[t_, s_] := bS[t]; 
    seite = Sqrt[(p3 - p2) . (p3 - p2)]

solv1 = 
      Solve[aSz[t1, s] == bSz[t2, s], {t1, t2}] // Flatten

h[z_] := aSz[t1, z] /. solv1[[1]];  h[z]

Show[{Graphics[ptab], Graphics[ptab1], Graphics[ptab2], pPar}, 
        Graphics[{Point[h[z]]}], AspectRatio -> Automatic];

kugel[x_, y_, z_] := ({x, y} - p3) . ({x, y} - p3) + 
        z^2

kugel[x, y, z] == seite^2

solv2 = 
      Solve[{kugel[h[z][[1]], h[z][[2]], z] == 
              seite^2}, {z}] // Flatten

pz1 = {1. , 0. , 0}; 
    pz2 = {-0.8090169943749475, -0.5877852522924731, 
        0};
pz3 = {0.30901699437494745, -0.9510565162951535, 
          0};
pz4 = {0.30901699437494745, -2.1266270208801, 
          0};
pz5 = {1. , -1.902113032590307, 0};

pz6 = {h[z][[1]], h[z][[2]], z} /. 
        solv2[[2]]

pANDq

d

n1 = Cross[pz2 - pz6, pz3 - pz6]

n2 = Cross[pz3 - pz6, pz1 - pz6]

vecLen[v_] := Sqrt[v . v]

winkel = n1 . n2/(vecLen[n1] vecLen[n2])

ArcCos[winkel]

ArcCos[winkel]/Degree

flaechenwinkel = 180 - ArcCos[winkel]/Degree