Pensieve header: Alexander from Heisenberg.

SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\LearningSeminarOnCategorification-2006"]

(Subscript[𝔼, A1_->B1_])[ω1_,Q1_]≡(Subscript[𝔼, A2_->B2_])[ω2_,Q2_] := A1===A2∧B1===B2∧Simplify[ω1==ω2]∧Simplify[Q1==Q2]

(Subscript[𝔼, A1_->B1_])[ω1_,Q1_](Subscript[𝔼, A2_->B2_])[ω2_,Q2_]/;(A1⋂A2==={})∧(B1⋂B2==={})^:=(Subscript[𝔼, A1⋃A2->B1⋃B2])[ω1 ω2,Q1+Q2]

((Subscript[𝔼, A1_->B1_])[ω1_,Q1_]//(Subscript[𝔼, A2_->B2_])[ω2_,Q2_])/; ((SuperStar[B1])===A2):=Module[{i,j,E1,F1,G1,E2,F2,G2,I},
I=IdentityMatrix@Length@B1;
E1=Table[(∂_(i,j))Q1,{i,A1},{j,B1}]; E2=Table[(∂_(i,j))Q2,{i,A2},{j,B2}];
F1=Table[(∂_(i,j))Q1,{i,A1},{j,A1}]; F2=Table[(∂_(i,j))Q2,{i,A2},{j,A2}];
G1=Table[(∂_(i,j))Q1,{i,B1},{j,B1}]; G2=Table[(∂_(i,j))Q2,{i,B2},{j,B2}];
Expand/@(Subscript[𝔼, A1->B2])[PowerExpand@Simplify[ω1 ω2 ((Det[I-F2.G1])^(-1/2))],Plus[
If[A1==={}∨B2==={},0,A1.E1.Inverse[I-F2.G1].E2.B2],
If[A1==={},0,(1/2)A1.(F1+E1.F2.Inverse[I-G1.F2].(E1^\[Transpose])).A1],
If[B2==={},0,(1/2)B2.(G2+(E2^\[Transpose]).G1.Inverse[I-F2.G1].E2).B2]
]] ]

A_∖B_:=Complement[A,B]

