Pensieve header: Alexander from Heisenberg.

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

\def\cellscale{0.78}
\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}}

CF=ExpandNumerator@*ExpandDenominator@*PowerExpand@*Factor;

(Subscript[𝔼, s1_])[ωQ1__]≡(Subscript[𝔼, s2_])[ωQ2__]:=s1===s2∧Simplify[{ωQ1}=={ωQ2}]

(Subscript[𝔼, A1_->B1_])[ω1_,Q1_](Subscript[𝔼, A2_->B2_])[ω2_,Q2_]^:=(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,M=Table},
I=IdentityMatrix@Length@B1;
E1=M[(∂_(i,j))Q1,{i,A1},{j,B1}]; E2=M[(∂_(i,j))Q2,{i,A2},{j,B2}];
F1=M[(∂_(i,j))Q1,{i,A1},{j,A1}]; F2=M[(∂_(i,j))Q2,{i,A2},{j,A2}];
G1=M[(∂_(i,j))Q1,{i,B1},{j,B1}]; G2=M[(∂_(i,j))Q2,{i,B2},{j,B2}];
(Subscript[𝔼, A1->B2])[CF[ω1 ω2 ((Det[I-F2.G1])^(1/2))],CF@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])}]]

{(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[𝔼, {}->{(Subscript[p, i]),(Subscript[x, i]),(Subscript[p, j]),(Subscript[x, j])}])[(T^(-1/2)),(1-T)(Subscript[p, j])(Subscript[x, j])+(T-1)(Subscript[p, i])(Subscript[x, j])];
(Subscript[(OverBar[R]), i_,j_]):=(Subscript[𝔼, {}->{(Subscript[p, i]),(Subscript[x, i]),(Subscript[p, j]),(Subscript[x, j])}])[(T^(1/2)),(1-(T^(-1)))(Subscript[p, j])(Subscript[x, j])+((T^(-1))-1)(Subscript[p, i])(Subscript[x, j])];
(Subscript[C, i_]):=(Subscript[𝔼, {}->{(Subscript[p, i]),(Subscript[x, i])}])[(T^(-1/2)),0]; (Subscript[(OverBar[C]), i_]):=(Subscript[𝔼, {}->{(Subscript[p, i]),(Subscript[x, i])}])[(T^(1/2)),0];

(Subscript[C, 1])

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

(Subscript[R, 1,2])≡(Subscript[𝔼, {}->{(Subscript[p, 1]),(Subscript[x, 1]),(Subscript[p, 2]),(Subscript[x, 2])}])[(T^(-1/2)),{(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[𝔼, {(Subscript[π, i]),(Subscript[ξ, i]),(Subscript[π, j]),(Subscript[ξ, j])}->{(Subscript[p, k]),(Subscript[x, 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[(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[CF[(∂_(i,j))Q],{i,ps},{j,xs}];
M[[2;;,1]]=ps; M[[1,2;;]]=xs;
(Subscript[MatrixForm[M], 𝔥])]

\parpic[r]{\scalebox{1}{\input{R3.pdftex_t}}}
{\red\bf 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, 4,3])(Subscript[R, 5,6])//(Subscript[hm, 1,4->1])(Subscript[hm, 2,5->2])(Subscript[hm, 3,6->3]))==((Subscript[R, 2,3])(Subscript[R, 1,6])(Subscript[R, 4,5])//(Subscript[hm, 1,4->1])(Subscript[hm, 2,5->2])(Subscript[hm, 3,6->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])}

{\red\bf The ``First Tangle''.}

Factor/@(z=(Subscript[R, 1,6])(Subscript[(OverBar[C]), 3])(Subscript[(OverBar[R]), 7,4])(Subscript[(OverBar[R]), 5,2])//(Subscript[hm, 1,3->1])//(Subscript[hm, 1,4->1])//(Subscript[hm, 1,5->1])//(Subscript[hm, 1,6->1])//(Subscript[hm, 2,7->2]))

\vskip -3mm
\parpic[r]{\scalebox{1}{\input{FirstTangle.pdftex_t}}}

(Subscript[z, 𝔥])

\parpic[r]{\scalebox{0.8}{\input{817.pdftex_t}}}
{\red\bf 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]);
Table[z= z // (Subscript[hm, 1,k->1]), {k,2,16}]//Last

{\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[𝔼, {}->{(Subscript[p, 1]),(Subscript[x, 1]),(Subscript[p, 2]),(Subscript[x, 2]),(Subscript[p, 3]),(Subscript[x, 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]);
Do[Z31=Z31//(Subscript[hm, 1,r->1]),{r,2,7}];
Simplify/@Z31