Übungsaufgabe

Clear[EulerCauchy]
EulerCauchy[g_, {x_, x0_}, {y_, y0_}, h_, n_] := 
      Module[{j, plot, Achsen}, 
X[j_] := 
          x0 + j h; 
Y[0] = 
          y0; 
plot[0] = 
          Graphics[{PointSize[0.02], 
              Point[{X[0], Y[0]}]}]; 
Do[
          Y[j] = Y[j - 1] + 
              h (g /. {x -> X[j - 1], 
                      y -> Y[j - 1]}); 
plot[j] = 
            Graphics[{PointSize[0.02], 
                Point[{X[j], Y[j]}]}]
, {j, 1, 
            n}]; 
Achsen = 
          Plot[{}, {x, x0, n h}, 
            DisplayFunction -> Identity]; 
Show[
          Prepend[Table[plot[j], {j, 0, n}], Achsen], 
          DisplayFunction -> $DisplayFunction]
]

euler1 = EulerCauchy[(x/y), {x, 0}, {y, 1}, 0.1, 20]

Table[{j, X[j], Y[j]}, {j, 0, 20}]

dsol = 
      DSolve[{y'[x] == (x/y)[x], y[0] == 1}, y[x], x] // 
        Simplify

plot = Plot[y[x] /. dsol, {x, 0, 2}]

Show[euler1, plot]

fehlerliste = 
      Table[Abs[Y[k] - y[x] /. dsol[[1]] /. x -> 0.1 k], {k, 0, 
          20}]

fehler = Max[fehlerliste]

Implementierung des Runge-Kutta-Verfahrens

Clear[Rungekutta]
Rungekutta[g_, {x_, x0_}, {y_, y0_}, h_, n_] := 
      Module[{X, j, plot, Achsen}, 
X[j_] := 
          x0 + j h; 
Y[0] = 
          y0; 
plot[0] = 
          Graphics[{PointSize[0.02], 
              Point[{X[0], Y[0]}]}]; 
Do[k[0][j_] := 
            h (g /. {x -> X[j - 1], 
                    y -> Y[j - 1] }); 
k[1][
              j_] := h (g /. {x -> X[j - 1] + (h/2), 
                    y ->  
                      Y[j - 1] + k[0][j]/2}); 
k[
                2][j_] := 
            h (g /. {x -> X[j - 1] + (h/2), 
                    y ->  
                      Y[j - 1] + k[1][j]/2}); 
k[
                3][j_] := 
            h (g /. {x -> X[j - 1] + h, 
                    y ->  
                      Y[j - 1] + k[2][j]}); 
Y[j] = 
            Y[j - 1] + 
              (1/6) (k[0][j] + 2  k[1][j] + 
                    2  k[2 ][j] + k[3][
                      j]); 
plot[j] = 
            Graphics[{PointSize[0.02], Point[{X[j], Y[j]}]}], {j, 1, 
            n}]; 
Achsen = 
          Plot[{}, {x, x0, n h}, 
            DisplayFunction -> Identity]; 
Show[
          Prepend[Table[plot[j], {j, 0, n}], Achsen], 
          DisplayFunction -> $DisplayFunction]
]

runge1 = Rungekutta[(y^2), {x, 0}, {y, 1}, 0.1, 10]

Y[10]

dsol = 
      DSolve[{y'[x] == y [x]^2, y[0] == 1}, y[x], 
        x]

plot = Plot[y[x] /. dsol, {x, 0, 1}]

Show[runge1, plot, PlotRange -> {0, 20}]

Show[runge1, plot]

Prepend[
      Table[{j, X[j], k[0][j], k[1][j], k[2][j], k[3][j], 
          Y[j]}, {j, 1, 10}], {j, (Subscript[X, j]), (Subscript[k, 0]), (Subscript[k, 1]), (Subscript[k, 2]), (Subscript[k, 3]), 
        (Subscript[Y, j])}]

runge1 = Rungekutta[(y^2), {x, 0}, {y, 1}, 0.05, 20]

Show[runge1, plot, PlotRange -> {0, 50}]

Lineare Gleichungssysteme

Needs["Graphics`ImplicitPlot`"]

Gleichungssystem 1a

sol1 = 
      Solve[{780  x + 563  y == 217, 913  x - 659  y == 254}, {x, 
          y}]

NSolve[{780  x + 563  y == 217, 
        913  x - 659  y == 254}, {x, y}]

plot1 = 
      ImplicitPlot[{780  x + 563  y == 217, 
          913  x - 659  y == 254}, {x, -1, 1}, {y, -1, 
          1}]

Gleichungssystem 1b

NSolve[{781x+563  y==217,913  x - 659  y == 254},{x, y}]

sol2 = 
      Solve[{781  x + 563  y == 217, 913  x - 659  y == 254}, {x, 
          y}]

plot2 = 
      ImplicitPlot[{781  x + 563  y == 217, 
          913  x - 659  y == 254}, {x, -1, 1}, {y, -1, 
          1}]

Abstand des Fehlers

Abstand[{x1_, y1_}, {x2_, 
          y2_}] := (Sqrt[(((x2 - x1))^2) + (((y2 - y1))^2)])

Abstand[({x, y} /. sol1[[1]]), ({x, y} /. sol2[[1]])] // 
      N

Fehlerverstärkung

(1/((1/780))) 
        Abstand[({x, y} /. sol1[[1]]), ({x, y} /. 
              sol2[[1]])] // N

Gleichungssystem 2a

plot3 = 
      ImplicitPlot[{780  x + 563  y == 217, 
          913  x + 659  y == 254}, {x, -1, 1}, {y, -1, 
          1}]

sol3 = 
      Solve[{780  x + 563  y == 217, 913  x + 659  y == 254}, {x, 
          y}]

NSolve[{780  x + 563  y == 217, 
        913  x + 659  y == 254}, {x, y}]

Gleichungssystem 2b

plot4 = 
      ImplicitPlot[{781  x + 563  y == 217, 
          913  x + 659  y == 254}, {x, -1, 1}, {y, -1, 
          1}]

NSolve[{781x+563  y==217,913  x + 659  y == 254},{x, y}]

sol4 = 
      Solve[{781  x + 563  y == 217, 913  x + 659  y == 254}, {x, 
          y}]

Abstand des Fehlers

Abstand[({x, y} /. sol3[[1]]), ({x, y} /. sol4[[1]])] // 
      N

Fehlerverstärkung

(1/((1/780))) 
        Abstand[({x, y} /. sol3[[1]]), ({x, y} /. 
              sol4[[1]])] // N

Hilbertmatrix: Matrix, deren schlechte Kondition mit n->∞ gegen ∞ geht:

Hilbert[n_] := Table[(1/(j + k - 1)), {j, n}, {k, n}]

Hilbert[10]

x = LinearSolve[A = Hilbert[5], b = Table[Random[], {5}]]

fehler = A . x - b

x = LinearSolve[A = Hilbert[10], b = Table[Random[], {10}]]

fehler = A . x - b

x = LinearSolve[A = Hilbert[15], b = Table[Random[], {15}]]

Dieser Fehler ist nicht nahe bei 0:

fehler = A . x - b