In[]:=
SetOptions[EvaluationNotebook[],CreateCellID->True]
In[]:=
deploy
Fri 27 Aug 2021 17:52:40
background for https://stats.stackexchange.com/questions/539720/expected-ratio-of-xax-and-xaax-on-a-unit-sphere
In[]:=
setupProblem[nn_]:=Clear[x];​​n=nn;​​hs=Table
1
i
,{i,1,n};​​xs=Array[x,n];​​Z=
2
n/2
π
Gamma[n/2]
;(*Z=Integrate[1,xs∈R]*)​​;​​​​setupProblem[2];​​H==DiagonalMatrix[hs]//TraditionalForm​​
Out[]//TraditionalForm=
H
1
0
0
1
2

Ratio of Normals

In[]:=
normalRatio:=​​dist=MultinormalDistribution[IdentityMatrix[n]];​​TransformedDistribution
hs.
2
xs
2
hs
.
2
xs
,xsdist​​;​​Mean[normalRatio]​​
Out[]=
4
3

Ratio of Dirichlet

In[]:=
dirichletRatio:=​​dist=DirichletDistribution[ConstantArray[1/2,n+1]];​​TransformedDistribution
hs.xs
2
hs
.xs
,xsdist​​;​​Mean[dirichletRatio]
Out[]=
4
3

Surface Integral

In[]:=
R=ImplicitRegion@@{Total[
2
xs
]1,xs};​​Z=Integrate[1,xs∈R];​​Integrate
hs.
2
xs
2
hs
.
2
xs
Z,xs∈R​​
Out[]=
4
3

Numerical integration

In[]:=
estimateR[n_]:=​​setupProblem[n];​​dist=MultinormalDistribution[IdentityMatrix[n]];​​ratio=TransformedDistribution
hs.
2
xs
2
hs
.
2
xs
,xsdist;​​NExpectation[x,xratio]​​;​​Table[estimateR[n],{n,1,4}]
NIntegrate
:Numerical integration converging too slowly; suspect one of the following: singularity, value of the integration is 0, highly oscillatory integrand, or WorkingPrecision too small.
Out[]=
{1.,1.33333,1.57976,1.77491}

Dot product expansion

From hyperplane simplification: https://stats.stackexchange.com/questions/539720/expected-ratio-of-xax-and-xaax-on-a-unit-sphere/540580#540580
In[]:=
solveDot[nn_]:=​​setupProblem[nn];​​dist=MultinormalDistribution[DiagonalMatrix[
2
hs
]];​​distz=TransformedDistribution
2
xs
Total[
2
xs
]
,xsdist;​​z=NExpectation[xs,xsdistz];​​Total[z/hs]​​
In[]:=
Table[solveDot[i],{i,1,7}]
Out[]=
{1.,1.33333,1.57976,1.77491,1.93664,2.07492,2.19579}
In[]:=
getz[nn_]:=​​setupProblem[nn];​​dist=MultinormalDistribution[DiagonalMatrix[
2
hs
]];​​distz=TransformedDistribution
2
xs
Total[
2
xs
]
,xsdist;​​z=NExpectation[xs,xsdistz]​​;​​vals=getz[7];​​vals
Out[]=
{0.490807,0.209373,0.115147,0.0723392,0.0494284,0.0358013,0.02707}

Average Learning rate

Animation

In[]:=
exportAnim[fn_,images_,is_]:=Module[{},​​rasters=images;​​SetDirectory[NotebookDirectory[]];​​SetDirectory["export"];​​Export[fn,rasters,"AnimationRepetitions"Infinity]​​];​​​​cylinder[t_]:=With{x=Cos[t],y=Sin[t]},Graphics3D@Cylinder{x,y,0},x,y,
2
x
+1/2
2
y
2
x
+1/4
2
y
,1100;​​plot3da=Plot3D0,
2
x
+12
2
y
,
2
x
+14
2
y
,{x,-1,1},{y,-1,1},MeshFalse,RegionFunctionFunction[{x,y,z},x^2+y^2≤1],MeshFunctions{#3&},BoxedFalse,AxesNone,PlotStyleOpacity[0.5],PlotPoints50;​​plot3d[t_]:=Show[plot3da,cylinder[t]]​​blue=ColorData[97,"ColorList"][[1]];​​(*plot2da=Plot[Callout[
2
Cos[t]
+3
2
Sin[t]
,"
λ
1
",Above],Callout[
2
Cos[t]
+3
2
Sin[t]
,"
λ
2
",Below],Callout[2,"
λ
ave
",Above],{t,0,2Pi},PlotStyle{blue,blue,Dashed},AxesOrigin{0,0}];*)​​plot2da=Plot
2
Cos[t]
+
2
Sin[t]
2
2
Cos[t]
+
2
Sin[t]
4
,Callout
4
3
,"
4
3
",Above,{t,0,2Pi},AxesOrigin{0,0},PlotStyle{Automatic,Dashed},PlotRangePadding.75,Ticks{{Pi/2,Pi,3Pi/2,2Pi},{0,1,1.33,2}};​​point[t_]:=ListPlotWith{x=Cos[t],y=Sin[t]},t,
2
Cos[t]
+
2
Sin[t]
2
2
Cos[t]
+
2
Sin[t]
4
,PlotStylePointSize[Large],FillingAxis,FillingStyleDirective[Orange,Opacity[0.8]]​​plot2d[t_]:=Show[plot2da,point[t],ImageSize400];​​plotCombined[t_]:=GraphicsRow[{Show[plot3d[t],ImageSize600],Show[plot2d[t],ImageSize500]}]​​plotCombined[2]