Code 1
In[]:=
ClearSystemCache[];
In[]:=
Clear[ϕ];
Measurement Probabilities
Measurement Probabilities
In[]:=
P02[ϕ_]:=Cos[ϕ/2]^4;P11[ϕ_]:=Sin[ϕ]^2/2;P20[ϕ_]:=Sin[ϕ/2]^4;
True Value of ϕ
True Value of ϕ
In[]:=
ϕ=1.5;
In[]:=
truephi=ϕ;
Roll of dice with random number generator for ν measurements generating tally of outcomes {m0, m1, m2}
Roll of dice with random number generator for ν measurements generating tally of outcomes {m0, m1, m2}
In[]:=
a=List[Re[P02[ϕ]],Re[P11[ϕ]],Re[P20[ϕ]]]
Out[]=
{0.28662,0.497498,0.215882}
In[]:=
Clear[b];Clear[r];Clear[c];
In[]:=
(*Initializeanemptylist'c'tostoretheresults*)c={};Do[b=ConstantArray[0,3];Clear[r];updateTally[]:=Block[{r},r=RandomReal[];If[r<a[[1]],b[[1]]+=1,If[a[[1]]<=r<a[[1]]+a[[2]],b[[2]]+=1,b[[3]]+=1]]];Do[updateTally[],{300}];AppendTo[c,b],{i,1,10000}];
In[]:=
(*MeasurmentOutcomeTotals*)c;
In[]:=
Clear[ϕ];
In[]:=
(*Definethelikelihoodandloglikelihoodfunctions*)L[ϕ_,m0_,m1_,m2_]:=**;llog[ϕ_,m0_,m1_,m2_]:=PowerExpand[Log[L[ϕ,m0,m1,m2]]]
4m0
Cos
ϕ
2
m1
Sin[ϕ]
2
4m2
Sin
ϕ
2
In[]:=
d=llog[ϕ,#[[1]],#[[2]],#[[3]]]&/@c;
In[]:=
LaunchKernels[];
In[]:=
MM=ParallelTable[ϕ/.NMaximize[{d[[i]],0<=ϕ<=Pi},ϕ][[2]],{i,Length[d]}];
Set Working Precision
Set Working Precision
In[]:=
(*MM=Table[NMaximize[d[[i]],0<=ϕ<=Pi,ϕ,WorkingPrecision->20],{i,Length[d]}];MM=MM[[All,2,1,2]];*)
Results Summary
Results Summary
In[]:=
mean=Mean[MM];(*Calculatethemeanofthedata*)variance=Variance[MM];(*Calculatethepopulationvariance*)Print["True value of phi:",truephi];Print["Mean of the data:",mean];Print["Bias of the estimator:",mean-truephi];Print["Variance of the data:",variance];
True value of phi:1.5
Mean of the data:1.47671
Bias of the estimator:-0.0232897
Variance of the data:0.00290086
In[]:=
Histogram[MM,100,"Probability",PlotLabel->"Histogram of Data",ChartLegends->{SwatchLegend[{"Measured Data"},LabelStyle->12]},Epilog->{Dashed,Blue,Line[{{truephi,0},{truephi,1}}]},AxesLabel->{"phi",None},PlotRange->{{1,2},All}]
Out[]=
In[]:=
Clear[ϕ];Clear[a];Clear[b];Clear[c];Clear[d];Clear[L];Clear[llog];Clear[MM];Clear[mean];Clear[variance];
Code 2
In[]:=
ClearSystemCache[];
Measurement Probabilities
Measurement Probabilities
In[]:=
P02[ϕ_]:=Cos[ϕ/2]^4;P11[ϕ_]:=Sin[ϕ]^2/2;P20[ϕ_]:=Sin[ϕ/2]^4;
In[]:=
L[ϕ_,m0_,m1_,m2_]:=**;llog[ϕ_]:=PowerExpand[Log[L[ϕ,m0,m1,m2]]]
4m0
Cos
ϕ
2
m1
Sin[ϕ]
2
4m2
Sin
ϕ
2
In[]:=
llog[ϕ]
Out[]=
-m1Log[2]+4m0LogCos+4m2LogSin+m1Log[Sin[ϕ]]
ϕ
2
ϕ
2
In[]:=
D[llog[ϕ],ϕ]
Out[]=
2m2Cot+m1Cot[ϕ]-2m0Tan
ϕ
2
ϕ
2
In[]:=
Solve[D[llog[ϕ],ϕ]==0,ϕ]
Out[]=
ϕ,ϕ
In[]:=
(*TestingRoots*)
In[]:=
f[ϕ_]:=2m2Cot[ϕ/2]+2m1Cot[ϕ]-2m0Tan[ϕ/2]
In[]:=
f[2ArcTan[Sqrt[m1+2m2]/Sqrt[2m0+m1]]]
Out[]=
2
2m0+m1
m2m1+2m2
2m0
m1+2m2
2m0+m1
m1+2m2
2m0+m1
In[]:=
FullSimplify[f[2ArcTan[Sqrt[m1+2m2]/Sqrt[2m0+m1]]]]
Out[]=
0
In[]:=
FullSimplify[f[2(ArcTan[Sqrt[m1+2m2]/Sqrt[2m0+m1]]+π)]]
Out[]=
0
In[]:=
(*Pointswherethederivativeofthelog-likelihoodshootstoinfinitycouldindicatesharppeaksinthelikelihoodfunction.Thesecouldbelocalorevenglobalmaxima.Ignoringthemrisksmissingthetruemaximumlikelihoodestimate.*)
In[]:=
ϕ=1.5;
In[]:=
truephi=ϕ;
In[]:=
f2[{m0_,m1_,m2_}]:=2ArcTan[Sqrt[m1+2m2]/Sqrt[2m0+m1]]
Roll of dice with random number generator for ν measurements generating tally of outcomes {m0, m1, m2}
Roll of dice with random number generator for ν measurements generating tally of outcomes {m0, m1, m2}
In[]:=
a=List[Re[P02[ϕ]],Re[P11[ϕ]],Re[P20[ϕ]]]
Out[]=
{0.28662,0.497498,0.215882}
In[]:=
Clear[b]
In[]:=
Clear[r]
In[]:=
(*Initializeanemptylist'c'tostoretheresults*)c={};Do[b=ConstantArray[0,3];Clear[r];updateTally[]:=Block[{r},r=RandomReal[];If[r<a[[1]],b[[1]]+=1,If[a[[1]]<=r<a[[1]]+a[[2]],b[[2]]+=1,b[[3]]+=1]]];Do[updateTally[],{300}];AppendTo[c,b],{i,1,10000}];
In[]:=
(*MeasurmentOutcomeTotals*)c;
In[]:=
MM=N[f2/@c];
Results Summary
Results Summary
In[]:=
mean=Mean[MM];(*Calculatethemeanofthedata*)variance=Variance[MM];(*Calculatethepopulationvariance*)Print["True value of phi:",truephi];Print["Mean of the MLE data:",mean];Print["Bias of the MLE:",mean-truephi];Print["Variance of the MLE data:",Variance[MM]];
True value of phi:1.5
Mean of the MLE data:1.50058
Bias of the MLE:0.000578424
Variance of the MLE data:0.00163246
In[]:=
Histogram[MM,100,"Probability",PlotLabel->"Histogram of Data",ChartLegends->{SwatchLegend[{"Measured Data"},LabelStyle->12]},Epilog->{Dashed,Blue,Line[{{truephi,0},{truephi,1}}]},AxesLabel->{"phi",None},PlotRange->{{1,2},Automatic}]
Out[]=
