Pensieve header: Direct formulas for the sl2 logoi.

Prolog

wdir=SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\SL2Portfolio"];
<< "SL2PortfolioProgram.m"

$p=2; $k=2; $U=QU;

HL[ℰ_] := Style[ℰ, Background -> Yellow];

t==ϵ a-γ b and b==-t/γ+ϵ a/γ.

(Subscript[t2b, i_->j_]):=𝔼[(Subscript[α, i])(Subscript[a, j])-(Subscript[τ, i])γ (Subscript[b, j]),(Subscript[ξ, i])(Subscript[x, j])+(Subscript[η, i])(Subscript[y, j]),(E^(ϵ (Subscript[τ, i])(Subscript[a, j])))+((O[ϵ])^($k+1))];
(Subscript[b2t, i_->j_]):=𝔼[(Subscript[α, i])(Subscript[a, j])-(Subscript[β, i])(Subscript[t, j])/γ,(Subscript[ξ, i])(Subscript[x, j])+(Subscript[η, i])(Subscript[y, j]),(E^(ϵ (Subscript[β, i])(Subscript[a, j])/γ))+((O[ϵ])^($k+1))];
(Subscript[t2b, i_]):=(Subscript[t2b, i->i]); (Subscript[b2t, i_]):=(Subscript[b2t, i->i]);

{(Subscript[t2b, 1]),(Subscript[b2t, 1])}

{(Subscript[t2b, 1->2]),(Subscript[b2t, 2->3])}

(Subscript[t2b, 1->2])~(Subscript[B, 2])~(Subscript[b2t, 2->3])

(Subscript[t2b, 1])~(Subscript[B, 1])~(Subscript[b2t, 1])

(Subscript[b2t, 1])~(Subscript[B, 1])~(Subscript[t2b, 1])

m

(Subscript[am, i_,j_->k_]):=𝔼[((Subscript[α, i])+(Subscript[α, j]))(Subscript[a, k]),((E^(-γ (Subscript[α, j])))(Subscript[ξ, i])+(Subscript[ξ, j]))(Subscript[x, k]),1];
(Subscript[bm, i_,j_->k_]):=𝔼[((Subscript[β, i])+(Subscript[β, j]))(Subscript[b, k]),((Subscript[η, i])+(Subscript[η, j]))(Subscript[y, k]),(E^(((E^(- ϵ (Subscript[β, i])))-1)(Subscript[η, j])(Subscript[y, k])))+((O[ϵ])^($k+1))];

Timing@Block[{$k=3},{(Subscript[am, i,j->k]),(Subscript[bm, i,j->k])}]

Comparisons with 2018-05/ybax.nb:

{HL[(Subscript[am, i,j->k])≡𝔼[((Subscript[α, i])+(Subscript[α, j]))(Subscript[a, k]),((E^(-(Subscript[α, j])))(Subscript[ξ, i])+(Subscript[ξ, j]))(Subscript[x, k]),1+((O[ϵ])^2)]/.l2U/.ℏ|γ->1], HL[(Subscript[bm, i,j->k])≡𝔼[((Subscript[β, i])+(Subscript[β, j]))(Subscript[b, k]),((Subscript[η, i])+(Subscript[η, j]))(Subscript[y, k]),1- ϵ  (Subscript[η, j])(Subscript[y, k])(Subscript[β, i])+((O[ϵ])^2)]]}

Comparisons with tm:

Timing@Block[{$k=3},
HL/@{𝔼[(Subscript[α, i])(Subscript[a, i])+(Subscript[α, j])(Subscript[a, j]),(Subscript[ξ, i])(Subscript[x, i])+(Subscript[ξ, j])(Subscript[x, j]),1]~(Subscript[B, i,j])~(Subscript[tm, i,j->k])≡((Subscript[am, i,j->k])/.l2U), (Subscript[bm, i,j->k])≡𝔼[(Subscript[β, i])(Subscript[b, i])+(Subscript[β, j])(Subscript[b, j]),(Subscript[η, i])(Subscript[y, i])+(Subscript[η, j])(Subscript[y, j]),1]~(Subscript[B, i,j])~((Subscript[b2t, i])(Subscript[b2t, j]))~(Subscript[B, i,j])~(Subscript[tm, i,j->k])~(Subscript[B, k])~(Subscript[t2b, k])}
]

Associativity on both sides

Timing@Block[{$k=3},
HL/@{((Subscript[am, 1,2->1])~(Subscript[B, 1])~(Subscript[am, 1,3->1]))≡((Subscript[am, 2,3->2])~(Subscript[B, 2])~(Subscript[am, 1,2->1])),((Subscript[bm, 1,2->1])~(Subscript[B, 1])~(Subscript[bm, 1,3->1]))≡((Subscript[bm, 2,3->2])~(Subscript[B, 2])~(Subscript[bm, 1,2->1]))}
]

