Pensieve header: A poly-time program to compute the ${\mathfrak g}_0$ invariant.

Reminders

1. Make sure that you have Mathematica and that you play with these programs!
2. Change meeting time?

Representing (Subscript[𝔤, 0])=⟨h,e,l,f⟩/([e,l]=-e, [f,l]=f, [e,f]=h, [h,*]=0)

ρh=(({{0, 0, -1}, {0, 0, 0}, {0, 0, 0}}));ρe=(({{0, 0, 0}, {0, 0, 1}, {0, 0, 0}})); ρl=(({{0, 0, 0}, {0, 1, 0}, {0, 0, 0}})); ρf=(({{0, 1, 0}, {0, 0, 0}, {0, 0, 0}})); ρ0=(({{0, 0, 0}, {0, 0, 0}, {0, 0, 0}}));
B[x_?MatrixQ, y_?MatrixQ] := x.y-y.x;

{B[ρe,ρl]==-ρe, B[ρf,ρl]==ρf, B[ρe,ρf]==ρh, B[ρh,ρe]==ρ0, B[ρh,ρl]==ρ0, B[ρh,ρf]==ρ0}

Implementing (Subscript[𝔤, 0])

PBWRule={e->1,l->2,f->3};
B[U@e,U@l]=-U@e; B[U@f,U@l]=U@f; B[U@e,U@f]=h U[];

$TD=3; ℏ /: (ℏ^(d_. ))/;d>$TD :=0;

x_⪯y_:=OrderedQ[{x,y}/.PBWRule]; x_≺y_:=!OrderedQ[{y,x}/.PBWRule];
Simp[ℰ_]:= Collect[ℰ, _U, Expand];

(Subscript[U, i_])[ℰ_] := ℰ /. {h->(Subscript[h, i]),t->(Subscript[t, i]), u_U :> Replace[u, x_ :> (Subscript[x, i]),1]};
B[U[(Subscript[(x_), i_])],U[(Subscript[(y_), i_])]]:=B[U[(Subscript[x, i])],U[(Subscript[y, i])]]=(Subscript[U, i])[B[U@x,U@y]];
B[U[(Subscript[(x_), i_])],U[(Subscript[(y_), j_])]] /; i=!=j := 0;
B[x_,x_]=0;
B[U[y_],U[x_]]:=B[U[y],U[x]]=Simp[-B[U[x],U[y]]];
B[x_,y_] := x**y-y**x;

