Lösungen Teil 1

1

Remove["Global`*"]

a

f1[r_, φ_, x_] := {x, r Cos[φ], 
          r Sin[φ]};
r = 20;
p1 = 
        ParametricPlot3D[
          f1[r, φ, x], {φ, 0, 2  Pi}, { x, -r, 
            r}];
f2[r_, φ_, z_] := {r Cos[φ], 
          r Sin[φ], z};
p2 = 
        ParametricPlot3D[
          f2[r, φ, z], {φ, 0, 2  Pi}, { z, -r, 
            r}];
Show[p1, p2];

f3[x_, y_, z_] := {x, y, 0};
p3 = 
        ParametricPlot3D[
          f3[x, y, z], {x, -r, r}, { y, -r, 
            r}];
Show[p1, p2, p3];

f1[r_, φ_, x_] := {x, r Cos[φ], 
          r Sin[φ]};
r = 20;
p1 = 
        ParametricPlot3D[
          f1[r, φ, x], {φ, 0, Pi/2}, { x, 0, 
            r}];
f2[r_, φ_, z_] := {r Cos[φ], 
          r Sin[φ], z};
p2 = 
        ParametricPlot3D[
          f2[r, φ, z], {φ, 0, Pi/2}, { z, 0, 
            r}];
Show[p1, p2, ViewPoint -> {1.848,  2.455,  1.418}];

Remove["Global`*"]

r = 20;
f1New[r_, x_, y_] := {x, y, 0} /;  
          x^2 + y^2 > r^2;
f1New[r_, x_, y_] := {x, y, x} /; 
          x^2 + y^2 ≤ r^2 ;
f2New[r_, φ_, 
          z_] := {r Cos[φ], r Sin[φ], 0} /;  
          z > r Cos[φ];
f2New[r_, φ_, 
          z_] := {r Cos[φ], r Sin[φ], z} /;  
          z ≤  r Cos[φ];
p1 = 
        ParametricPlot3D[f1New[r, x, y], {x, 0, r}, { y, 0, r}, 
          ViewPoint -> {-1.867,  -2.569,  1.168}, 
          PlotPoints -> 70];
p2 = 
        ParametricPlot3D[
          f2New[r, φ, z], {φ, 0, Pi/2}, { z, 0, r}, 
          ViewPoint -> {-1.867,  -2.569,  1.168}, 
          PlotPoints -> 70];

b

Der gesuchte Körper besteht aus 8 mal 2 mal sochen kongruenten Teilen.

Integrate[1, {z, 0, x}]

r = 20;
int = 
      Integrate[
        Integrate[Integrate[1, {z, 0, x}], {x, 0, Sqrt[20^2 - y^2]}], {y, 0, 
          r}]

N[%]

V = 2*8*int

N[%]

intN = 
      2*8*NIntegrate[
          1, {y, 0, r}, {x, 0, Sqrt[20^2 - y^2]}, {z, 0, x}]

2

Remove["Global`*"]

a

LaplaceTransform[Sin [3  t] + Sinh [5  t], t, s]

% // Together

% // ExpandAll // Together

% // Apart

b

LaplaceTransform[E^(t - 3)*E^(t + 3), t, s]

c

LaplaceTransform[(E^t) (1 + Sin[t]), t, 
      s]

% // Together

% // ExpandAll // Together

d

LaplaceTransform[(t/(1 + (t^2))), t, s]

e

LaplaceTransform[DiracDelta[t] + (1 + t)^2, t, s]

% // Together

% // Factor

f

InverseLaplaceTransform[2  s/(4  s^2 + 1), s, t]

g

InverseLaplaceTransform[(s^2)/(s^2 + 1), s, t]

h

InverseLaplaceTransform[1/s + 1/s^2 + 1/s^3, s, t]

i

InverseLaplaceTransform[E^(-3)/(s - 1) + E^3/(s - 1), 
      s, t]

% // ExpandAll

k

InverseLaplaceTransform[(2/(s^3)) + (1/(1 + (s^2))) + (4/(s + (s^2))), s, 
      t]

3

Remove["Global`*"]

a

