Lösungen / Statistik 1/14

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]}]

tb1 = 
      Table[{tb[[k]][[2]], tb[[k]][[1]]}, {k, 1, 
          Length[tb]}]

BarChart[tb1];

tb2 = 
      Table[{tb[[k]][[2]]/s // N, tb[[k]][[1]]}, {k, 
          1, Length[tb]}]

BarChart[tb2];

Remove[p]

p[n_] := 0;
p[n_] := tb2[[n]][[1]]  /; IntegerQ[
            n] &&  0 < n <  178 - 152

{p[0], p[0.5], p[1], p[2], p[3.1]}

plotTab = 
      Table[{tb2[[n]][[2]], p[n]}, {n, 1, 
          Length[tb2]}]

ListPlot[plotTab];

Remove[F]

F[x_] := 0;
F[x_] := 
      Sum[p[n - 152], {n, 153, Floor[x]}] /; Floor[x] > 152

{F[-1], F[1], F[152], F[153], F[154], F[200]}

Plot[F[x], {x, 150, 180}];

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]

s = Sum[freq[[n]][[1]], {n, 1, Length[freq]}]

BarChart[freq];

freq2 = 
      Table[{freq[[k]][[1]]/s // 
            N, freq[[k]][[2]]}, {k, 1, Length[freq]}]

BarChart[freq2];

Remove[p, F]

p[n_] := 0;
p[n_] := freq2[[n]][[1]]  /; IntegerQ[
            n] &&  0 < n <  18 - 2

{p[0], p[0.5], p[1], p[2], p[3.1]}

plotTab = 
      Table[{freq2[[n]][[2]], p[n]}, {n, 1, 
          Length[freq2]}]

ListPlot[plotTab];

F[x_] := 0;
F[x_] := Sum[p[n - 2], {n, 3, Floor[x]}] /; Floor[x] > 2

{F[-1], F[1], F[2], F[3], F[4], F[200]}

Plot[F[x], {x, 0, 20}];

3.

Remove["Global`*"]

λ = 6;
P[k_] := λ^k/k! E^(-λ) // 
          N;

a

Table[{k, P[k]}, {k, 0, 20}] // TableForm

a

EW = λ

StAbw  =  Sqrt[λ] // N

4.

Remove["Global`*"]

n = 30;  p = 0.2;  q = 1 - p; 
kk = 10;

P[k_] := 
        Binomial[n - 1, k - 1] p^(k - 1) q^(n - k) p // 
          N;

a

P[kk]/p

P[kk]

b

EW = kk/p

StAbw  =  Sqrt[kk (1 - p)/p^2] // N

5.

Remove["Global`*"]

a = 0;  b = 1;  h = 1/(b - a);

f[x_] := 0  /; x < a;
f[x_] := 
        h  /; (x ≥ a  &&  
              x ≤  b);
f[x_] := 0  /; x > b;

a

Plot[f[x], {x, -1, 2}, 
        AspectRatio -> Automatic];

b

EW = 
      Integrate[x  0, {x, -Infinity, a}] + 
        Integrate[x  h, {x, a, b}] +  
        Integrate[x  0, {x, b, Infinity}]

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

StAbw  =  Sqrt[(b - a)^2/12] // N

6.

Remove["Global`*"]

μ =  5.295;
σ =  0.003;

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

NV[x, μ, σ]

Plot[NV[x, μ, σ], {x, 5.285, 5.305}];

Integrate[
      Evaluate[NV[x, μ, σ]], {x, -100, 100}]

a

Integrate[Evaluate[NV[x, μ, σ]], {x, 5.29, 5.30}]

1 - 
      Integrate[Evaluate[NV[x, μ, σ]], {x, 5.29, 5.30}]

b

Integrate[Evaluate[NV[x, μ, σ]], {x, 5.298, 7}]

Integrate[Evaluate[NV[x, μ, σ]], {x, 5.298, 100}]

c

Integrate[
      Evaluate[NV[x, μ, σ]], {x, 5.291, 5.297}]

7.

Remove["Global`*"]

p = 3/10;  q = 1 - p;  n = 100000;

EW =  n p

StAbw  =  Sqrt[n p q]

StAbw  // N

μ = EW;
σ = StAbw ;

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

NV[x, μ, σ]

Plot[NV[x, μ, σ], {x, 29500, 30500}];

a

μ

σ // N

"sigma grösser 3"  ist erfüllt!  ==>  Approximation zulässig.

b

Integrate[
      Evaluate[NV[x, μ - 1/2, σ] - 
          NV[x, μ + 1/2, σ]], {x, -Infinity, a}]

result1 = 
      Integrate[
          Evaluate[NV[x, μ - 1/2, σ]], {x, -Infinity, 
            90000}] - 
        Integrate[
          Evaluate[NV[x, μ + 1/2, σ]], {x, -Infinity, 
            10000}]

N[result1, 100]

c

Integrate[
      Evaluate[NV[x, μ, σ]], {x, -Infinity, a}]

Integrate[
      Evaluate[NV[x, μ, σ]], {x, 10000, 90000}]

result2 = 
      N[Integrate[Evaluate[NV[x, μ, σ]], {x, 10000, 90000}], 
        100]

result1 - result2

Die Abweichung ist bei 100 Stellen nicht feststellbar  ==> Keine praktisch feststellbare Abweichung!!