Freund F2 Submanifold and Neighbourhood of Independent Exponentials

Submanifold(Subscript[F, 2]) ⊂ F : (Subscript[α, 1])=(Subscript[α, 3]) and  (Subscript[α, 2])=(Subscript[α, 4])

n=2;
(Subscript[f, 1])=(Subscript[α, 1])(Subscript[α, 2]) (E^(-(Subscript[α, 2])y-(2(Subscript[α, 1])-(Subscript[α, 2]))x    ));
(Subscript[f, 2])=(Subscript[α, 1])(Subscript[α, 2])(E^(-(Subscript[α, 2])x-(2(Subscript[α, 1])-(Subscript[α, 2]))y    ));

(Subscript[f, X])=FullSimplify[(∫_0^x)(Subscript[f, 2])\[DifferentialD]y+(∫_x^∞)(Subscript[f, 1])\[DifferentialD]y,{(Subscript[α, 1])>0,(Subscript[α, 2])>0,(Subscript[α, 3])>0,(Subscript[α, 4])>0}]

(Subscript[f, Y])=FullSimplify[(∫_0^y)(Subscript[f, 1])\[DifferentialD]x+(∫_y^∞)(Subscript[f, 2])\[DifferentialD]x,{(Subscript[α, 1])>0,(Subscript[α, 2])>0,(Subscript[α, 3])>0,(Subscript[α, 4])>0}]

Note that the marginal functions have the same parameters, that is why this family of pdf's forms an exponential family.

(Subscript[σ, 12])=FullSimplify[(∫_0^∞)(∫_x^∞)x y (Subscript[f, 1])\[DifferentialD]y\[DifferentialD]x+(∫_0^∞)(∫_0^x)x y (Subscript[f, 2])\[DifferentialD]y\[DifferentialD]x-Simplify[((∫_0^∞)x (Subscript[f, X])\[DifferentialD]x) (∫_0^∞)y (Subscript[f, Y])\[DifferentialD]y],{(Subscript[α, 1])>0,(Subscript[α, 2])>0,(Subscript[α, 3])>0,(Subscript[α, 4])>0}]

ρ=FullSimplify[(Subscript[σ, 12])/Simplify[(Sqrt[(∫_0^∞)(x^2) (Subscript[f, X])\[DifferentialD]x-((((∫_0^∞)x (Subscript[f, X])\[DifferentialD]x))^2)]) (Sqrt[(∫_0^∞)(y^2) (Subscript[f, Y])\[DifferentialD]y-((((∫_0^∞)y (Subscript[f, Y])\[DifferentialD]y))^2)]),{(Subscript[α, 1])>0,(Subscript[α, 2])>0,(Subscript[α, 3])>0,(Subscript[α, 4])>0}]]

Solve[1-((4 (Subscript[α, 1]^2))/(3 (Subscript[α, 1]^2)+(Subscript[α, 2]^2)))==0,{(Subscript[α, 1])}]

So when  (Subscript[α, 1])=(Subscript[α, 2]) we have the independent case.

This family forms an exponential family with natural parameters ( (Subscript[α, 1]),(Subscript[α, 2]))and potential function:

ψ=-log((Subscript[α, 1]))-log((Subscript[α, 2]));

α - geometry of this family :

g=Outer[FullSimplify[Simplify[(((∂^2)ψ)/(∂#1 ∂#2))],{(Subscript[λ, 1])>0,(Subscript[λ, 12])≥0}]&,{(Subscript[α, 1]),(Subscript[α, 2])},{(Subscript[α, 1]),(Subscript[α, 2])}]

T=Outer[FullSimplify[(((∂^3)ψ)/(∂#1 ∂#2 ∂#3)),{(Subscript[α, 1])>0,(Subscript[α, 2])>0}]&,{(Subscript[α, 1]),(Subscript[α, 2])},{(Subscript[α, 1]),(Subscript[α, 2])},{(Subscript[α, 1]),(Subscript[α, 2])}]

(Overscript[Γ, α])=Table[(1/2) (1-α) FullSimplify[T[[i,j,k]]],{i,n},{j,n},{k,n}]

Table[FullSimplify[Solve[{(Overscript[Γ, α])[[i,j,1]]==(∑_(h=1)^n)g[[1,h]] (Overscript[Γ, h])(i,j),(Overscript[Γ, α])[[i,j,2]]==(∑_(h=1)^n)g[[2,h]] (Overscript[Γ, h])(i,j)},{(Overscript[Γ, 1])(i,j),(Overscript[Γ, 2])(i,j)}]],{i,n},{j,n}]

(Overscript[Γ, 1])=(({{((α-1)/(Subscript[α, 1])), 0}, {0, 0}}));

(Overscript[Γ, 2])=(({{0, 0}, {0, ((α-1)/(Subscript[α, 2]))}}));

R=FullSimplify[Table[(1/4) (1-(α^2)) Simplify[(∑_(p=1)^n)(∑_(m=1)^n)(g^(-1))[[m,p]] (T[[k,m,i]] T[[j,l,p]]-T[[k,m,j]] T[[i,l,p]])],{i,n},{j,n},{k,n},{l,n}]]

The expectation coordiantes ((Subscript[η, i])), and the potential function ϕ:

η=Outer[FullSimplify[((∂ψ)/(∂#1)),{(Subscript[α, 1])>0,(Subscript[α, 2])>0}]&,{(Subscript[α, 1]),(Subscript[α, 2])}]

ϕ=FullSimplify[-ψ+η[[1]] (Subscript[α, 1])+η[[2]] (Subscript[α, 1])]

affine immersion :

We can define an affine immersion  from  (Subscript[F, 2]) to (R^3)   by a graph immerion:  f:(Subscript[F, 2])->  (R^3): ( (Subscript[α, 1]),(Subscript[α, 2]))-> ( (Subscript[α, 1]),(Subscript[α, 2]),ψ)

So   S   is the affine embedding of the manifold  (Subscript[F, 2]) as a surface in (R^3) : where  a= (Subscript[α, 1])  and  b=(Subscript[α, 2])

AffF2(a_,b_):={a,b,-log(a)-log(b)}

S=ParametricPlot3D[Evaluate[AffF2(a,b)],{a,0.00001,5.},{b,0.00001,5.},ViewPoint->{3,2,1},BoxRatios->{1,1,1},Mesh->False,PlotPoints->{30,30}]

The independence  case  ( b = a) is represented by this curve

AffF2independent(a_):={a,a,-2 log(a)}

M=ParametricPlot3D[Evaluate[AffF2independent(a)],{a,0.00001,5.6},ViewPoint->{3,2,1},BoxRatios->{1,1,1}]

So here we can  construct a neighbouhood  around  the curve M which reperesents the  independent case :

c[t_]:={t,t,-2 Log[t]}
tubecurve[c][r_][t_,theta_]:={t-((r Cos[theta])/((Sqrt[1+(1/(t^2))]) (Sqrt[(1/(t^4))]) (t^3))),t-((r Sin[theta])/((Sqrt[(1/(t^4))]) (t^2))),-((r Cos[theta])/((Sqrt[1+(1/(t^2))]) (Sqrt[(1/(t^4))]) (t^2)))-2 Log[t]}

R=ParametricPlot3D[tubecurve[
c][0.6][a,theta]
//Evaluate,
{a,0.000001,6},{theta,0,2Pi},
PlotPoints->{30,30},ViewPoint->{3,2,1}, BoxRatios->{1,1,1},PlotRange -> All]

Show[S,R]