DSolve[y'''[t] - 3 y''[t] + 3  y'[t] - y[t] == 
        E^(-t), y, t]

f[t_, C1_, C2_, 
          C3_] := -((E^(-t))/8) + (E^t) C1 + (E^t) t C2 + (E^t) (t^2) C3;
f[t, C[1], C[2], C[3]]

{f[t, C[1], C[2], C[3]] == 0, 
        Evaluate[D[f[t, C[1], C[2], C[3]], t]] == 0, 
        Evaluate[D[f[t, C[1], C[2], C[3]], {t, 2}]] == 0} /. 
      t -> 0

solv = 
      Solve[{-(1/8) + C[1] == 0, 
            (1/8) + C[1] + C[2] == 
              0, -(1/8) + C[1] + 2 C[2] + 2 C[3] == 0}, {C[1], 
            C[2], C[3]}] // Flatten

Eine einzige Lösung bei diesen Bedingungen

b

f[t_] := f[t, C[1], C[2], C[3]] /. solv;  f[t]

% // Simplify

Plot[f[t], {t, -1, 2.5}];

c

Evaluate[D[f[t], t]]

Steigt mindestens exponentiell

Plot[(Evaluate[D[f[t], t]] /. t -> t1), {t1, -1, 
          2.5}];

Plot[(Evaluate[D[f[t], t]] /. t -> t1), {t1, -10^-8, 
          10^-8}];

Präzision muss höher gestellt werden - wird hier des Aufwandes wegen unterlassen

FindRoot[Evaluate[D[f[t], t]] == 0, {t, 0}]

FindRoot[Evaluate[D[f[t], t]] == 0, {t, -1}]

Problem der schwach eingestellten Präzision ==> Abbruch der Iteration im Bereich von (10^(-8))

FindRoot[Evaluate[D[f[t], t]] == 0, {t, 1}]

Problem der schwach eingestellten Präzision ==> Abbruch der Iteration im Bereich von (10^(-8))

Resultat: Nur ein Wendepunkt - wegen der Monotonie

d

d = 
      NIntegrate[
        Sqrt[1 + ((Evaluate[D[f[t], t]] /. 
                    t -> t1))^2], {t1, -1, 2.5}]

d = 
      NIntegrate[
        Sqrt[1 + ((Evaluate[D[f[t], t]] /. 
                    t -> t1))^2], {t1, -1, 6}]

e

loes = 
      DSolve[{y'''[t] - 3 y''[t] + 3  y'[t] - y[t] == t^2, 
            y[0] == -1, y'[0] == 0, y''[0] == 0}, y, t] // 
        Flatten

yLoes[t_] := y[t] /. loes;    yLoes[t]

yLoes[t] // Expand // Simplify

4

Remove["Global`*"]

a

DSolve[{x''[t] - y[t] == 0,  
        y[t] - x'[t] == 2  Sin[t], x[0] == 1, 
        y[0] == -1, x'[0] == -1}, {y, x}, 
      t]

x[t_] := 
      Cos[t] - Sin[t];    y[t_] := -Cos[t] + Sin[t];

v[t_] := {x[t], y[t]};
ParametricPlot[v[t], {t, 0, 4  Pi}];

b

v[t_] := {x[t], Sin[t] y[t]};
ParametricPlot[v[t], {t, 0, 4  Pi}];

5

Remove["Global`*"]

a

Integrate[ (2  x - y) , {x, 0, 2  Pi}, {y, 0, 4  Pi}]

Integrate[ (2  x - y)  +   Sin[x y], {x, 0, 2  Pi}, {y, 0, 
        4  Pi}]

NIntegrate[ (2  x - y)  +   Sin[x y], {x, 0, 2  Pi}, {y, 0, 
        4  Pi}]

Integrate[(2  x -  y)  +  Sin[x  + y], {x, 0, 2  Pi}, {y, 0, 
        4  Pi}]

NIntegrate[(2  x -  y)  +  Sin[x  + y], {x, 0, 2  Pi}, {y, 0, 
        4  Pi}]

% // Chop

6

Remove["Global`*"]

v'[t] == g - c/m  v[t]^2

c == cw ϱ A/2

v'[Inf] == 0 == g - c/m  v[Inf]^2

Solve[0 == g - c/m  v[Inf]^2, { v[Inf]}]

v[Inf] == (((Sqrt[g]) (Sqrt[m]))/(Sqrt[c]));  
    v[Inf]^2 == ((((Sqrt[g]) (Sqrt[m]))/(Sqrt[c])))^2

Evaluate[
      v[Inf]^2 == (((g m)/c) /. (m/c) -> 
              1/k)]

Solve[
      Evaluate[v[Inf]^2 == (((g m)/c) /. (m/c) -> 
                1/k)], {k}]

v'[t] == g - (g/(vInf^2))  v[t]^2

Solve[0 == g - c/m  vInf^2, {vInf}]

DSolve[v'[t] == g - (g/(vInf^2))  v[t]^2, v, t]

solv = DSolve[v'[t] == g - (g/(vInf^2))  v[t]^2, v, t] /. 
            vInf -> (((Sqrt[g]) (Sqrt[m]))/(Sqrt[c])) // Simplify // 
        Flatten

vNeu[t_] := v[t] /. solv;  vNeu[t]

vNeu[t_] := Simplify[%] /. C[1] -> 0;  vNeu[t]

h = 1000;  g = 9.81;  m = 100;  cw = 1.33;  ϱ = 1.2;  
    A = 25; c = cw ϱ A/2;

DSolve[v'[t] == g - (g/(vInf^2))  v[t]^2, v, t] /. 
        vInf -> (((Sqrt[g]) (Sqrt[m]))/(Sqrt[c])) // Simplify

Solve[(7.012341429995196` Tanh[
                0.01` (((981.` t)/7.012341429995196)` + 
                      100.` 7.012341429995196` C[1])] /. 
            t -> 0) == 0, {C[1]}]

(DSolve[v'[t] == g - (g/(vInf^2))  v[t]^2, v, 
            t] /. {vInf -> (((Sqrt[g]) (Sqrt[m]))/(Sqrt[c])), C[1] -> 0}) // 
      Simplify

v[t_] := 
      7.012341429995196` Tanh[
            0.01` (((981.` t)/7.012341429995196)` + 
                  100.` 7.012341429995196` 0)] // Chop

v[t]

Plot[v[t], {t, 0, 10}, PlotRange -> {0, 7.2}];

b

sNeu[t_] := 
      h - Integrate[vNeu[t1], {t1, 0, t}, 
          Assumptions -> {Element[t1, Reals], 
              Element[t, Reals] && t >  0}];  
    sNeu[t]

s[t_] := 
      h - Integrate[v[t1], {t1, 0, t}, 
          Assumptions -> {Element[t1, Reals], 
              Element[t, Reals] && t >  0}];  s[t]

s[t_] := 
      1000.` - 
        5.012531328320802` Log[Cosh[1.3989621152840417` t]]

Plot[s[t], {t, 0, 1}];

Plot[s[t], {t, 0, 150}];

c

FindRoot[s[t] == 0, {t, 150}]

7

T[x_, t_] := 40 - 4 x;
T[0, t]

T[10, t]

T[x, t]

Unabhängig von t

D[T[x, t], t]

D[T[x, t], {x, 2}]

D[T[x, t], t] == D[T[x, t], {x, 2}]

Lösung gefunden:   T[x,t]=40-4 x

Lösungen Teil 2

1

Remove["Global`*"]

a

120.8 == 1/500 (sumFix  +  76 110)

solv1 = 
        Solve[120.8 == 1/500 (sumFix  +  76 110), {sumFix}] // 
          Flatten;
sumFix = sumFix /. solv1

mittelwert = 1/500 (sumFix  +  76 130)

b

(500 - 1)/500  6.24^2 == 
      1/500 (QS  +   76 110^2) - 120.8^2

solv2 = 
        Solve[(500 - 1)/500  6.24^2 == 
              1/500 (QS  +   76 110^2) - 120.8^2, {QS}] // 
          Flatten;
QS = QS /. solv2

s = 
      Sqrt[1/(500 - 1) (QS   +  76 130^2) - 
          123.84`^2]

2

Der Fall 4 mit 0 wird gestrichen. 9 mal kommt "+" vor und 2 mal "-" von den 11 Fällen.
P(X ≥ 9) = 1 - P(X ≤ 8) := P,   p=q=0.5

p = 0.5;  q = p;
P = 
      1 - Sum[Binomial[11, k]  p^k q^(11 - k), {k, 0, 8}]

P = 0.0327148...  ist hier nicht kleiner als α = 0.01. Daher kann H1 nicht auf signifgikante Weise angenommen werden. H0 muss daher belassen werden. 
Zum Beispiel zu α = 0.035. Könne man H1 auf signifgikante Weise annehmen. H0 müsste man dann ablehnen.

3

Remove["Global`*"]

dat1 = {45, 7, 4, 49, 11, 7, 7, 5, 7, 41, 53, 1, 4, 41, 41, 22, 21, 
          2, 8, 2};
dat2 = {27, 44, 4, 1, 16, 4, 12, 49, 2, 23, 68, 3, 13, 13, 50, 4, 42, 
          7, 27, 1};

a

Mean[dat1] // N

Mean[dat2] // N

Beanstandung nicht nachvollziehbar

b

StandardDeviation[dat1] // N

StandardDeviation[dat2] // N

Beanstandung nicht nachvollziehbar

c

<< Statistics`StatisticsPlots`

BoxWhiskerPlot[Transpose[{dat1, dat2}]];

{Median[dat1], Median[dat2]} // N

Im BoxWhiskerPlotsieht man, dass die Datensätze sehr ungleich streuen. Dazu ist der Median des einen Datensatzes fast doppelt so gross wie der andere!

4

Remove["Global`*"]

a

a0 = 46.50;  Δa0 = 0.01;   a1 = 46.497;  
    s = 0.044;
φ[x_, μ_, s_] := 
        1/(s Sqrt[
                  2 Pi])  E^(-(x - μ)^2 / (2 s^2));
schranke = a0 + 2  Δa0;
Plot[φ[x, a1, s], {x, 46.3, 46.7}];

test = Integrate[φ[x, a1, s], {x, -100, 200}]

WahrscheinlichkeitAusschuss = 
      Integrate[φ[x, a1, s], {x, a0 + 2  Δa0, 
          Infinity}]

b

FindRoot[
      Integrate[φ[x, a1, sNeu], {x, a0 + 2  Δa0, 
            Infinity}] == 0.01, {sNeu, 0.01}]

0.00988...ist von einer anderen Grössenordnung als 0.044. Eine Genauigkeit derart zu erhähen wird wohl mit grossen Kosten verbunden sein.

c

FindRoot[
      Integrate[φ[x, a1Neu, s], {x, a0 + 2  Δa0, 
            Infinity}] == 0.01, {a1Neu, 46.0}]

46.4176...ist von einer ähnlicher Grössenordnung wie 46.497. Hier liesse sich vielleicht was machen.

5

Remove["Global`*"]

a

N[1 - (364/365)^365]

N[1 - (364/365)^20]

b

P = 1 - (1 - 0.03)^20

c

p = 1/20;  q = 1 - p;
PXk[r_, k_] = 
        Binomial[r + k - 1, r - 1] p^r q^k;
 PXk[1, 0] +  PXk[1, 1] +  PXk[1, 2] +  PXk[1, 3] // 
      N

{  PXk[1, 0],  PXk[1, 1],  PXk[1, 2],  PXk[1, 3]} // N

Sum[PXk[1, u], {u, 0, 20}] // N

Sum[PXk[1, u], {u, 0, 40}] // N

Sum[PXk[1, u], {u, 0, 100}] // N

Work

Work Kissen

f[r_, φ_, ϑ_] := {r Sin[φ], 
          r Cos[φ] Cos[ϑ], 
          r  Sin[ϑ] };
ParametricPlot3D[
        f[20, φ, ϑ], {φ, 0, 
          2  Pi}, {ϑ, 0, 2  Pi}];

ParametricPlot3D[
        f[20, φ, ϑ], {φ, 0, 
          2  Pi}, {ϑ, 0, 2  Pi}, 
        ViewPoint -> {2.537,  -1.875,  -0.304}];