Eine Bootstrap-Anwendung Schritt für Schritt

Mit Mathematica

Fall 1 resp. Beispiel 1: Generierung einer Menge von Zahlen als Messwerte

Remove["Global`*"]

Die Funktion "Random" (Wahl einer Zufallszahl zwischen 0 und 1)

Random[]

Wahl einer ganzen Zufallszahl zwischen 1 und 12

Random[Integer, {1, 12}]

Wahl von 20 ganzen Zufallszahlen zwischen 1 und 12

Table[Random[Integer, {1, 12}], {n, 1, 20}]

Wahl von 50 Zufallszahlen zwischen -10 und 10

M = Table[20  Random[] - 10, {n, 1, 50}]

Kontrolle:

M

Fall 1 resp. Beispiel 1: Bearbeitung der Menge von Messwerten

Histogramm und Mittelwert von M

<< Graphics`Graphics`;
Histogram[M];
M // Mean

Die 10-te Zahl aus M

z1 = M[[10]]

Kontrolle:

z1

Die n-te Zahl aus M, n = ganze Zufallszahl zwischen 1 und 50   ( 50 = |M| )

n1 = Random[Integer, {1, 50}];  
    z2 = M[[n1]];  {n1, z2}

Kontrolle:

z2

Eine Funktion u, die mit einer Nummer j eine Menge von 50  Zufallszahlen aus M so auswählt wie es eben geschehen ist (Exemplar Nummer j mit 50 Zahlen aus M)

u[j_] := 
      Table[M[[Random[Integer, {1, 50}]]], {k, 1, 50}]

tWork1 = u[1]

Kontrolle:

tWork1

Kontrolle der Anzahl der gewählten Zahlen

Length[u[1]]

Mit u[j],  j = 1 bis 80, wird in eine Tabelle mit dem Namen \glqq t\Grqq 80 mal der Mittelwert von 50 Zufallszahlen aus M geschrieben: Das sind jetzt Mittelwerte von 80 Bootstrap--Kopien!

tWork2 = Table[Mean[u[j]], {j, 1, 80}]

tWork2

Jetzt wird 20'000 mal der Mittelwert von 50 Zufallszahlen aus M in eine Tabelle geschrieben und damit ein Histogramm der Mittelwerte erstellt

t = Table[Mean[u[j]], {j, 1, 20000}]; Histogram[t];

Wir wiederholen das Programm und erstellen nochmals ein Histogramm (andere Bootstrapkopien, anderes Histogramm, ähnliche Form, aber verschoben...)

t = Table[Mean[u[j]], {j, 1, 20000}]; Histogram[t];

Die Form des Histogramms bleibt bei 20'000 mal "bootstrapen" beim zweiten Mal etwa ähnlich. Daher kann man einer daraus gewonnenen Verteilungsfunktion vertrauen.

Erstellung einer Verteilungsfunktion auf der Grundlage von Bootstrap-Kopien (hier mit 1000 Kopien)

<< Statistics`DataManipulation`

ttt = 
        Sort[Table[Mean[u[j]], {j, 1, 1000}]];