R

(Subscript[E, q_,k_])[x_]:=Module[{j},E^((∑_(j=1)^(k+1)) (((((1-q))^j)(x^j))/(j(1-(q^j)))))]; (Subscript[E, q_])[x_]:=(Subscript[E, q,$k])[x]

Series[(Subscript[E, q,5])[x], {x,0,5}]

(E^(-x))Series[(Subscript[E, (E^ϵ),5])[x], {ϵ,0,5}]

(Subscript[tR, 1,2])

(Subscript[nR, i_,j_]):=𝔼[ℏ (Subscript[a, j]) (Subscript[b, i]),ℏ (Subscript[x, j]) (Subscript[y, i]),Series[(E^(-ℏ (Subscript[y, i])(Subscript[x, j])))(Subscript[E, (Subscript[q, ℏ])])[ℏ (Subscript[y, i])(Subscript[x, j])],{ϵ,0,$k}]];
(Subscript[nR, 1,2])

(Subscript[nR, 1,2])~(Subscript[B, 1])~(Subscript[b2t, 1])

HL[((Subscript[nR, 1,2])~(Subscript[B, 1])~(Subscript[b2t, 1]))≡(Subscript[tR, 1,2])]

P

(Subscript[nP, i_,j_,0]):=𝔼[(Subscript[β, i])(Subscript[α, j])/ℏ,(Subscript[η, i])(Subscript[ξ, j])/ℏ,1];
(Subscript[nP, i_,j_,k_]):=Module[{m,n},
MapAt[(#-(ϵ^k)Coefficient[((Subscript[nR, n,m])~(Subscript[B, n,m])~((Subscript[nP, n,j,0])(Subscript[nP, i,m,k-1])))[[3]],ϵ,k]+((O[ϵ])^($k+1)))&, (Subscript[nP, i,j,k-1]),3]
];
(Subscript[nP, i_,j_]):=(Subscript[nP, i,j,$k]);

(Subscript[nR, i,j])

Block[{$k=3},{(Subscript[nR, i,j]),(Subscript[nP, i,k]),HL[(Subscript[nR, i,j])~(Subscript[B, i])~(Subscript[nP, i,k])≡𝔼[(Subscript[a, j]) (Subscript[α, k]),(Subscript[x, j]) (Subscript[ξ, k]),1]]}]

aS

(Subscript[aS, i_]):=𝔼[(Subscript[α, i])(Subscript[a, i]),(Subscript[ξ, i])(Subscript[x, i]),1]~(Subscript[B, i])~(Subscript[tS, i]);
(Subscript[aS, i])

Comparison with 2018-05/ybax.nb:

HL[(Subscript[aS, i])≡𝔼[-(Subscript[α, i])(Subscript[a, i]),- (E^( (Subscript[α, i])))(Subscript[ξ, i])(Subscript[x, i]),1- ϵ (E^( (Subscript[α, i]))) (Subscript[ξ, i])(Subscript[x, i])((Subscript[a, i])+ (1/2) (E^( (Subscript[α, i])))(Subscript[ξ, i])(Subscript[x, i]))+((O[ϵ])^2)]/.l2U/.ℏ|γ->1]

𝔼[(Subscript[α, i])(Subscript[a, i]),0,1]~(Subscript[B, i])~(Subscript[aS, i])

𝔼[0,(Subscript[ξ, i])(Subscript[x, i]),1]~(Subscript[B, i])~(Subscript[aS, i])

HL[𝔼[0,(Subscript[ξ, i])(Subscript[x, i]),1]~(Subscript[B, i])~(Subscript[aS, i])≡𝔼[0,-(Subscript[ξ, i])(Subscript[x, i]),Series[
(E^((Subscript[ξ, i]) (Subscript[x, i])))Sum[Expand[((((-ℏ γ ϵ))^k)/((2^k)k!))Nest[Expand[(Subscript[x, i]^2)(∂_({(Subscript[x, i]),2}))#]&, (E^(-(Subscript[ξ, i]) (E^(ℏ ϵ (Subscript[a, i])))(Subscript[x, i]))),k]], {k,0,$k}],
{ϵ,0,$k}]]]

HL[(Subscript[aS, i])≡𝔼[-(Subscript[α, i])(Subscript[a, j]),-(Subscript[ξ, i])(Subscript[x, i]),Series[
(E^((Subscript[ξ, i]) (Subscript[x, i])))Sum[Expand[((((-ℏ γ ϵ))^k)/((2^k)k!))Nest[Expand[(Subscript[x, i]^2)(∂_({(Subscript[x, i]),2}))#]&, (E^(-(Subscript[ξ, i]) (E^(ℏ ϵ (Subscript[a, i])))(Subscript[x, i]))),k]], {k,0,$k}],
{ϵ,0,$k}]]~(Subscript[B, i,j])~(Subscript[am, i,j->i])]

bSi

(Subscript[bSi, i_]):=𝔼[(Subscript[β, i])(Subscript[b, i]),(Subscript[η, i])(Subscript[y, i]),1]~(Subscript[B, i])~(Subscript[b2t, i])~(Subscript[B, i])~(Subscript[tS, i])~(Subscript[B, i])~(Subscript[t2b, i]);
(Subscript[bSi, i])

Comparison with 2018-05/ybax.nb:

HL[(Subscript[bSi, i])≡𝔼[-(Subscript[β, i])(Subscript[b, i]),-(E^(Subscript[b, i]))(Subscript[η, i])(Subscript[y, i]),1-ϵ (E^( (Subscript[b, i]))) (Subscript[η, i])(Subscript[y, i])( (Subscript[β, i])-1+ (1/2)(E^(Subscript[b, i])) (Subscript[η, i])(Subscript[y, i]))+((O[ϵ])^2)]/.l2U/.ℏ|γ->1]

aΔ

Block[{i,j,k,l,m,n}, (Subscript[aΔ, i_->j_,k_])=((Subscript[nR, n,j])(Subscript[nR, m,k]))~(Subscript[B, n,m])~(Subscript[bm, n,m->l])~(Subscript[B, l])~(Subscript[nP, l,i])];
(Subscript[aΔ, i->j,k])

Comparison with 2018-05/ybax.nb:

HL[(Subscript[aΔ, i->j,k])≡𝔼[(Subscript[α, i])((Subscript[a, j])+(Subscript[a, k])),(Subscript[ξ, i])((Subscript[x, j])+(Subscript[x, k])),1+ϵ (Subscript[ξ, i])(Subscript[x, k])( -(Subscript[a, j])+(1/2) (Subscript[ξ, i]) (Subscript[x, j]))+((O[ϵ])^2)]/.l2U/.ℏ|γ->1]

Comparison with tΔ:

HL[(Subscript[aΔ, i->j,k])≡𝔼[(Subscript[α, i])(Subscript[a, i]),(Subscript[ξ, i])(Subscript[x, i]),1]~(Subscript[B, i])~(Subscript[tΔ, i->j,k])]

bΔ

Block[{i,j,k,l,m,n}, (Subscript[bΔ, i_->j_,k_])=((Subscript[nR, j,n])(Subscript[nR, k,m]))~(Subscript[B, n,m])~(Subscript[am, n,m->l])~(Subscript[B, l])~(Subscript[nP, i,l])];
(Subscript[bΔ, i->j,k])

Comparison with 2018-05/ybax.nb:

HL@Simplify[(Subscript[bΔ, i->j,k])≡𝔼[(Subscript[β, i])((Subscript[b, j])+(Subscript[b, k])),(Subscript[η, i])((E^(-(Subscript[b, k])))(Subscript[y, j])+(Subscript[y, k])),1+(1/2)ϵ ((Subscript[η, i])^2)(Subscript[y, j])(Subscript[y, k])(E^(-(Subscript[b, k])))+((O[ϵ])^2)]/.l2U/.ℏ|γ->1]

Comparison with tΔ:

HL[(Subscript[bΔ, i->k,j])≡(𝔼[(Subscript[β, i])(Subscript[b, i]),(Subscript[η, i])(Subscript[y, i]),1]~(Subscript[B, i])~(Subscript[b2t, i])~(Subscript[B, i])~(Subscript[tΔ, i->j,k])~(Subscript[B, j,k])~((Subscript[t2b, j])(Subscript[t2b, k])))]

Log Logoi

𝔼 /: Simplify[ℰ_𝔼] := Simplify/@(ℰ/.l2U)
Column@(Portfolio=Simplify/@{(Subscript[nR, i,j]),(Subscript[nP, i,j]),(Subscript[am, i,j->k]),(Subscript[bm, i,j->k]),(Subscript[aS, i]),(Subscript[bSi, i]),(Subscript[aΔ, i->j,k]),(Subscript[bΔ, i->j,k])})

𝔼 /: Log[𝔼[L_,Q_,P_]] := 𝔼L[L,Q/.l2U,Simplify@Log[P/.l2U]];
Column[Log /@ Portfolio]