Unprotect[NonCommutativeMultiply];
NonCommutativeMultiply[x_] := x;
0**_=_**0=0;
x_**U[]:=x; U[]**x_:=x;
(a_*x_U)**(b_*y_U) := If[a b === 0, 0, Simp[a b (x**y)]];
(a_*x_U)**y_ := Simp[a(x**y)]; x_**(a_*y_U) := Simp[a(x**y)];
(x_Plus)**y_ := (#**y)& /@ x; x_**(y_Plus) := (x**#)& /@ y;

U[xx___,x_] ** U[y_,yy___] := If[x⪯y,U[xx,x,y,yy], U@xx**(U@y**U@x+B[U@x,U@y])**U@yy];

UU[l___,((x_)^(n_)),r___]:= UU[l,Sequence@@Table[x,{n}],r];
UU[l___,1,r___]:= UU[l,r];
UU[]=U[];
UU[l_,r___]:=U[l]**UU[r];

UProducts[{},0]={UU[]};
UProducts[{},n_Integer] /; n>0 = {};
UProducts[{x_,xs___}, n_Integer] := Sort@Flatten@Table[UU[(x^k)]**u, {k,0,n},{u,UProducts[{xs},n-k]}];
UProducts[xs_List, k_Integer, n_Integer] := UProducts[Flatten@Table[(Subscript[x, j]), {x,xs}, {j,k}], n];
UProducts[any__, {n_}] := Flatten@Table[UProducts[any,k], {k,0,n}];

(Subscript[r, i_,j_]):=Simp[ℏ ((Subscript[h, i])UU[(Subscript[l, j])]+ UU[(Subscript[e, i]),(Subscript[f, j])])]

UExp[u_]:=Module[{s,t,k},
s=t=U[]; k=0;
While[k<20∧0=!=(t=t**u), s+=t/(++k)!];
Simp[s]];
(Subscript[R, i_,j_]):=UExp[(Subscript[r, i,j])];

m[i_,j_,k_][ℰ_] := Simp[ℰ /. {
u_U :> UU@@Join[DeleteCases[u,(Subscript[x_, i|j])],U@@Cases[u,(Subscript[x_, i]):>(Subscript[x, k])],U@@Cases[u,(Subscript[x_, j]):>(Subscript[x, k])]],
(Subscript[h, i|j])->(Subscript[h, k])}]

Ordering Symbols; The Invariant of the Trefoil

Theorem. R=(e^(h⊗l+e⊗f))=𝕆(exp(hl+(((e^h)-1)/h)ef|e⊗lf).
Gentle Proof, Presented Brutely.

MatrixForm /@ {MatrixExp[h ρl+e ρf], MatrixExp[h ρl].MatrixExp[(((E^h)-1)/h)e ρf]}

𝕆[poly_, specs___] := Module[{vs,us,z},
vs=Join@@(First /@ {specs});
us=Join@@({specs} /. (l_->s_) :> (l/.(Subscript[x_, i_]):>(Subscript[x, s])));
Simp@Total[CoefficientRules[Normal@Series[poly, {ℏ,0,$TD}], vs] /. (p_->c_) :> c UU@@((us^p))]
]

Debt. How does this work?

Timing[$TD=3; T1$1=𝕆[Exp[ℏ h (Subscript[l, 1])+(((E^(ℏ h))-1)/h)(Subscript[e, 4])(Subscript[f, 1])+ℏ h (Subscript[l, 5])+(((E^(ℏ h))-1)/h)(Subscript[e, 2])(Subscript[f, 5])+ℏ h (Subscript[l, 3])+(((E^(ℏ h))-1)/h)(Subscript[e, 6])(Subscript[f, 3])], {(Subscript[l, 1]),(Subscript[f, 1]),(Subscript[e, 2]),(Subscript[l, 3]),(Subscript[f, 3]),(Subscript[e, 4]),(Subscript[l, 5]),(Subscript[f, 5]),(Subscript[e, 6])}->1] /. (Subscript[h, 1])->h]

The Big (Subscript[𝔤, 0]) Lemma

1. 𝕆((e^(γl+βe))|le)=𝕆((e^(γl+(e^γ)βe))|el).
2. 𝕆((e^(γl+βf))|fl)=𝕆((e^(γl+(e^γ)βf))|lf).
3. 𝕆((e^(βe+αf+δef))|fe)=𝕆(((νe)^(ν(-αβh+βe+αf+δef)))|ef), with ν=(((1+hδ))^(-1)).

Gentle Proofs of 1 & 2 and of 3 at δ=0.

MatrixForm /@ {MatrixExp[γ ρl].MatrixExp[β ρe], MatrixExp[(E^γ)β ρe].MatrixExp[γ ρl]}

MatrixForm /@ {MatrixExp[β ρf].MatrixExp[γ ρl], MatrixExp[γ ρl].MatrixExp[(E^γ)β ρf]}

MatrixForm /@ {MatrixExp[α ρf].MatrixExp[β ρe], MatrixExp[-α β ρh].MatrixExp[β ρe].MatrixExp[α ρf]}

Debt. Prove the full part 3!

The Main (Subscript[𝔤, 0]) Theorem.

Raw Version. The (Subscript[𝔤, 0]) invariant of any S-component tangle T can be written in the form Z(T)=𝕆(((ωe)^(L+Q))|(∏_(i∈S))(Subscript[e, i])(Subscript[l, i])(Subscript[f, i])), where ω is a scalar (meaning, a rational function in the variables (Subscript[h, i]) and their exponentials (Subscript[t, i])=(e^(Subscript[h, i]))), where L=∑(Subscript[a, ij])(Subscript[h, i])(Subscript[l, j]) is a balanced quadratic in the variables (Subscript[h, i]) and (Subscript[l, j]) with integer coefficients (Subscript[a, ij]) and where Q=∑(Subscript[b, ij])(Subscript[e, i])(Subscript[f, j]) is a balanced quadratic in the variables (Subscript[e, i]) and (Subscript[f, j]) with scalar coefficients (Subscript[b, ij]). Furthermore, after setting (Subscript[h, i])=h and (Subscript[t, i])=t for all i, the invariant Z(T) is poly-time computable.

Proof. Indeed, 
0. (R^s)=(e^(s(h⊗l+e⊗f)))=𝕆(exp(s hl+(((e^(s h))-1)/h)ef|e⊗lf),
1. 𝕆((e^(γl+βe))|le)=𝕆((e^(γl+(e^γ)βe))|el),
2. 𝕆((e^(γl+βf))|fl)=𝕆((e^(γl+(e^γ)βf))|lf),
3. 𝕆((e^(βe+αf+δef))|fe)=𝕆(((νe)^(ν(-αβh+βe+αf+δef)))|ef), with ν=(((1+hδ))^(-1)),
and the rest is straight-forward.

old above / new below

CF[𝔼[ω_,L_,Q_]] := 𝔼[Simplify[ω], Simplify[L], Simplify[Q]];
𝔼 /: 𝔼[ω1_,L1_,Q1_]𝔼[ω2_,L2_,Q2_] := CF@𝔼[ω1 ω2,L1+L2,Q1+Q2];
𝔼[ω1_,L1_,Q1_] ≡ 𝔼[ω2_,L2_,Q2_] := Simplify[ω1==ω2∧L1==L2∧Q1==Q2];

0. R=(e^(h⊗l+e⊗f))=𝕆(exp(hl+(((e^h)-1)/h)ef|e⊗lf):

𝔼[(Subscript[X, i_,j_]^(+))]:=𝔼[1, (Subscript[h, i])(Subscript[l, j]),(Subscript[h, i]^(-1))((E^(Subscript[h, i]))-1)(Subscript[e, i])(Subscript[f, j])];
𝔼[(Subscript[X, i_,j_]^(-))]:=𝔼[1, -(Subscript[h, i])(Subscript[l, j]),(Subscript[h, i]^(-1))((E^(-(Subscript[h, i])))-1)(Subscript[e, i])(Subscript[f, j])];
𝔼[p_Times] := 𝔼 /@ p;

𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))]

𝕆[𝔼[ω_,L_,Q_], specs___] := 𝕆[ω (E^(L+Q))/.(Subscript[(x:e|h), i_]):>ℏ (Subscript[x, i]), specs];

Timing[$TD=3; T1$2=𝕆[𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))], {(Subscript[l, 1]),(Subscript[f, 1]),(Subscript[e, 2]),(Subscript[l, 3]),(Subscript[f, 3]),(Subscript[e, 4]),(Subscript[l, 5]),(Subscript[f, 5]),(Subscript[e, 6])}->1] /. (Subscript[h, _])->h]