freq = Union[Frequencies[ttt]]; 
    F[x_] := Apply[Plus, 
          Table[Take[freq, 
                  Length[Select[
                      Table[freq[[k1, 2]], {k1, 1, 
                          Length[freq]}], # ≤ 
                          x &]]][[k1]][[1]], {k1, 1, 
              Length[Take[freq, 
                  Length[Select[
                      Table[freq[[k, 2]], {k, 1, 
                          Length[freq]}], # ≤ x &]]]]} ]]  /
        Length[ttt] ;
Plot[{F[x], 1}, {x, -3, 3}];

freq = Union[Frequencies[t]];

Fall 2 resp. Beispiel 2: Einlesen und bearbeiten von Messwerten

Hier wird erst eine neue Messreihe erzeugt.

Remove["Global`*"]

Einlesen resp. Erzeugung der Messwerte und Setzung der Parameter

nN = 12;
nHistogram = 20000;
nBootstrap = 1000;
M1 = Table[Random[]/10 + 20, {n, 1, nN}];

Bearbeitung mit Plug-in (Bootstrapping)

<< Graphics`Graphics`;
<< Statistics`DataManipulation`
M1 = 
        Table[Random[]/10 + 20, {n, 1, nN}];
Print["Messwerte:  ", M1];
Print["Mittelwert: ", M1 // Mean];
Histogram[M1];
u1[j_] := 
        Table[M1[[Random[Integer, {1, nN}]]], {k, 1, 
            50}];
Print["Kontrolle Anzahl:  ", 
        Length[u1[1]] == nN];
Print[
        nBootstrap, " mal bootstrapen"];
t1 = Table[Mean[u1[j]], {j, 1, nBootstrap}]; 
    Histogram[t1];
Print["Nochmals ", 
        nBootstrap, " mal bootstrapen"];
t1 = Table[Mean[u1[j]], {j, 1, nBootstrap}]; 
    Histogram[t1];
Print[
        nHistogram, " mal bootstrapen"];
t1 = Table[Mean[u1[j]], {j, 1, nHistogram}]; 
    Histogram[t1];
Print["Nochmals ", 
        nHistogram, " mal bootstrapen"];
t1 = Table[Mean[u1[j]], {j, 1, nHistogram}]; 
    Histogram[t1];
ttt1 = 
        Sort[Table[
            Mean[u1[j]], {j, 1, nBootstrap}]];
Print[nBootstrap, " Bootstrap-Kopien der Mittelwerte= ", 
        ttt1];
MeanMin = Min[ttt1];
MeanMax = Max[ttt1];
Print["Mittelwert Min. bis Max.  = ",   "[", 
        MeanMin, ", ", MeanMax, "]"];
freq = Union[Frequencies[ttt1]]; 
    F[x_] := Apply[Plus, 
          Table[Take[freq, 
                  Length[Select[
                      Table[freq[[k1, 2]], {k1, 1, 
                          Length[freq]}], # ≤ 
                          x &]]][[k1]][[1]], {k1, 1, 
              Length[Take[freq, 
                  Length[Select[
                      Table[freq[[k, 2]], {k, 1, 
                          Length[freq]}], # ≤ x &]]]]} ]]  /
        Length[ttt1] ;
Plot[{F[x], 1}, {x, MeanMin, MeanMax}];

Neue Messreihe

Work: Schrittweise Erzeugung einer Verteilungsfunktion, Fall 3 oder Beispiel 3

Remove["Global`*"]

<< Graphics`Graphics`;
<< Statistics`DataManipulation`;

Mit 80 Bootstrap-Kopien (Daten gewonnen wie eingangs)

M = 
        Table[20  Random[] - 10, {n, 1, 50}];
Print["Mean " , Mean[M]]
Histogram[M];
u[j_] := 
        Table[M[[Random[Integer, {1, 50}]]], {k, 1, 
            50}];
tWork2 = Table[Mean[u[j]], {j, 1, 80}];
tWork2

h = Sort[tWork2]

freq1 = Frequencies[tWork2];
freq2 = 
      Table[{freq1[[k]][[2]], freq1[[k]][[1]]}, {k, 
          1, Length[freq1]}]

freq2 = 
      Table[{freq1[[k, 2]], freq1[[k, 1]]}, {k, 1, 
          Length[freq1]}]

Length[freq1]

freq3 = Table[freq1[[k, 2]], {k, 1, Length[freq1]}]

Select[freq3, # ≤ 1 &]

Length[Select[freq3, # ≤ 1 &]]

Take[freq2, Length[Select[freq3, # ≤ 1 &]]]

tabX = 
      Take[freq2, 
        Length[Select[
            Table[freq1[[k, 2]], {k, 1, Length[freq1]}], # ≤ 
                0 &]]]

tabX2 = 
      Table[tabX[[k]][[2]], {k, 1, Length[tabX]} ]

Apply[Plus, tabX2]

freq1 = Frequencies[tWork2];
f[x_] := 
      Apply[Plus, 
        Table[Take[freq2, 
                Length[Select[
                    Table[freq1[[k, 2]], {k, 1, 
                        Length[freq1]}], # ≤ 
                        x &]]][[k]][[2]], {k, 1, 
            Length[Take[freq2, 
                Length[Select[
                    Table[freq1[[k, 2]], {k, 1, 
                        Length[freq1]}], # ≤ 
                        x &]]]]} ]]

{f[0], f[0.5], f[1], f[2], f[3]}

Plot[f[x], {x, Min[h] - 0.5, Max[h] + 0.5}];

freq1 = Frequencies[tWork2];
F1[x_] := 
        Apply[Plus, 
          Table[Take[freq1, 
                  Length[Select[
                      Table[freq1[[k1, 2]], {k1, 1, 
                          Length[freq1]}], # ≤ 
                          x &]]][[k1]][[1]], {k1, 1, 
              Length[Take[freq 1, 
                  Length[Select[
                      Table[freq1[[k, 2]], {k, 1, 
                          Length[freq1]}], # ≤ 
                          x &]]]]} ]];
Plot[F1[x], {x, Min[h] - 0.5, Max[h] + 0.5}];

Mit 1000 Bootstrap-Kopien

ttt = 
        Sort[Table[Mean[u[j]], {j, 1, 1000}]];
freq = Union[Frequencies[ttt]]; 
    F[x_] := Apply[Plus, 
          Table[Take[freq, 
                  Length[Select[
                      Table[freq[[k1, 2]], {k1, 1, 
                          Length[freq]}], # ≤ 
                          x &]]][[k1]][[1]], {k1, 1, 
              Length[Take[freq, 
                  Length[Select[
                      Table[freq[[k, 2]], {k, 1, 
                          Length[freq]}], # ≤ x &]]]]} ]]  /
        Length[ttt] ;
Plot[{F[x], 1}, {x, Min[h] - 0.5, Max[h] + 0.5}];