Lösungen / Statistik 1/15

Remove["Global`*"]

1.

<< Graphics`Graphics`

<< Statistics`DescriptiveStatistics`

tb = {{153, 1}, {154, 1}, {155, 2}, {156, 3}, {157, 3}, {158, 5}, {159, 
          6}, {160, 4}, {161, 5}, {162, 7}, {163, 5}, {164, 5}, {165, 
          6}, {166, 7}, {167, 5}, {168, 5}, {169, 6}, {170, 5}, {171, 
          6}, {172, 4}, {173, 3}, {174, 2}, {175, 3}, {176, 1}, {177, 
          1}, {178, 1}}

s = Sum[tb[[n]][[2]], {n, 1, Length[tb]}]

Table[
      freq[tb[[n]][[1]]] = tb[[n]][[2]], {n, 1, 
        Length[tb]}]

Table[freq[tb[[n]][[1]]], {n, 1, Length[tb]}]

freq[157]

Table[
      relfreq[tb[[n]][[1]]] = tb[[n]][[2]]/s, {n, 1, 
        Length[tb]}]

N[%]

μ = 
      Sum[tb[[n]][[1]] * 
          relfreq[tb[[n]][[1]]] , {n, 1, Length[tb]}]

N[%]

2.

Remove[u, v, w]

tab21 = 
      Table[u + v + w, {u, 1, 6}, {v, 1, 6}, {w, 1, 6}] // Flatten

<< Statistics`DataManipulation`

freq = Frequencies[tab21]

newFreq = 
      Table[{freq[[n]][[2]], freq[[n]][[1]]}, {n, 1, 
          Length[freq]}]

s = 
      Sum[newFreq[[n]][[2]], {n, 1, Length[newFreq]}]

Table[
      fr[newFreq[[n]][[1]]] = newFreq[[n]][[2]], {n, 
        1, Length[newFreq]}]

Table[
      fr[newFreq[[n]][[1]]], {n, 1, Length[newFreq]}]

fr[12]

Table[
      relfr[newFreq[[n]][[1]]] = newFreq[[n]][[2]]/
          s, {n, 1, Length[newFreq]}]

N[%]

μ = 
      Sum[newFreq[[n]][[1]] * 
          relfr[newFreq[[n]][[1]]] , {n, 1, 
          Length[newFreq]}]

N[%]

3 + (18 - 3)/2

3.

Remove[a, b, f, F, x]

f[x_] := a  (E^(-x^2) - b);  f[x]

{f[-7], f[7]}

s = Solve[f[7] == 0, {b}] // Flatten

f1[x_] := a  (E^(-x^2) - b) /. s;  f1[x]

F[x_] := Integrate[f1[t], {t, -7, x}];  F[x]

F[-7]

F[7]

ss = Solve[F[7] == 1, {a}] // Flatten

f2[x_] := f1[x] /. ss;  f2[x]

Plot[f2[x], {x, -7, 7}, PlotRange -> {0, 1}];

F2[x_] := F[x] /. ss;  F2[x]

Plot[F2[x], {x, -7, 7}, PlotRange -> {0, 1}];

4.

Begriffe siehe angegebene Literatur und Links im Aufgabenblatt.
http://de.wikipedia.org/wiki/Punktsch%C3%A4tzer 
http://de.wikipedia.org/wiki/Stichprobe 
http://de.wikipedia.org/wiki/Vertrauensintervall 
http://de.wikipedia.org/wiki/Konfidenzintervall 
http://de.wikipedia.org/wiki/Statistischer_Test 
http://de.wikipedia.org/wiki/Vorzeichentest 
http://de.wikipedia.org/wiki/Wilcoxon-Vorzeichen-Rang-Test

5.

Remove["Global`*"]

n = 145;
xQuer = 314.0;
σQuadrat = 1000;
σ = Sqrt[1000];
α = 0.01;

σ // N

NV[x_, μ_, σ_,  n_] := 
        1/(σ/Sqrt[n]  Sqrt[2 Pi]) E^(-1/
                  2 ((x - μ) Sqrt[
                          n]/σ)^2);
NV[μ, xQuer, σ, n]

Plot[NV[μ, xQuer, σ, n], {μ, 300, 325}];

Integrate[NV[μ, xQuer, σ, n], {μ, 280, 340}]

Integriere nur über die halbe Normalverteilung:

Integrate[
        NV[μ, xQuer, σ, n], {μ, xQuer, 
          x}] == (1 - α)/2

rootOben = 
      FindRoot[Evaluate[
            Integrate[
              NV[μ, xQuer, σ, n], {μ, xQuer, 
                x}]] == (1 - α)/2, {x, 320}]

cOben = x /. rootOben

cUnten = xQuer - (cOben - xQuer)

Integrate[
      NV[μ, xQuer, σ, n], {μ, cUnten, cOben}]

1 - 
      Integrate[
        NV[μ, xQuer, σ, n], {μ, cUnten, cOben}]

Das ist etwa α.  Lösung:   [cUnten, cOben] ist das Konfidenzintervall.

6.

a

Solange nicht mehrmals ohne Zurücklegen gezogen wird, kann man von einer Bernoulli-Verteilung ausgehen.

b[k_] := Binomial[20, k] (1/2)^k  (1/2)^(20 - k);   b[
      k]

b

Sum[N[b[k]], {k, 5, 15}]

c

Mit der Wahrscheinlichkeit 0.988182 (Konvidenzniveau) kommen bei einer solchen Ziehung mindestens 5 rote und maximal 15 rote Bonbons, d. h maximal 15 blaue und minimal 5 blaue in eine Tüte zu liegen. Das Konvidenzintervall zum Niveau 0.988182 ist damit [5, 15].

7.

M1 = {0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 
          12};
M2 = {56, 202, 381, 526, 530, 404, 270, 56, 137, 44, 26, 9, 
          3};

    
{a1, b1, c1} . {a2, b2, c2}

Length[M1] == Length[M2]

n = Apply[Plus, M2]

μ = M1 . M2 /n   // N

({a1, b1, c1} - d)^2

({a1, b1, c1} - d)^2  . {a2, b2, c2}

1/(n - 1)  (M2 . ((M1 - μ)^2))

σ  =  
      Sqrt[1/(n - 1) (M2 . ((M1 - μ)^2))]

σQuadrat = σ^2

RelativerFehler = (σ^2 - μ)/σ^2

a

f1[k_] := μ^k / k! E^(-μ)

p12 := P(X >12)=1-P(X ≤ 12)

p12 = 1 - Sum[f1[k], {k, 0, 12}]

Das ist weniger als ein Drittel Promill.

b

f2[k_] := σQuadrat^
            k / k! E^(-σQuadrat)

p12 = 1 - Sum[f2[k], {k, 0, 12}]

Das ist weniger als zwei Drittel Promill.