Pensieve header: Alexander from Heisenberg.

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

\def\cellscale{0.8}
\def\nbpdfInput#1{\vskip 1mm\par\noindent\includegraphics[scale=\cellscale]{#1}}
\def\nbpdfEcho#1{\vskip 1mm\par\noindent\includegraphics[scale=\cellscale]{#1}}
\def\nbpdfOutput#1{\vskip 1mm\par\noindent\includegraphics[scale=\cellscale]{#1}}
\def\nbpdfSubsection#1{\vskip 1mm\par\noindent\includegraphics[scale=\cellscale]{#1}}

(Subscript[𝔼, s1_])[ω1_,Q1_]≡(Subscript[𝔼, s2_])[ω2_,Q2_]:=s1===s2∧Simplify[ω1==ω2∧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])}]]

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;

A proof of the formula for R is at http://drorbn.net/cat20.

(Subscript[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[(OverBar[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[C, i_]):=(Subscript[𝔼, {}->{Hz@i}])[(T^(-1/2)),0]; (Subscript[(OverBar[C]), i_]):=(Subscript[𝔼, {}->{Hz@i}])[(T^(1/2)),0];

(Subscript[C, 1])

{(Subscript[((Subscript[R, 1,2])), 𝔥]),(Subscript[((Subscript[(OverBar[R]), 1,2])), 𝔥])}

(Subscript[R, 1,2])≡(Subscript[𝔼, {}->{Hz[1],Hz[2]}])[1,{(Subscript[x, 1]),(Subscript[x, 2])}.(({{0, 0}, {T-1, 1-T}})).{(Subscript[p, 1]),(Subscript[p, 2])}]

A proof of the formula for hm is at http://drorbn.net/cat20.

(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])]

Proof of Reidemeister 3:
{\def\nbpdfOutput#1{\vskip 1mm\par\noindent\includegraphics[scale=\cellscale]{#1}\hfill\text{$\Box$\quad}}

((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]))

}

Reidemeister 2:

{(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])}

Reidemeister 1’s:

{((Subscript[R, 1,3])(Subscript[(OverBar[C]), 2]))//(Subscript[hm, 1,2->1])//(Subscript[hm, 1,3->1]), ((Subscript[(OverBar[R]), 1,3])(Subscript[C, 2]))//(Subscript[hm, 1,2->1])//(Subscript[hm, 1,3->1]),
((Subscript[(OverBar[R]), 3,1])(Subscript[(OverBar[C]), 2]))//(Subscript[hm, 1,2->1])//(Subscript[hm, 1,3->1]), ((Subscript[R, 3,1])(Subscript[C, 2]))//(Subscript[hm, 1,2->1])//(Subscript[hm, 1,3->1])}

(Subscript[Kink, i_]):=(Subscript[𝔼, {}->{(Subscript[p, i]),(Subscript[x, i])}])[(T^(-1/2)),0]; (Subscript[(OverBar[Kink]), i_]):=(Subscript[𝔼, {}->{(Subscript[p, i]),(Subscript[x, i])}])[(T^(1/2)),0];

(Subscript[(Subscript[𝔼, {}->vs_])[ωi_,Q_], 𝔥]):=Module[{ps,xs,M},
ps=Cases[vs,(Subscript[p, _])]; xs=Cases[vs,(Subscript[x, _])];
M=Table[ωi,1+Length@ps,1+Length@xs];
M[[2;;,2;;]]=Table[Simplify[(∂_(i,j))Q],{i,ps},{j,xs}];
M[[2;;,1]]=ps; M[[1,2;;]]=xs;
(Subscript[MatrixForm[M], 𝔥])]

The ``First Tangle’’.

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

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

The knot $8_{17}$.

z=(Subscript[(OverBar[R]), 12,1])(Subscript[(OverBar[R]), 2,7])(Subscript[(OverBar[R]), 8,3])(Subscript[(OverBar[R]), 4,11])(Subscript[R, 16,5])(Subscript[R, 6,13])(Subscript[R, 14,9])(Subscript[R, 10,15]);
Do[z= z // (Subscript[hm, 1,k->1]), {k,2,16}];Simplify /@ z

{\red\bf Proof of Theorem 3, (3).}
{\def\nbpdfOutput#1{\vskip 1mm\par\noindent\includegraphics[scale=\cellscale]{#1}\hfill\text{$\Box$\quad}}

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

}

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

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

Recycling

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

Simplify[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^(((e^t)-1)p x+(t^(-1))((e^t)-1) tp x))

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

The Trefoil

Z31=(Subscript[R, 1,5])(Subscript[R, 6,2])(Subscript[R, 3,7])(Subscript[(OverBar[C]), 4])(Subscript[(OverBar[Kink]), 8])(Subscript[(OverBar[Kink]), 9])(Subscript[(OverBar[Kink]), 10]);
Do[Z31=Z31//(Subscript[hm, 1,r->1]),{r,2,10}];
Simplify/@Z31