<<Graphics`Graphics3D`
<<Graphics`Graphics`
Off[General::spell]

McKay distances

This uses the geometry of the McKay bivariate gamma.
    Parameters are a = (Subscript[α, 1]),  c = (Subscript[α, 2]), b = (Subscript[σ, 12]). 
    Distance function gives an upper bound on distance from 
    A,B,C  to a,b,c in information metric.

?ScatterPlot3D

dist[A_,a_,B_,b_,C_,c_]:=
Abs[(∫_A^a)(Sqrt[Abs[((-3x+C)/(4(x^2))) +PolyGamma[1, x]]])\[DifferentialD]x ]+ 
Abs[((Sqrt[Abs[A+C]])/2)Log[(b/B) ]] + 
Abs[(∫_C^c)((Sqrt[Abs[PolyGamma[1, y]] ]))\[DifferentialD]y]

FullSimplify[PowerExpand[dist[A,a,B,b,C,c]]]

McKay energy

Because we cannot obtain a closed form for McKay distances, we use McKay energy estimates of coordinate curve triangulations. This removes the square roots and gives a closed form upper bound (Subscript[E, M]) for information energy difference between points in M.

(Subscript[dist, M])((Subscript[T, 0]),(Subscript[T, 1]))=\[LeftBracketingBar](∫_A^a)(Sqrt[\[LeftBracketingBar]((C-3 x)/(4 (x^2)))+(ψ^((1)))(x)\[RightBracketingBar]])\[DifferentialD]x\[RightBracketingBar]+\[LeftBracketingBar](∫_B^b)(Sqrt[\[LeftBracketingBar]((A+C)/(4 (z^2)))\[RightBracketingBar]])\[DifferentialD]z\[RightBracketingBar]+\[LeftBracketingBar](∫_C^c)(Sqrt[\[LeftBracketingBar](ψ^((1)))(y)\[RightBracketingBar]])\[DifferentialD]y\[RightBracketingBar]

So the information energy is given by:

(Subscript[E, M])((Subscript[T, 0]),(Subscript[T, 1]))=\[LeftBracketingBar](∫_A^a)(((C-3 x)/(4 (x^2)))+(ψ^((1)))(x))\[DifferentialD]x\[RightBracketingBar]+\[LeftBracketingBar](∫_B^b)(((A+C)/(4 (z^2))))\[DifferentialD]z\[RightBracketingBar]+\[LeftBracketingBar](∫_C^c)(ψ^((1)))(y)\[DifferentialD]y\[RightBracketingBar]
≤\[LeftBracketingBar](∫_A^a)(((C-3 x)/(4 (x^2))))\[DifferentialD]x\[RightBracketingBar]+\[LeftBracketingBar](∫_A^a)(ψ^((1)))(x)\[DifferentialD]x\[RightBracketingBar]+\[LeftBracketingBar](∫_B^b)(((A+C)/(4 (z^2))))\[DifferentialD]z\[RightBracketingBar]+\[LeftBracketingBar](∫_C^c)(ψ^((1)))(y)\[DifferentialD]y\[RightBracketingBar]

FullSimplify[\[LeftBracketingBar](∫_A^a)((C-3 x)/(4 (x^2)))\[DifferentialD]x\[RightBracketingBar]+\[LeftBracketingBar](∫_B^b)((A+C)/(4 (z^2)))\[DifferentialD]z\[RightBracketingBar]+\[LeftBracketingBar](∫_A^a)(ψ^((1)))(x)\[DifferentialD]x\[RightBracketingBar]+\[LeftBracketingBar](∫_C^c)(ψ^((1)))(y)\[DifferentialD]y\[RightBracketingBar],{A>0,a>0,B>0,b>0,C>0,c>0}]

(Subscript[E, M])(A_,a_,B_,b_,C_,c_):=(1/4) (A+C) \[LeftBracketingBar](1/b)-(1/B)\[RightBracketingBar]+\[LeftBracketingBar]((C/(4 a))-(C/(4 A)))+(3/4) log((a/A))\[RightBracketingBar]+\[LeftBracketingBar](ψ^((0)))(a)-(ψ^((0)))(A)\[RightBracketingBar]+\[LeftBracketingBar](ψ^((0)))(c)-(ψ^((0)))(C)\[RightBracketingBar]

This uses the geometry of the McKay bivariate gamma.
    Parameters are a = (Subscript[α, 1]),  c = (Subscript[α, 2]), b = (Subscript[σ, 12]). 
    Distance function gives an upper bound on energy of geodesics from 
    A,B,C  to a,b,c in information metric.

(Subscript[E, M])(A_,a_,B_,b_,C_,c_):=(1/4) (A+C) \[LeftBracketingBar](1/b)-(1/B)\[RightBracketingBar]+((\[LeftBracketingBar]a C-A C+3 a A log((A/a))\[RightBracketingBar])/(4 a A))+\[LeftBracketingBar](ψ^((0)))(a)-(ψ^((0)))(A)\[RightBracketingBar]+\[LeftBracketingBar](ψ^((0)))(c)-(ψ^((0)))(C)\[RightBracketingBar]

