SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\LearningSeminarOnCategorification-2006"];
<< "Engine-Speedy.m";
<< "Objects.m";
$k=0; ℏ=1;

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

ΓR[1,2]

(Subscript[R, i,j])

(Subscript[cm, i,j->k])

(Subscript[dm, i,j->k])

(Subscript[cR, i_,j_]):=(Subscript[𝔼, {}->{i,j}])[(Subscript[a, j]) (Subscript[b, i]),((1-(Subscript[B, i]))/(Subscript[b, i]))(Subscript[x, j]) (Subscript[y, i]),1]

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

(Subscript[(OverBar[cR]), i_,j_]):=(Subscript[𝔼, {}->{i,j}])[-(Subscript[a, j]) (Subscript[b, i]),(((Subscript[B, i])-1)/((Subscript[b, i])(Subscript[B, i])))(Subscript[x, j]) (Subscript[y, i]),1]

(Subscript[cR, 1,3])(Subscript[(OverBar[cR]), 2,4])//(Subscript[cm, 1,2->1])//(Subscript[cm, 3,4->3])

(Subscript[𝔾, sp1_])[ω_,L_,Q_]//𝔼:=(Subscript[𝔼, {}->sp1])[L,Q,ω+O[ϵ]];
(Subscript[𝔾, sp1_])[ω_,L_,Q_] // (Subscript[𝔼, sp2_])[L2_,Q2_,P2_] := (Subscript[𝔾, sp1])[ω,L,Q]//𝔼//(Subscript[𝔼, sp2])[L2,Q2,P2]

G1=Expand/@(Subscript[𝔾, {1,2,3}])[ω,{(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3])}.(({{(Subscript[l, 11]), (Subscript[l, 12]), (Subscript[l, 13])}, {(Subscript[l, 21]), (Subscript[l, 22]), (Subscript[l, 23])}, {(Subscript[l, 31]), (Subscript[l, 32]), (Subscript[l, 33])}})).{(Subscript[a, 1]),(Subscript[a, 2]),(Subscript[a, 3])},{(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3])}.(({{α, β, θ}, {γ, δ, ϵ}, {ϕ, ψ, Ξ}})).{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}]

G1//𝔼

G1//(Subscript[cm, 1,2->0])//Simplify

(Subscript[𝔼, {}->r_])[L_,Q_,P_]//𝔾:=(Subscript[𝔾, r])[Normal@P,L,Q]

G1//(Subscript[cm, 1,2->0])//𝔾

