Pensieve header: Integration with Γ-calculus.

Startup

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\SL2Portfolio2"];
<< KnotTheory`;
<<"../Profile/Profile.m";
<<"Engine-Speedy.m";
<<"Objects.m";
<<"KT.m";
BeginProfile[];
PopupWindow[Button["Show Profile Monitor"],Dynamic[PrintProfile[], UpdateInterval->3, TrackedSymbols->{}]]

$k=0; ℏ=γ=1;

s;h;t;Γ;dL;V;
Once[Begin["MetaCalculi`"]; << "../MetaCalculi/MetaCalculi.m";End[];]
ΓSimp=MetaCalculi`ΓSimp;
ΓR[i_,j_] := Γ[Xp[i,j]]; (OverBar[ΓR])[i_,j_] := Γ[Xm[i,j]];

?MetaCalculi`*

Utilities

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

Conversions

Γ[(Subscript[𝔼, {}->ss_])[LL_,QQ_,PP_]] := Module[{L,Q,P,σ,i,j},
{L,Q,P}=List@@((Subscript[𝔼, {}->ss])[LL,QQ,PP]//Composition@@((Subscript[dS, #])&/@ss));
ΓSimp[Γ[
(((Normal[P]/.ϵ->0))^(-1)),
σ=Sum[(Subscript[h, i])Product[(Subscript[T, j]^(Coefficient[L,ℏ (Subscript[a, i])(Subscript[b, j])])),{j,ss}],{i,ss}],
(σ/.(Subscript[h, i_]):>(Subscript[t, i])(Subscript[h, i]))+Sum[(Subscript[h, i])(Subscript[t, j])(1-(Subscript[T, j]))Coefficient[Q,ℏ (Subscript[x, i])(Subscript[y, j])],{i,ss},{j,ss}]
]/.B->T]
]

𝔼[Γ[ω_,σ_,λ_]] := Module[{ss,L,Q,P,i,j},
ss=dL@Γ[ω,σ,λ];
P=(ω^(-1))+O[ϵ];
L=Sum[ℏ (Subscript[a, i])(Subscript[b, j])Exponent[Coefficient[σ,(Subscript[h, i])],(Subscript[T, j])],{i,ss},{j,ss}];
Q=(λ-(σ/.(Subscript[h, i_]):>(Subscript[t, i])(Subscript[h, i])))/.{(Subscript[h, i_]):>(Subscript[x, i]), (Subscript[t, j_]):>(ℏ/(1-(Subscript[T, j])))(Subscript[y, j])};
((Subscript[𝔼, {}->ss])[L,Q,P]/.T->B)//Composition@@((Subscript[dS, #])&/@ss)
]

Testing

{ℰ=(Subscript[R, 1,2]),lhs=ℰ//Γ, rhs=ΓR[1,2], HL[lhs==rhs]}

\[Placeholder]

{ℰ=(Subscript[R, 1,5])(Subscript[(OverBar[R]), 4,2])(Subscript[(OverBar[R]), 6,3])//(Subscript[dm, 1,3->1])//(Subscript[dm, 1,4->1])//(Subscript[dm, 1,5->1])//(Subscript[dm, 2,6->2]),
lhs=ℰ//Γ,
rhs=ΓR[1,5](OverBar[ΓR])[4,2](OverBar[ΓR])[6,3]//dm[1,3,1]//dm[1,4,1]//dm[1,5,1]//dm[2,6,2],
HL@Simplify[lhs==rhs]}

From 2014-05/RibbonPropertyExample.nb:

{ℰ=(Subscript[(OverBar[R]), 11,1])(Subscript[(OverBar[R]), 5,12])(Subscript[R, 2,13])(Subscript[R, 14,6])(Subscript[R, 7,15])(Subscript[(OverBar[R]), 8,4])(Subscript[(OverBar[R]), 16,9])(Subscript[R, 3,10])//(Subscript[dm, 1,5->1])//(Subscript[dm, 2,6->2])//(Subscript[dm, 2,7->2])//(Subscript[dm, 2,8->2])//(Subscript[dm, 2,9->2])//(Subscript[dm, 2,10->2])//(Subscript[dm, 3,11->3])//(Subscript[dm, 3,12->3])//(Subscript[dm, 3,13->3])//(Subscript[dm, 3,14->3])//(Subscript[dm, 3,15->3])//(Subscript[dm, 4,16->4]),
lhs=ℰ//Γ,
rhs=Xm[11,1]Xm[5,12]Xp[2,13]Xp[14,6]Xp[7,15]Xm[8,4]Xm[16,9]Xp[3,10] // Γ // dm[1,5,1]//dm[2,6,2]//dm[2,7,2]//dm[2,8,2]//dm[2,9,2]//dm[2,10,2]//dm[3,11,3]//dm[3,12,3]//dm[3,13,3]//dm[3,14,3]//dm[3,15,3]//dm[4,16,4],
HL@Simplify[lhs==rhs]}//Column

HL[ℰ≡(ℰ//Γ//𝔼)]

Γ[V]

γ2=Γ[ω,(Subscript[σ, 1])(Subscript[h, 1])+(Subscript[σ, 2])(Subscript[h, 2]),{(Subscript[t, 1]),(Subscript[t, 2])}.(({{α, θ}, {ψ, Ξ}})).{(Subscript[h, 1]),(Subscript[h, 2])}]

γ2//MetaCalculi`tr[1]//𝔼

(Subscript[𝔼, {}->{1,2}])[(Subscript[l, 11])(Subscript[b, 1])(Subscript[a, 1])+(Subscript[l, 12])(Subscript[b, 1])(Subscript[a, 2])+(Subscript[l, 21])(Subscript[b, 2])(Subscript[a, 1])+(Subscript[l, 22])(Subscript[b, 2])(Subscript[a, 2]),(Subscript[q, 11])(Subscript[y, 1])(Subscript[x, 1])+(Subscript[q, 12])(Subscript[y, 1])(Subscript[x, 2])+(Subscript[q, 21])(Subscript[y, 2])(Subscript[x, 1])+(Subscript[q, 22])(Subscript[y, 2])(Subscript[x, 2]),(ω^(-1))]//Γ//Simplify

(Subscript[𝔼, {}->{1,2}])[(Subscript[l, 11])(Subscript[b, 1])(Subscript[a, 1])+(Subscript[l, 12])(Subscript[b, 1])(Subscript[a, 2])+(Subscript[l, 21])(Subscript[b, 2])(Subscript[a, 1])+(Subscript[l, 22])(Subscript[b, 2])(Subscript[a, 2]),(Subscript[q, 11])(Subscript[y, 1])(Subscript[x, 1])+(Subscript[q, 12])(Subscript[y, 1])(Subscript[x, 2])+(Subscript[q, 21])(Subscript[y, 2])(Subscript[x, 1])+(Subscript[q, 22])(Subscript[y, 2])(Subscript[x, 2]),(ω^(-1))]//Γ//MetaCalculi`tr[1]//𝔼//Simplify