T1$1==T1$2

1. 𝕆((e^(γl+βe))|le)=𝕆((e^(γl+(e^γ)βe))|el),
2. 𝕆((e^(γl+βf))|fl)=𝕆((e^(γl+(e^γ)βf))|lf):

(Subscript[NO, (Subscript[(x:f|e), i_])(Subscript[l, j_])])[𝔼[ω_,L_,Q_]] := CF[𝔼[ω,L,(E^γ)α (Subscript[x, i])+(Q/.(Subscript[x, i])->0)/.{γ->(∂_(Subscript[l, j]))L,α->(∂_(Subscript[x, i]))Q}]];
(Subscript[ANO, (Subscript[(x:f|e), i_])(Subscript[l, j_])])[𝔼[ω_,L_,Q_]] := CF[𝔼[ω,L,(E^(-γ))α (Subscript[x, i])+(Q/.(Subscript[x, i])->0)/.{γ->(∂_(Subscript[l, j]))L,α->(∂_(Subscript[x, i]))Q}]];

𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))]

𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))] // (Subscript[ANO, (Subscript[e, 2])(Subscript[l, 3])])

𝕆[𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))]// (Subscript[ANO, (Subscript[e, 2])(Subscript[l, 3])]), {(Subscript[l, 1]),(Subscript[f, 1]),(Subscript[l, 3]),(Subscript[e, 2]),(Subscript[f, 3]),(Subscript[e, 4]),(Subscript[l, 5]),(Subscript[f, 5]),(Subscript[e, 6])}->1]==𝕆[𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))], {(Subscript[l, 1]),(Subscript[f, 1]),(Subscript[e, 2]),(Subscript[l, 3]),(Subscript[f, 3]),(Subscript[e, 4]),(Subscript[l, 5]),(Subscript[f, 5]),(Subscript[e, 6])}->1]