(Subscript[𝔾, S_])[ω_,L_,Q_]//𝔾Form := Module[{M,i,j},
M = Table[Simplify[(∂_((Subscript[x, i]),(Subscript[y, j])))Q],{i,S},{j,S}];
PrependTo[M, (Subscript[y, #])&/@S];
M = Join[
{Prepend[(Subscript[x, #])&/@S, ω]},
Transpose[M],
{Prepend[Table[(∂_(Subscript[a, i]))L,{i,S}], "𝔾"]}
];
MatrixForm[M]
];

(Subscript[𝔾, S1_])[ω1_,L1_,Q1_]≡(Subscript[𝔾, S2_])[ω2_,L2_,Q2_]:=(Sort[S1]===Sort[S2])∧Simplify[ω1==ω2]∧Simplify[L1==L2]∧Simplify[Q1==Q2]

G1//𝔾Form

G1//(Subscript[cm, 1,2->0])//𝔾//𝔾Form

(G2=(Subscript[𝔾, {0,3}])[(ω/(1-γ (Subscript[b, 0]))),{(Subscript[b, 0]),(Subscript[b, 3])}.(({{(Subscript[l, 11])+(Subscript[l, 12])+(Subscript[l, 21])+(Subscript[l, 22]), (Subscript[l, 13])+(Subscript[l, 23])}, {(Subscript[l, 31])+(Subscript[l, 32]), (Subscript[l, 33])}})).{(Subscript[a, 0]),(Subscript[a, 3])},{(Subscript[y, 0]),(Subscript[y, 3])}.(({{((β+(α δ-γ β) (Subscript[b, 0])+δ (Subscript[B, 0]^((Subscript[l, 11])+(Subscript[l, 21]))) (Subscript[B, 3]^(Subscript[l, 31]))+α (Subscript[B, 0]^((Subscript[l, 12])+(Subscript[l, 22]))) (Subscript[B, 3]^(Subscript[l, 32]))+γ (Subscript[B, 0]^((Subscript[l, 11])+(Subscript[l, 12])+(Subscript[l, 21])+(Subscript[l, 22]))) (Subscript[B, 3]^((Subscript[l, 31])+(Subscript[l, 32]))))/(1-γ (Subscript[b, 0]))), ((θ+(α ϵ-γ θ) (Subscript[b, 0])+ϵ (Subscript[B, 0]^((Subscript[l, 11])+(Subscript[l, 21]))) (Subscript[B, 3]^(Subscript[l, 31])))/(1-γ (Subscript[b, 0])))}, {((ψ+(δ ϕ-γ ψ) (Subscript[b, 0])+ϕ (Subscript[B, 0]^((Subscript[l, 12])+(Subscript[l, 22]))) (Subscript[B, 3]^(Subscript[l, 32])))/(1-γ (Subscript[b, 0]))), ((Ξ+(ϵ ϕ-γ Ξ) (Subscript[b, 0]))/(1-γ (Subscript[b, 0])))}})).{(Subscript[x, 0]),(Subscript[x, 3])}])//𝔾Form
(G1//(Subscript[cm, 1,2->0])//𝔾)≡G2

G1//(Subscript[dm, 1,2->0])//𝔾//𝔾Form

(G3=(Subscript[𝔾, {0,3}])[(ω/(1+γ((Subscript[B, 0])-1))),{(Subscript[b, 0]),(Subscript[b, 3])}.(({{(Subscript[l, 11])+(Subscript[l, 12])+(Subscript[l, 21])+(Subscript[l, 22]), (Subscript[l, 13])+(Subscript[l, 23])}, {(Subscript[l, 31])+(Subscript[l, 32]), (Subscript[l, 33])}})).{(Subscript[a, 0]),(Subscript[a, 3])},{(Subscript[y, 0]),(Subscript[y, 3])}.(({{((β-γ β+α δ+(γ β-α δ) (Subscript[B, 0])+δ (Subscript[B, 0]^((Subscript[l, 11])+(Subscript[l, 21]))) (Subscript[B, 3]^(Subscript[l, 31]))+α (Subscript[B, 0]^((Subscript[l, 12])+(Subscript[l, 22]))) (Subscript[B, 3]^(Subscript[l, 32]))+γ (Subscript[B, 0]^((Subscript[l, 11])+(Subscript[l, 12])+(Subscript[l, 21])+(Subscript[l, 22]))) (Subscript[B, 3]^((Subscript[l, 31])+(Subscript[l, 32]))))/(1+γ((Subscript[B, 0])-1))), ((α ϵ+θ-γ θ+(-α ϵ+γ θ) (Subscript[B, 0])+ϵ (Subscript[B, 0]^((Subscript[l, 11])+(Subscript[l, 21]))) (Subscript[B, 3]^(Subscript[l, 31])))/(1+γ((Subscript[B, 0])-1)))}, {((δ ϕ+ψ-γ ψ+(-δ ϕ+γ ψ) (Subscript[B, 0])+ϕ (Subscript[B, 0]^((Subscript[l, 12])+(Subscript[l, 22]))) (Subscript[B, 3]^(Subscript[l, 32])))/(1+γ((Subscript[B, 0])-1))), ((Ξ-γ Ξ+ϵ ϕ+(γ Ξ-ϵ ϕ) (Subscript[B, 0]))/(1+γ((Subscript[B, 0])-1)))}})).{(Subscript[x, 0]),(Subscript[x, 3])}])//𝔾Form
(G1//(Subscript[dm, 1,2->0])//𝔾)≡G3

(Subscript[R, 1,2])//𝔾//𝔾Form

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

((Subscript[R, 1,4])(Subscript[(OverBar[R]), 6,2])(Subscript[(OverBar[R]), 3,5]))//(Subscript[dm, 1,2->1])//(Subscript[dm, 1,3->1])//(Subscript[dm, 1,4->1])//(Subscript[dm, 5,6->2])//Simplify//𝔾//𝔾Form

((Subscript[cR, 1,4])(Subscript[(OverBar[cR]), 6,2])(Subscript[(OverBar[cR]), 3,5]))//(Subscript[cm, 1,2->1])//(Subscript[cm, 1,3->1])//(Subscript[cm, 1,4->1])//(Subscript[cm, 5,6->2])//Simplify//𝔾//𝔾Form

(ΓR[1,4](OverBar[ΓR])[6,2](OverBar[ΓR])[3,5])//dm[1,2,1]//dm[1,3,1]//dm[1,4,1]//dm[5,6,2]

γ1=Expand/@(Subscript[Γ1, {1,2,3}])[ω,{(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3])}.(({{(Subscript[l, 11]), (Subscript[l, 12]), (Subscript[l, 13])}, {(Subscript[l, 21]), (Subscript[l, 22]), (Subscript[l, 23])}, {(Subscript[l, 31]), (Subscript[l, 32]), (Subscript[l, 33])}})).{(Subscript[a, 1]),(Subscript[a, 2]),(Subscript[a, 3])},{(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3])}.(({{α, β, θ}, {γ, δ, ϵ}, {ϕ, ψ, Ξ}})).{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}]

(Subscript[Γ1, sp1_])[ω_,L_,Q_]//𝔼:=(Subscript[𝔼, {}->sp1])[L,Q,ω+O[ϵ]];
(Subscript[Γ1, sp1_])[ω_,L_,Q_] // (Subscript[𝔼, sp2_])[L2_,Q2_,P2_] := (Subscript[Γ1, sp1])[ω,L,Q]//𝔼//(Subscript[𝔼, sp2])[L2,Q2,P2]

(Subscript[𝔼, {}->r_])[L_,Q_,P_]//Γ1:=(Subscript[Γ1, r])[Normal@P,L,Q]

(Subscript[Γ1, S_])[ω_,L_,Q_]//Γ1Form := Module[{M,i,j},
M = Table[Simplify[(∂_((Subscript[x, i]),(Subscript[y, j])))Q],{i,S},{j,S}];
PrependTo[M, (Subscript[y, #])&/@S];
M = Join[
{Prepend[(Subscript[x, #])&/@S, ω]},
Transpose[M],
{Prepend[Table[(∂_(Subscript[a, i]))L,{i,S}], "Γ1"]}
];
MatrixForm[M]
];

(Subscript[Γ1, S1_])[ω1_,L1_,Q1_]≡(Subscript[Γ1, S2_])[ω2_,L2_,Q2_]:=(Sort[S1]===Sort[S2])∧Simplify[ω1==ω2]∧Simplify[L1==L2]∧Simplify[Q1==Q2]

γ1≡(γ1//𝔼//Γ1)

γ1//(Subscript[cm, 1,2->0])//Γ1//Γ1Form

γ2=Expand/@(Subscript[Γ2, {1,2,3}])[ω,{(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3])}.(({{(Subscript[l, 11]), (Subscript[l, 12]), (Subscript[l, 13])}, {(Subscript[l, 21]), (Subscript[l, 22]), (Subscript[l, 23])}, {(Subscript[l, 31]), (Subscript[l, 32]), (Subscript[l, 33])}})).{(Subscript[a, 1]),(Subscript[a, 2]),(Subscript[a, 3])},{(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3])}.(({{α, β, θ}, {γ, δ, ϵ}, {ϕ, ψ, Ξ}})).{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}]

(Subscript[Γ2, sp1_])[ω_,L_,Q_]//𝔼:=(Subscript[𝔼, {}->sp1])[L,Q/.(Subscript[y, i_]):>(Subscript[y, i])/(Subscript[b, i]),ω+O[ϵ]];

(Subscript[𝔼, {}->r_])[L_,Q_,P_]//Γ2:=(Subscript[Γ2, r])[Normal@P,L,Q/.(Subscript[y, i_]):>(Subscript[y, i])(Subscript[b, i])]

(Subscript[Γ2, S1_])[ω1_,L1_,Q1_]≡(Subscript[Γ2, S2_])[ω2_,L2_,Q2_]:=(Sort[S1]===Sort[S2])∧Simplify[ω1==ω2]∧Simplify[L1==L2]∧Simplify[Q1==Q2]

γ2≡(γ2//𝔼//Γ2)

(Subscript[Γ2, S_])[ω_,L_,Q_]//Γ2Form := Module[{M,i,j},
M = Table[Simplify[(∂_((Subscript[x, i]),(Subscript[y, j])))Q],{i,S},{j,S}];
PrependTo[M, (Subscript[y, #])&/@S];
M = Join[
{Prepend[(Subscript[x, #])&/@S, ω]},
Transpose[M],
{Prepend[Table[(∂_(Subscript[a, i]))L,{i,S}], "Γ2"]}
];
MatrixForm[M]
];

γ2//𝔼//(Subscript[cm, 1,2->0])//Γ2//Γ2Form

((Subscript[cR, 1,4])(Subscript[(OverBar[cR]), 6,2])(Subscript[(OverBar[cR]), 3,5]))//(Subscript[cm, 1,2->1])//(Subscript[cm, 1,3->1])//(Subscript[cm, 1,4->1])//(Subscript[cm, 5,6->2])//Γ2//Γ2Form

{(Subscript[cR, 1,2])//Γ2//Γ2Form, ΓR[1,2]}

γ3=Expand/@(Subscript[Γ3, {1,2,3}])[ω,{(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3])}.(({{(Subscript[l, 11]), (Subscript[l, 12]), (Subscript[l, 13])}, {(Subscript[l, 21]), (Subscript[l, 22]), (Subscript[l, 23])}, {(Subscript[l, 31]), (Subscript[l, 32]), (Subscript[l, 33])}})).{(Subscript[a, 1]),(Subscript[a, 2]),(Subscript[a, 3])},{(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3])}.(({{α, β, θ}, {γ, δ, ϵ}, {ϕ, ψ, Ξ}})).{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}]

With[{sp={1,2,3,4},L=(Subscript[a, 1]) (Subscript[b, 1]) (Subscript[l, 11])+(Subscript[a, 2]) (Subscript[b, 1]) (Subscript[l, 12])+(Subscript[a, 3]) (Subscript[b, 1]) (Subscript[l, 13])+(Subscript[a, 1]) (Subscript[b, 2]) (Subscript[l, 21])+(Subscript[a, 2]) (Subscript[b, 2]) (Subscript[l, 22])+(Subscript[a, 3]) (Subscript[b, 2]) (Subscript[l, 23])+(Subscript[a, 1]) (Subscript[b, 3]) (Subscript[l, 31])+(Subscript[a, 2]) (Subscript[b, 3]) (Subscript[l, 32])+(Subscript[a, 3]) (Subscript[b, 3]) (Subscript[l, 33])},
Sum[((E^(-(∂_(Subscript[a, i]))L))//.l2U)(Subscript[y, i])(Subscript[x, i]),{i,sp}]
]

(Subscript[Γ3, sp_])[ω_,L_,Q_]//𝔼:=(Subscript[𝔼, {}->sp])[L,(Q/.(Subscript[y, i_]):>(Subscript[y, i])/(Subscript[b, i]))-Sum[((E^(-(∂_(Subscript[a, i]))L))//.l2U)(Subscript[y, i])(Subscript[x, i])/(Subscript[b, i]),{i,sp}],ω+O[ϵ]];

(Subscript[𝔼, {}->r_])[L_,Q_,P_]//Γ3:=(Subscript[Γ3, r])[Normal@P,L,(Q/.(Subscript[y, i_]):>(Subscript[y, i])(Subscript[b, i]))+Sum[((E^(-(∂_(Subscript[a, i]))L))//.l2U)(Subscript[y, i])(Subscript[x, i]),{i,r}]]

(Subscript[Γ3, S_])[ω_,L_,Q_]//Γ3Form := Module[{M,i,j},
M = Table[Simplify[(∂_((Subscript[x, i]),(Subscript[y, j])))Q],{i,S},{j,S}];
PrependTo[M, (Subscript[y, #])&/@S];
M = Join[
{Prepend[(Subscript[x, #])&/@S, ω]},
Transpose[M],
{Prepend[Table[(∂_(Subscript[a, i]))L,{i,S}], "Γ3"]}
];
MatrixForm[M]
];

(Subscript[cR, 1,2])//Γ3//Γ3Form

(Subscript[Γ3, S1_])[ω1_,L1_,Q1_]≡(Subscript[Γ3, S2_])[ω2_,L2_,Q2_]:=(Sort[S1]===Sort[S2])∧Simplify[ω1==ω2]∧Simplify[L1==L2]∧Simplify[Q1==Q2]

γ3≡(γ3//𝔼//Γ3)

γ3//𝔼//(Subscript[cm, 1,2->0])//Γ3//Γ3Form

γ3//𝔼//(Subscript[cm, 2,1->0])//Γ3//Γ3Form

(Subscript[Γ4, S_])[ω_,L_,Q_]//Γ4Form := Module[{M,i,j,SS=Sort[S]},
M = Table[Simplify[(∂_((Subscript[y, i]),(Subscript[x, j])))Q],{i,SS},{j,SS}];
PrependTo[M, (Subscript[x, #])&/@SS];
M = Join[
{Prepend[(Subscript[y, #])&/@SS, ω]},
Transpose[M],
{Prepend[Table[(∂_(Subscript[a, i]))L,{i,SS}], "Γ4"]}
];
MatrixForm[M]
];

γ4=Expand/@(Subscript[Γ4, {1,2,3}])[ω,{(Subscript[b, 1]),(Subscript[b, 2]),(Subscript[b, 3])}.(({{(Subscript[l, 11]), (Subscript[l, 12]), (Subscript[l, 13])}, {(Subscript[l, 21]), (Subscript[l, 22]), (Subscript[l, 23])}, {(Subscript[l, 31]), (Subscript[l, 32]), (Subscript[l, 33])}})).{(Subscript[a, 1]),(Subscript[a, 2]),(Subscript[a, 3])},{(Subscript[x, 1]),(Subscript[x, 2]),(Subscript[x, 3])}.(({{α, β, θ}, {γ, δ, ϵ}, {ϕ, ψ, Ξ}})).{(Subscript[y, 1]),(Subscript[y, 2]),(Subscript[y, 3])}]

γ4//Γ4Form

(Subscript[Γ4, sp_])[ω_,L_,Q_]//𝔼:=(Subscript[𝔼, {}->sp])[L,(Q/.(Subscript[y, i_]):>(Subscript[y, i])/(Subscript[b, i]))-Sum[((E^(-(∂_(Subscript[a, i]))L))//.l2U)(Subscript[y, i])(Subscript[x, i])/(Subscript[b, i]),{i,sp}],(ω^(-1))+O[ϵ]];

(Subscript[𝔼, {}->r_])[L_,Q_,P_]//Γ4:=(Subscript[Γ4, r])[(((Normal@P))^(-1)),L,(Q/.(Subscript[y, i_]):>(Subscript[y, i])(Subscript[b, i]))+Sum[((E^(-(∂_(Subscript[a, i]))L))//.l2U)(Subscript[y, i])(Subscript[x, i]),{i,r}]]

{(Subscript[cR, 1,2])//Γ4//Γ4Form,(Subscript[(OverBar[cR]), 1,2])//Γ4//Γ4Form}

{(Subscript[cR, 2,1])//Γ4//Γ4Form,(Subscript[(OverBar[cR]), 2,1])//Γ4//Γ4Form}

(Subscript[Γ4, S1_])[ω1_,L1_,Q1_]≡(Subscript[Γ4, S2_])[ω2_,L2_,Q2_]:=(Sort[S1]===Sort[S2])∧Simplify[ω1==ω2]∧Simplify[L1==L2]∧Simplify[Q1==Q2]

γ4≡(γ4//𝔼//Γ4)

γ4//𝔼//(Subscript[cm, 1,2->0])//Γ4//Γ4Form