中心極限定理(Central Limit Theorem)

１．母集団の作成

確率変数x,y に対する確率密度関数(PDF)が, それぞれ p(x)と ρ(y)のとき,
                                         p(x) dx =ρ(y)dy 
例えば p(x)=1,ρ(y)=(y^2) のとき，   1dx=(y^2)dy⇔ y=(^3)(Sqrt[3x])

ClearAll["Global`*"];
f[x_]=CubeRoot[3 x];
g[x_]:=RandomChoice[{1,-1}]* Sqrt[2Abs[x]];
h[x_]=Tan[ N[π] x];
p[x_]=Sqrt[2 x]-4/3;
uniform=Table[RandomReal[{-0.5,0.5}],{1000000}];
abs=Table[g[RandomReal[{-0.5,0.5}]],{1000000}];
stairs=Table[p[RandomReal[{0,2}]],{1000000}];
squared=Table[f[RandomReal[{-1/3,1/3}]],{1000000}];
caushy=Table[h[RandomReal[{-0.5,0.5}]],{1000000}];
twinpeaks=Table[RandomChoice[{1,-1}]*RandomReal[{0.4,0.5}],{1000000}];
caushyVariance=Variance[caushy](*不偏標本分散*)
Variance[#]&/@{uniform,squared,abs,stairs,twinpeaks}(*不偏標本分散*)

1 - 1. Uniform PDF

Show[Histogram[uniform,{-1,1,0.05},PDF,PlotRange->{{-1,1},{0,1}}]]

1 - 2. |X| PDF

Show[Histogram[abs,{-1,1,0.05},PDF,PlotRange->{{-1,1},{0,1}}],Plot[Abs[x],{x,-1,1},PlotRange->All]]

1 - 3. (X^2) PDF

Show[Histogram[squared,{-1,1,0.05},PDF,PlotRange->{{-1,1},{0,3/2}}],Plot[3/2(x^2),{x,-1,1},PlotRange->All]]

1 - 4. Stairs PDF

Show[Histogram[stairs,{-4/3,2/3,0.05},PDF,PlotRange->All],Plot[1/2(x+4/3),{x,-4/3,2/3},PlotRange->All]]

1 - 5. Caushy PDF

Show[Histogram[caushy,{-10,10,0.25},PDF,PlotRange->{{-10,10},{0,0.35}}],Plot[1/(1+x^2)/Pi,{x,-10,10},PlotRange->All]]

２．「ｎ個の平均」の確率密度関数

「母集団から ｎ個の標本を採り その平均を測る」 という操作を 10000 回行う

2 - 1. Uniform PDF の場合

Manipulate[
set1=Table[Mean[RandomSample[uniform,n]],{k,1,10000}];
Show[Histogram[set1,30,"PDF"],
Plot[PDF[NormalDistribution[0,1/Sqrt[12 n]],x],{x,-1,1},PlotRange->All]],
{n,1,99,1}]

2 - 2. squared PDF　の場合

Manipulate[
set2=Table[Mean[RandomSample[squared,n]],{k,1,10000}];
Show[Histogram[set2,50,"PDF"],
Plot[PDF[NormalDistribution[0,Sqrt[3/5]/Sqrt[n]],x],{x,-1,1},PlotRange->All]],
{n,1,99,1}]

2 -3. stairs PDF　の場合

Manipulate[
set4=Table[Mean[RandomSample[stairs,n]],{k,1,10000}];
Show[Histogram[set4,50,"PDF"],
Plot[PDF[NormalDistribution[0,Sqrt[2/9]/Sqrt[n]],x],{x,-1,1},PlotRange->All]],
{n,1,99,1}]

2 - 4. twin peaks PDF　の場合

Manipulate[
set3=Table[Mean[RandomSample[twinpeaks,n]],{k,1,10000}];
Show[Histogram[set3,50,"PDF"],
Plot[PDF[NormalDistribution[0,Sqrt[1/5]/Sqrt[n]],x],{x,-1,1},PlotRange->All]],
{n,1,200,1}]

2 - 5. Caushy PDF　の場合

Manipulate[
set5=Table[Mean[RandomSample[caushy,n]],{k,1,10000}];
Show[Histogram[set5,{-10,10,0.25},"PDF",PlotRange->{{-10,10},{0,0.35}}],Plot[{1/(1+x^2)/π,PDF[NormalDistribution[0,Sqrt[caushyVariance/n]],x]},{x,-10,10},PlotRange->All,PlotLegends->{"caushy","normal"}]],
{n,1,1001,10}]

n個の平均の分散

Manipulate[
set6=Table[Mean[RandomSample[caushy,n]],{k,1,1000}];
Row[{ "Variance = ",Floor[Variance[set6]]}],
{n,1,10001,100}]