FullSimplify[PowerExpand[(Subscript[E, M])(A,a,B,b,C,c)]]

Case (Subscript[T, 0]): (Subscript[α, 1])=1

TeXForm[(1/4) (A+C) \[LeftBracketingBar](1/b)-(1/B)\[RightBracketingBar]+((\[LeftBracketingBar]a C-A C+3 a A log((A/a))\[RightBracketingBar])/(4 a A))+\[LeftBracketingBar](ψ^((0)))(a)-(ψ^((0)))(A)\[RightBracketingBar]+\[LeftBracketingBar](ψ^((0)))(c)-(ψ^((0)))(C)\[RightBracketingBar]]

FullSimplify[PowerExpand[(Subscript[E, M])(1,(1/((cv(x))^2)),(((((2(ρ^2))/(1+(ρ^2)))))^2),((cv(x))^2)(((((2(ρ^2))/(1+(ρ^2)))))^2),((1/(ρ^2))-1),(1/((cv(x))^2))((1/(ρ^2))-1))]]

TeXForm[{(1/((cv(x))^2)),((cv(x))^2)(((((2(ρ^2))/(1+(ρ^2)))))^2),(1/((cv(x))^2))((1/(ρ^2))-1)}]

TeXForm[{1,(((((2(ρ^2))/(1+(ρ^2)))))^2),((1/(ρ^2))-1)}]

(Subscript[E, M])(1,(1/((cv(x))^2)),(((((2(ρ^2))/(1+(ρ^2)))))^2),((cv(x))^2)(((((2(ρ^2))/(1+(ρ^2)))))^2),((1/(ρ^2))-1),(1/((cv(x))^2))((1/(ρ^2))-1))

TeXForm[%]

Plot3D[√(((Abs[-((((1+(ρ^2)))^2)/(4 (ρ^4)))+((((1+(ρ^2)))^2)/(4 (ρ^4) (c^2)))])/(4 (ρ^2)))+Abs[EulerGamma+PolyGamma[0,(1/(c^2))]]+Abs[-PolyGamma[0,-1+(1/(ρ^2))]+PolyGamma[0,((-1+(1/(ρ^2)))/(c^2))]]+(1/4) Abs[1-(1/(ρ^2))+((-1+(1/(ρ^2)))/(c^2))+((3 Log[(c^2)])/(c^2)) (c^2)]),{c,0.6,2},{ρ,0.3,0.99}, Mesh->False,PlotRange->All,AxesLabel->{(Subscript[τ, x]),"ρ","(Subscript[dE, m])"},LabelStyle->Directive[Medium,Bold]]

TeXForm[((((1+(ρ^2)))^2)/(16 (ρ^6)))Abs[-1+(1/( cv(((x))^2)))]+Abs[EulerGamma+PolyGamma[0,(1/(cv(((x))^2)))]]+Abs[-PolyGamma[0,-1+(1/(ρ^2))]+PolyGamma[0,((-1+(1/(ρ^2)))/(cv(((x))^2)))]]+(1/4) Abs[(1-(1/(ρ^2)))(1-(1/(cv(((x))^2))))+3 Log[cv(((x))^2)] ]]

?EulerGamma

Case (Subscript[T, 0]): (Subscript[α, 1])+ (Subscript[α, 2])=1

(Subscript[E, M])((Subscript[α, 1]),(Subscript[α, 1]),((2/(1+(Subscript[α, 1])))),((4(Subscript[α, 1]))/(((2(Subscript[α, 1])+(Subscript[α, 2])))^2)),(1-(Subscript[α, 1])),(Subscript[α, 2]))

TeXForm[%]

Plot3D[√(Abs[-PolyGamma[0,1-(Subscript[α, 1])]+PolyGamma[0,(Subscript[α, 2])]]+(1/4) Abs[(1/2) (-1-(Subscript[α, 1]))+((((2 (Subscript[α, 1])+(Subscript[α, 2])))^2)/(4 (Subscript[α, 1])))]),{(Subscript[α, 1]),0.01,0.9},{(Subscript[α, 2]),0.12,1}, Mesh->False,AxesLabel->{(Subscript[α, 1]),(Subscript[α, 2]),"(Subscript[dE, m])"},LabelStyle->Directive[Medium,Bold]]

Plot3D[√(Abs[-PolyGamma[0,1-(Subscript[α, 1])]+PolyGamma[0,(Subscript[α, 2])]]+(1/4) Abs[(1/2) (-1-(Subscript[α, 1]))+((((2 (Subscript[α, 1])+(Subscript[α, 2])))^2)/(4 (Subscript[α, 1])))]),{(Subscript[α, 1]),0.01,.9},{(Subscript[α, 2]),0.12,1}]