((Subscript[𝔼, A1_->B1_])[ω1_,Q1_]//(Subscript[𝔼, A2_->B2_])[ω2_,Q2_])/; ((SuperStar[B1])=!=A2):=(Subscript[𝔼, A1⋃(A2∖(SuperStar[B1]))->B1⋃(SuperStar[A2])])[ω1,Q1+Sum[(SuperStar[ζ])ζ,{ζ,A2∖(SuperStar[B1])}]]//(Subscript[𝔼, (SuperStar[B1])⋃A2->B2⋃(B1∖(SuperStar[A2]))])[ω2,Q2+Sum[(SuperStar[z])z,{z,B1∖(SuperStar[A2])}]]

(*((Subscript[𝔼, A1_->B1_])[ω1_,Q1_]//(Subscript[𝔼, A2_->B2_])[ω2_,Q2_])/; ((SuperStar[B1])=!=A2):=Module[{L,R},
L=Echo@(Subscript[𝔼, A1⋃(A2∖(SuperStar[B1]))->B1⋃(SuperStar[A2])])[ω1,Q1+Sum[(SuperStar[ζ])ζ,{ζ,A2∖(SuperStar[B1])}]];
R=Echo@(Subscript[𝔼, (SuperStar[B1])⋃A2->B2⋃(B1∖(SuperStar[A2]))])[ω2,Q2+Sum[(SuperStar[z])z,{z,B1∖(SuperStar[A2])}]];
L//R]*)

Hz@i_:=Sequence[(Subscript[p, i]),(Subscript[x, i])]; Hζ@i_:=Sequence[(Subscript[π, i]),(Subscript[ξ, i])];
{(SuperStar[p]),(SuperStar[x])}={π,ξ}; {(SuperStar[π]),(SuperStar[ξ])}={p,x};
(SuperStar[((Subscript[u_, i_]))]):=(Subscript[((SuperStar[u])), i]); (SuperStar[l_List]):=(SuperStar[#])& /@ l;

Our PBW ordering is {p,x}.

We are at [p,x]=1 and R=(e^(t⊗px-tp⊗x)). Let a=p x. Then [a,x]=x.

Claim. (e^(t a-tp x))=(e^(t a))(e^((t^(-1))((e^(-t))-1) tp x)).
Proof. Use a 2d representation:

ρa=(({{1, 0}, {0, 0}})); ρx=(({{0, 1}, {0, 0}})); ρa.ρx-ρx.ρa==ρx

MatrixExp[t ρa-tp ρx]==MatrixExp[t ρa].MatrixExp[(t^(-1))((E^(-t))-1) tp ρx]

Claim. (e^(t p x))=𝕆[(e^((1-(e^(-t)))p x))].
Proof. True at t=0, test (∂_t) using p x 𝕆[f]=𝕆[p(x f-(∂_p)f)]:

Simplify[p (x (E^((1-(E^(-t)))p x)) -(∂_p)(E^((1-(E^(-t)))p x)))==(∂_t)(E^((1-(E^(-t)))p x))]

Claim. 𝕆[(e^(t a-tp x))] =(e^((1-(e^(-t)))p x+(t^(-1))((e^(-t))-1) tp x))

Collect[(1-(E^(-t)))p x + (t^(-1))((E^(-t))-1)tp x,{tp},Simplify]

(Subscript[R, i_,j_]):=(Subscript[𝔼, {}->{Hz@i,Hz@j}])[1,(1-(T^(-1)))(Subscript[p, j])(Subscript[x, j])+((T^(-1))-1)(Subscript[p, i])(Subscript[x, j])];
(Subscript[(OverBar[R]), i_,j_]):=(Subscript[𝔼, {}->{Hz@i,Hz@j}])[1,(1-T)(Subscript[p, j])(Subscript[x, j])+(T-1)(Subscript[p, i])(Subscript[x, j])];

(Subscript[R, 1,2])

(Subscript[hm, i_,j_->k_]):=(Subscript[𝔼, {Hζ@i,Hζ@j}->{Hz@k}])[1,-(Subscript[ξ, i])(Subscript[π, j])+((Subscript[π, i])+(Subscript[π, j]))(Subscript[p, k])+((Subscript[ξ, i])+(Subscript[ξ, j]))(Subscript[x, k])]

(Subscript[hm, 1,2->3])

(Subscript[hm, 1,2->1])//(Subscript[hm, 1,3->1])

((Subscript[hm, 2,3->2])//(Subscript[hm, 1,2->1]))≡((Subscript[hm, 1,2->1])//(Subscript[hm, 1,3->1]))

(Subscript[R, 1,2])(Subscript[R, 6,3])(Subscript[R, 4,5])

(Subscript[hm, 1,6->1])(Subscript[hm, 2,4->2])(Subscript[hm, 3,5->3])

(Subscript[R, 1,2])(Subscript[R, 6,3])(Subscript[R, 4,5])//(Subscript[hm, 1,6->1])(Subscript[hm, 2,4->2])(Subscript[hm, 3,5->3])

((Subscript[R, 1,2])(Subscript[R, 6,3])(Subscript[R, 4,5])//(Subscript[hm, 1,6->1])(Subscript[hm, 2,4->2])(Subscript[hm, 3,5->3]))≡((Subscript[R, 2,3])(Subscript[R, 1,4])(Subscript[R, 5,6])//(Subscript[hm, 1,5->1])(Subscript[hm, 2,6->2])(Subscript[hm, 3,4->3]))

(Subscript[(OverBar[R]), 1,2])(Subscript[R, 3,4])//(Subscript[hm, 1,3->1])(Subscript[hm, 2,4->2])

(Subscript[(OverBar[R]), 1,4])(Subscript[R, 3,2])//(Subscript[hm, 1,3->1])(Subscript[hm, 2,4->2])

γ1=(Subscript[𝔼, {}->{Hz[1],Hz[2],Hz[3]}])[1,{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}.(({{α, β, θ}, {γ, δ, ϵ}, {ϕ, ψ, Ξ}})).{(Subscript[p, 1]),(Subscript[p, 2]),(Subscript[p, 3])}]

Simplify/@(γ1//(Subscript[hm, 1,2->0]))

MatrixForm@Simplify[
Table[(∂_(i,j))(γ1//(Subscript[hm, 1,2->0]))[[2]],{j,{(Subscript[x, 0]),(Subscript[x, 3])}},{i,{(Subscript[p, 0]),(Subscript[p, 3])}}]
]

Simplify[Table[(∂_(i,j))(γ1//(Subscript[hm, 1,2->0]))[[2]],{j,{(Subscript[x, 0]),(Subscript[x, 3])}},{i,{(Subscript[p, 0]),(Subscript[p, 3])}}]==(({{1+γ-(((1-α)(1-δ))/(1+β)), ϵ+(((1-δ)θ)/(1+β))}, {ϕ+(((1-α)ψ)/(1+β)), Ξ-((θ ψ)/(1+β))}}))]

MatrixForm@Simplify[
IdentityMatrix[2]-Table[(∂_(i,j))(γ1//(Subscript[hm, 1,2->0]))[[2]],{j,{(Subscript[x, 0]),(Subscript[x, 3])}},{i,{(Subscript[p, 0]),(Subscript[p, 3])}}]/.Thread[{α,β,γ,δ,θ,ϵ,ϕ,ψ,Ξ}->{1-α,-β,-γ,1-δ,-θ,-ϵ,-ϕ,-ψ,1-Ξ}]
]

Expand[1+β-(1-α)(1-δ)]