𝕆[𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))]// (Subscript[ANO, (Subscript[e, 2])(Subscript[l, 3])]), {(Subscript[l, 3]),(Subscript[e, 2])}->1]==𝕆[𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))], {(Subscript[e, 2]),(Subscript[l, 3])}->1]

(𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))] // (Subscript[ANO, (Subscript[e, 2])(Subscript[l, 3])]) // (Subscript[NO, (Subscript[e, 2])(Subscript[l, 3])]))==𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))]

3. 𝕆((e^(βe+αf+δef))|fe)=𝕆(((νe)^(ν(-αβh+βe+αf+δef)))|ef), with ν=(((1+hδ))^(-1)):

(Subscript[NO, (Subscript[f, i_])(Subscript[e, j_])->k_])[𝔼[ω_,L_,Q_]]:=CF[
𝔼[ν ω,L,ν(-α β (Subscript[h, k])+β (Subscript[e, k])+α (Subscript[f, k])+δ (Subscript[e, k])(Subscript[f, k]))+(Q/.(Subscript[f, i])|(Subscript[e, j])->0)]
/.ν->(((1+(Subscript[h, k])δ))^(-1))/.{α->(∂_(Subscript[f, i]))Q/.(Subscript[e, j])->0,β->(∂_(Subscript[e, j]))Q/.(Subscript[f, i])->0,δ->(∂_((Subscript[f, i]),(Subscript[e, j])))Q}];

𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))] // (Subscript[NO, (Subscript[f, 3])(Subscript[e, 4])->7])

𝕆[𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))]// (Subscript[NO, (Subscript[f, 3])(Subscript[e, 4])->7]),  {(Subscript[l, 1]),(Subscript[f, 1]),(Subscript[e, 2]),(Subscript[l, 3]),(Subscript[e, 7]),(Subscript[f, 7]),(Subscript[l, 5]),(Subscript[f, 5]),(Subscript[e, 6])}->1]==𝕆[𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))],  {(Subscript[l, 1]),(Subscript[f, 1]),(Subscript[e, 2]),(Subscript[l, 3]),(Subscript[f, 3]),(Subscript[e, 4]),(Subscript[l, 5]),(Subscript[f, 5]),(Subscript[e, 6])}->1]/.(Subscript[h, _])->h

The Stitching Formula

(Subscript[m, i_,j_->k_])[Z_]:=Module[{x,z},CF[(Z//(Subscript[NO, (Subscript[f, i])(Subscript[e, j])->x])//(Subscript[NO, (Subscript[l, i])(Subscript[e, x])])//(Subscript[NO, (Subscript[f, x])(Subscript[l, j])]))/.(Subscript[z_, i|j|x])->(Subscript[z, k])]]

𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))] // (Subscript[m, 1,2->1])

𝕆[𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))]// (Subscript[m, 1,2->1]),  {(Subscript[e, 1]),(Subscript[l, 1]),(Subscript[f, 1]),(Subscript[l, 3]),(Subscript[f, 3]),(Subscript[e, 4]),(Subscript[l, 5]),(Subscript[f, 5]),(Subscript[e, 6])}->1]==𝕆[𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))],  {(Subscript[l, 1]),(Subscript[f, 1]),(Subscript[e, 2]),(Subscript[l, 3]),(Subscript[f, 3]),(Subscript[e, 4]),(Subscript[l, 5]),(Subscript[f, 5]),(Subscript[e, 6])}->1] /.(Subscript[h, _])->h

𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))] // (Subscript[m, 1,2->1]) // (Subscript[m, 1,3->1])

𝕆[𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))]// (Subscript[m, 1,2->1])// (Subscript[m, 1,3->1]),  {(Subscript[e, 1]),(Subscript[l, 1]),(Subscript[f, 1]),(Subscript[e, 4]),(Subscript[l, 5]),(Subscript[f, 5]),(Subscript[e, 6])}->1]==𝕆[𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))],  {(Subscript[l, 1]),(Subscript[f, 1]),(Subscript[e, 2]),(Subscript[l, 3]),(Subscript[f, 3]),(Subscript[e, 4]),(Subscript[l, 5]),(Subscript[f, 5]),(Subscript[e, 6])}->1] /.(Subscript[h, _])->h

𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))] // (Subscript[m, 1,2->1]) // (Subscript[m, 1,3->1])//(Subscript[m, 1,4->1])

𝕆[𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))]// (Subscript[m, 1,2->1])// (Subscript[m, 1,3->1])//(Subscript[m, 1,4->1]),  {(Subscript[e, 1]),(Subscript[l, 1]),(Subscript[f, 1]),(Subscript[l, 5]),(Subscript[f, 5]),(Subscript[e, 6])}->1]==𝕆[𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))],  {(Subscript[l, 1]),(Subscript[f, 1]),(Subscript[e, 2]),(Subscript[l, 3]),(Subscript[f, 3]),(Subscript[e, 4]),(Subscript[l, 5]),(Subscript[f, 5]),(Subscript[e, 6])}->1] /.(Subscript[h, _])->h

𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))] // (Subscript[m, 1,2->1]) // (Subscript[m, 1,3->1])//(Subscript[m, 1,4->1])//(Subscript[m, 1,5->1])//(Subscript[m, 1,6->1])

𝕆[𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))]// (Subscript[m, 1,2->1])// (Subscript[m, 1,3->1])//(Subscript[m, 1,4->1])//(Subscript[m, 1,5->1])//(Subscript[m, 1,6->1]),  {(Subscript[e, 1]),(Subscript[l, 1]),(Subscript[f, 1])}->1]==𝕆[𝔼[(Subscript[X, 4,1]^(+))(Subscript[X, 2,5]^(+))(Subscript[X, 6,3]^(+))],  {(Subscript[l, 1]),(Subscript[f, 1]),(Subscript[e, 2]),(Subscript[l, 3]),(Subscript[f, 3]),(Subscript[e, 4]),(Subscript[l, 5]),(Subscript[f, 5]),(Subscript[e, 6])}->1] /.(Subscript[h, _])->h

The Main (Subscript[𝔤, 0]) Theorem, Polished Version

Polished Version. With (OverBar[e])=((((e^h)-1))/h)e, the (Subscript[𝔤, 0]) invariant of any S-component tangle T can be written in the form Z(T)=𝕆((ω^(-1))(e^(L+(ω^(-1))Q))|(∏_(i∈S))(Subscript[(OverBar[e]), i])(Subscript[l, i])(Subscript[f, i])), where ω is a scalar (meaning, a polynomial in the variables (Subscript[t, i])=(e^(Subscript[h, i]))), where L=∑(Subscript[a, ij])(Subscript[h, i])(Subscript[l, j]) is a balanced quadratic in the variables (Subscript[h, i]) and (Subscript[l, j]) with integer coefficients (Subscript[a, ij]) and where Q=∑(Subscript[b, ij])(Subscript[(OverBar[e]), i])(Subscript[f, j]) is a balanced quadratic in the variables (Subscript[(OverBar[e]), i]) and (Subscript[f, j]) with scalar coefficients (Subscript[b, ij]). Furthermore, after setting (Subscript[t, i])=t for all i, the invariant Z(T) is poly-time computable.

Debt. Implement (and verify!).

Just a Computation

With[{ψ=ν (E^(ν(t e f-α β h+α f+β e))) /. ν->(((1+t h))^(-1))}, Simplify@{(∂_t)ψ-(∂_(α,β))ψ, ψ /. t->0}]