Resampling: Bootstrap und Jackknife

<<Statistics`DescriptiveStatistics`;
<< Graphics`Graphics`;

Jackknife

(* Datengenerierung *)
m=50;
ind[j_]:=Table[12.+Floor[40 (Random[]^3)]/10.+1 ,{k,1,m}];
tabx = ind[0]

(* Histogramm der generierten Daten *)
Histogram[tabx,HistogramCategories -> Table[k,{k,12,20,0.1}]];

(* Mitelwert der generierten Daten *)
meanTabx=Mean[tabx]

(* Resampling: Jackknife *)
sampl[k_]:= Drop[tabx,{k}];
meanSamplek[k_]:=Mean[sampl[k]];
tabMean=Table[meanSamplek[k],{k,1,Length[tabx]}]

(* Mean Jackknifedaten zur Kontrolle *)
meanJack=Mean[tabMean]

meanTabx==meanJack

(* Deskriptive Statistik: Report 1 *)
LocationReport[tabMean]

(* Deskriptive Statistik: Report 2 *)
DispersionReport[tabMean]

(* Deskriptive Statistik: Report 3 *)
ShapeReport[tabMean]

(* Rundungen der generierten Mittelwerte *)
tabMeanW=Round[50 tabMean]/50.

(* Histogramm der generierten Mittelwerte *)
Histogram[tabMean];

(* Histogramm der generierten gerundeten Mittelwerte *)
Histogram[tabMeanW];

(* Jackknife Standardfehlerschätzer *)
SDtabMean=Sqrt[(Length[tabx]-1)/Length[tabx] Apply[Plus, Table[(tabMean[[k]]-Mean[tabMean])^2 ,{k,1,Length[tabx]}]]]

(* Standardabweichung der generierten Mittelwerte *)
StandardDeviation[tabMean]

Bootstrap

(* Anzahl Samples *)
bootstrap=50;

(* Daten vo Jackknife übernommen *)
tabx

(* Histogramm der generierten Daten *)
Histogram[tabx,HistogramCategories -> Table[k,{k,12,20,0.1}]];

(* Mitelwert der generierten Daten *)
meanTabx=Mean[tabx]

(* Resampling: Bootstrap *)
randInt[k_]:=Table[Random[Integer,{1,m}],{j,1,m}];
Table[randIntFix[k]=randInt[k],{k,1,bootstrap}];
sampl[k_]:= Table[tabx[[(randIntFix[k][[j]])]],{j,1,m}];
meanSamplek[k_]:=Mean[sampl[k]];
tabMean=Table[meanSamplek[k],{k,1,bootstrap}]

(* Mean Bootstrapdaten zur Kontrolle *)
meanBootstrap=Mean[tabMean]

meanTabx==meanBootstrap

(* Deskriptive Statistik: Report 1 *)
LocationReport[tabMean]

(* Deskriptive Statistik: Report 2 *)
DispersionReport[tabMean]

(* Deskriptive Statistik: Report 3 *)
ShapeReport[tabMean]

(* Rundungen der generierten Mittelwerte *)
tabMeanW=Round[50 tabMean]/50.

(* Histogramm der generierten Mittelwerte *)
Histogram[tabMean];

(* Histogramm der generierten gerundeten Mittelwerte *)
Histogram[tabMeanW];

(* Standardabweichung der generierten Mittelwerte *)
StandardDeviation[tabMean]
0.0261677

Table[
randInt[k_]:=Table[Random[Integer,{1,m}],{j,1,m}];
Table[randIntFix[k]=randInt[k],{k,1,bootstrap}];
sampl[k_]:= Table[tabx[[(randIntFix[k][[j]])]],{j,1,m}];
meanSamplek[k_]:=Mean[sampl[k]];
tabMean=Table[meanSamplek[k],{k,1,bootstrap}];
meanBootstrapN[h]=Mean[tabMean];
StandardDeviationN[h]=StandardDeviation[tabMean];
Print["Nr. = ",h," Mean = ",meanBootstrapN[h]," SD = ",StandardDeviationN[h]];
"Wiederholbar mit verändertem h!",{h,1,10}]

(* Gesamtmittelwert und Standardabweichungen bei wiederholtem Bootstrap *)
tabRes[w_]:=Table[
randInt[k_]:=Table[Random[Integer,{1,m}],{j,1,m}];
Table[randIntFix[k]=randInt[k],{k,1,bootstrap}];
sampl[k_]:= Table[tabx[[(randIntFix[k][[j]])]],{j,1,m}];
meanSamplek[k_]:=Mean[sampl[k]];
tabMean=Table[meanSamplek[k],{k,1,bootstrap}];
meanBootstrapN[h]=Mean[tabMean];
StandardDeviationN[h]=StandardDeviation[tabMean];
Print["Nr. = ",h,", Mean = ",meanBootstrapN[h],", SD = ",StandardDeviationN[h]];
If[h==w,Print["Wiederholbar mit verändertem h!","  Stop"]],{h,1,w}];
tabRes[15]

Probierecke

Remove["Global`*"]

tabx = Table[12+2 Random[],{n,1,30}]

meanTabx=Mean[tabx]

sampl[k_]:= Drop[tabx,{k}];
meanSamplek[k_]:=Mean[sampl[k]]

tabMean=Table[meanSamplek[k],{k,1,Length[tabx]}]

Mean[tabMean]

SDtabMean=Sqrt[(Length[tabx]-1)/Length[tabx] Apply[Plus, Table[(tabMean[[k]]-Mean[tabMean])^2 ,{k,1,Length[tabx]}]]]