Normally ordered variables in the q-variant of the 1-co sl_2 algebra.

For pragmatic reasons, 𝔼[ω,L,Q,P] means (ω^(-1))(1+ϵ (ω^(-4))P)Exp[L+(ω^(-1))Q], where ω is an ϵ-free scalar, L is linear and contains only c’s and b’s, Q is a balanced quadratic in the u’s and the w’s and contains no c’s and b’s, and P is a balanced quartic polynomial in the c’s, u’s, and w’s.

(*The R-matrix and its inverse*)
(Subscript[R, i_,j_]^(+)):=𝔼[1,(Subscript[b, i])(Subscript[c, j]),(Subscript[u, i])(Subscript[w, j]),(Subscript[c, i])(Subscript[c, j])-(Subscript[c, j])(Subscript[u, i])(Subscript[w, j])-(1/4)((Subscript[u, i])^2)((Subscript[w, j])^2)]
(Subscript[R, i_,j_]^(-)):=𝔼[1,-(Subscript[b, i])(Subscript[c, j]),-((Subscript[t, i])^(-1))(Subscript[u, i])(Subscript[w, j]),-(Subscript[c, i])(Subscript[c, j])+((Subscript[t, i])^(-1))(Subscript[c, i])(Subscript[u, i])(Subscript[w, j])-((Subscript[t, i])^(-1))(Subscript[u, i])(Subscript[w, j])+(((Subscript[t, i])^(-2))/4)((Subscript[u, i])^2)((Subscript[w, j])^2)]

(*The ribbon element is Drinfeld*(t^(-1/2))(e^(-ϵc)). We assign suitable values to the cups and caps, following Ohtsuki p.72. Only the left-moving cups and caps need to be recorded.*)
(Subscript[nr, i_]):=𝔼[((Subscript[t, i])^(1/2)),0,0,-((Subscript[t, i])^2)(Subscript[c, i])]
(Subscript[nl, i_]):=𝔼[1,0,0,0]
(Subscript[ur, i_]):=𝔼[((Subscript[t, i])^(-1/2)),0,0,((Subscript[t, i])^(-2))(Subscript[c, i])]
(Subscript[ul, i_]):=𝔼[1,0,0,0]

(*The q-Logos*)
Λ[k_]:=(1/4) ((α^2) (β^2)+4 α β δ μ+2 (δ^2) (μ^2)) (1-3 (Subscript[t, k])) (1-(Subscript[t, k]))-2 (μ^2) (α β+δ μ) (Subscript[c, k]) (Subscript[t, k])-2 β δ (μ^2) (Subscript[c, k]) (Subscript[t, k]) (Subscript[u, k])+(1/2) β ((α β+2 δ μ) (1-3 (Subscript[t, k]))+4 α β μ (Subscript[t, k])+8 δ (μ^2) (Subscript[t, k])) (Subscript[u, k])+(1/4) (β^2) δ ((1+μ) (1-3 (Subscript[t, k]))+8 μ (Subscript[t, k])) (Subscript[u, k]^2)+(1/2) α (α β+2 δ μ) (1-3 (Subscript[t, k])) (Subscript[w, k])-2 α δ (μ^2) (Subscript[c, k]) (Subscript[t, k]) (Subscript[w, k])-2 (δ^2) (μ^2) (Subscript[c, k]) (Subscript[t, k]) (Subscript[u, k]) (Subscript[w, k])+(α β+δ μ) (1-2 (δ^2) (1-(Subscript[t, k])) (Subscript[t, k])) (Subscript[u, k]) (Subscript[w, k])+(1/2) β δ (1+μ-2 δ (Subscript[t, k])+4 δ μ (Subscript[t, k])) (Subscript[u, k]^2) (Subscript[w, k])+(1/4) (α^2) δ (1+μ) (1-3 (Subscript[t, k])) (Subscript[w, k]^2)+(1/2) α δ (1+μ-2 δ (Subscript[t, k])) (Subscript[u, k]) (Subscript[w, k]^2)+(1/4) (δ^2) (4 μ+(δ^2) (1-3 (Subscript[t, k])) (1-(Subscript[t, k]))) (Subscript[u, k]^2) (Subscript[w, k]^2)

(Subscript[DP, x_->(Subscript[D, α_]),y_->(Subscript[D, β_])])[P_][f_] := Total[CoefficientRules[P, {x,y}] /. ({m_,n_}->c_) :> c D[f,{α,m},{β,n}]]

CF[𝔼[ω_,L_,Q_,P_]] := Expand/@Together/@
𝔼[ω/.(Subscript[b, l_]):>Log[(Subscript[t, l])],L,Q/.(Subscript[b, l_]):>Log[(Subscript[t, l])],P/.(Subscript[b, l_]):>Log[(Subscript[t, l])]];
𝔼 /: 𝔼[ω1_,L1_,Q1_,P1_]≡𝔼[ω2_,L2_,Q2_,P2_] := (ω1==ω2∧L1==L2∧Q1==Q2∧P1==P2);
𝔼 /: 𝔼[ω1_,L1_,Q1_,P1_]𝔼[ω2_,L2_,Q2_,P2_] := CF@𝔼[ω1 ω2, L1+L2,ω2 Q1+ω1 Q2,((ω2)^4)P1+((ω1)^4)P2];

(Subscript[N, (Subscript[u, i_]),(Subscript[c, j_]),k_])[𝔼[ω_,L_,Q_,P_]] := With[{q=(E^(-γ))β (Subscript[u, k])+γ (Subscript[c, k])}, CF[
𝔼[ω, γ (Subscript[c, k])+(L/.(Subscript[c, j])->0), ω (E^(-γ))β (Subscript[u, k])+(Q/.(Subscript[u, i])->0), (E^(-q))(Subscript[DP, (Subscript[c, j])->(Subscript[D, γ]),(Subscript[u, i])->(Subscript[D, β])])[P][(E^q)]]/. {γ->(∂_(Subscript[c, j]))L,β->(ω^(-1))(∂_(Subscript[u, i]))Q}]];
(Subscript[N, (Subscript[w, i_]),(Subscript[c, j_]),k_])[𝔼[ω_,L_,Q_,P_]] := With[{q=(E^γ)α (Subscript[w, k])+γ (Subscript[c, k])}, CF[
𝔼[ω, γ (Subscript[c, k])+(L/.(Subscript[c, j])->0), ω (E^γ)α (Subscript[w, k])+(Q/.(Subscript[w, i])->0), (E^(-q))(Subscript[DP, (Subscript[c, j])->(Subscript[D, γ]),(Subscript[w, i])->(Subscript[D, α])])[P][(E^q)]]/. {γ->(∂_(Subscript[c, j]))L,α->(ω^(-1))(∂_(Subscript[w, i]))Q}]];

(Subscript[N, (Subscript[w, i_]),(Subscript[u, j_]),k_])[𝔼[ω_,L_,Q_,P_]] :=With[{q=(1-(Subscript[t, k]))(μ^(-1)) α β+(μ^(-1)) β (Subscript[u, k])+(μ^(-1)) δ (Subscript[u, k])(Subscript[w, k])+(μ^(-1)) α (Subscript[w, k])}, CF[
𝔼[μ ω, L, μ ω q+μ(Q/.(Subscript[w, i])|(Subscript[u, j])->0), (μ^4) (E^(-q)) (Subscript[DP, (Subscript[w, i])->(Subscript[D, α]),(Subscript[u, j])->(Subscript[D, β])])[P][(E^q)]+(ω^4)Λ[k]] /. μ->1+((Subscript[t, k])-1) δ /. {α->(ω^(-1))((∂_(Subscript[w, i]))Q/.(Subscript[u, j])->0), β->(ω^(-1))((∂_(Subscript[u, j]))Q/.(Subscript[w, i])->0), δ->(ω^(-1))(∂_((Subscript[w, i]),(Subscript[u, j])))Q}]];

(Subscript[m, i_,j_->k_])[Z_] :=Module[{x,y},
Z // ReplaceAll[{(Subscript[b, i|j])->(Subscript[b, k]),(Subscript[t, i|j])->(Subscript[t, k])}]// (Subscript[N, (Subscript[w, i]),(Subscript[c, j]),x]) // (Subscript[N, (Subscript[w, x]),(Subscript[u, j]),y]) // ReplaceAll[{(Subscript[c, x|y])->(Subscript[c, x]),(Subscript[w, j])->(Subscript[w, y])}] // (Subscript[N, (Subscript[u, i]),(Subscript[c, x]),x]) // ReplaceAll[{(Subscript[c, i|x])->(Subscript[c, k]),(Subscript[u, x|y])->(Subscript[u, k]),(Subscript[w, y])->(Subscript[w, k]),(Subscript[b, x|y])->(Subscript[b, k]),(Subscript[t, x|y])->(Subscript[t, k])}] // CF]

Testing routines.

(*Test meta-associativity*)
Q0=𝔼[x,Sum[RandomInteger[{-2,2}](Subscript[b, i])(Subscript[c, j]),{i,3},{j,3}],Sum[RandomInteger[{-2,2}](Subscript[u, i])(Subscript[w, j]),{i,3},{j,3}],Sum[RandomInteger[{-2,2}](Subscript[u, i])(Subscript[w, j]),{i,3},{j,3}]];
t1=Q0 // (Subscript[m, 1,2->1])//(Subscript[m, 1,3->1]);
t2=Q0 // (Subscript[m, 2,3->2])//(Subscript[m, 1,2->1]);
t1≡t2

(*Check Reidemeister 2,3*)
((Subscript[R, 2,1]^(+)) (Subscript[R, 4,3]^(+)) (Subscript[R, 6,5]^(+))// (Subscript[m, 2,4->x])//(Subscript[m, 1,6->y])//(Subscript[m, 3,5->z]))≡((Subscript[R, 2,1]^(+)) (Subscript[R, 4,3]^(+)) (Subscript[R, 6,5]^(+))// (Subscript[m, 4,6->x])//(Subscript[m, 2,5->y])//(Subscript[m, 1,3->z]))
((Subscript[R, 1,2]^(-)) (Subscript[R, 3,4]^(-)) (Subscript[R, 5,6]^(-))// (Subscript[m, 2,4->x])//(Subscript[m, 1,6->y])//(Subscript[m, 3,5->z]))≡((Subscript[R, 1,2]^(-)) (Subscript[R, 3,4]^(-)) (Subscript[R, 5,6]^(-))// (Subscript[m, 4,6->x])//(Subscript[m, 2,5->y])//(Subscript[m, 1,3->z]))
(Subscript[R, 1,2]^(+)) (Subscript[R, 3,4]^(-)) //(Subscript[m, 4,2->x])//(Subscript[m, 3,1->y])

(*rotated crossings*)
t2=(Subscript[ur, 1])(Subscript[R, 2,5]^(-))(Subscript[nr, 3])(Subscript[ur, 4])(Subscript[nr, 6])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1])//(Subscript[m, 4,5->4])//(Subscript[m, 4,6->4])
t3=((Subscript[ul, 1])(Subscript[R, 2,5]^(-))(Subscript[nl, 3])(Subscript[ul, 4])(Subscript[nl, 6])//(Subscript[m, 1,2->1])//(Subscript[m, 1,3->1])//(Subscript[m, 4,5->4])//(Subscript[m, 4,6->4]))
t2≡t3

(Subscript[ul, 1])(Subscript[nl, 2])//(Subscript[m, 1,2->1])
(Subscript[nl, 1])(Subscript[ul, 2])//(Subscript[m, 1,2->1])
(Subscript[nr, 1])(Subscript[ur, 2])//(Subscript[m, 1,2->1])
(Subscript[ur, 1])(Subscript[nr, 2])//(Subscript[m, 1,2->1])

(*the oppositely oriented RII *)
(Subscript[R, 1,2]^(-)) (Subscript[R, 3,4]^(+))(Subscript[ur, 5])(Subscript[nr, 6])//(Subscript[m, 1,3->1])//(Subscript[m, 4,5->4])//(Subscript[m, 4,2->4])//(Subscript[m, 4,6->4])

Computations

Kinks

(Subscript[R, 1,2]^(+))(Subscript[nr, 3])//(Subscript[m, 1,3->1])//(Subscript[m, 1,2->1])
(Subscript[R, 1,2]^(+))(Subscript[ur, 3])//(Subscript[m, 2,3->2])//(Subscript[m, 2,1->1])
(Subscript[R, 2,1]^(-))(Subscript[nr, 3])//(Subscript[m, 1,3->1])//(Subscript[m, 1,2->1])
(Subscript[R, 2,1]^(-))(Subscript[ur, 3])//(Subscript[m, 2,3->2])//(Subscript[m, 2,1->1])

(*Kinks should be central elements!*)

k =(Subscript[R, 1,2]^(+))(Subscript[ur, 3])//(Subscript[m, 2,3->2])//(Subscript[m, 2,1->4]);
X=𝔼[1,-(Subscript[b, 1]) (Subscript[c, 1]),-(((Subscript[u, 1]) (Subscript[w, 1]))/(Subscript[t, 1])),-(((Subscript[u, 1]) (Subscript[w, 1]))/(Subscript[t, 1]))+(((Subscript[c, 1]) (Subscript[u, 1]) (Subscript[w, 1]))/(Subscript[t, 1]))+(((Subscript[u, 1]^2) (Subscript[w, 1]^2))/(4 (Subscript[t, 1]^2)))];

(k X //(Subscript[m, 1,4->1])) ≡ (k X //(Subscript[m, 4,1->1]))

(Subscript[R, 1,2]^(+))(Subscript[nr, 3])(Subscript[R, 4,5]^(+))(Subscript[nr, 6])//(Subscript[m, 1,3->1])//(Subscript[m, 1,2->1])//(Subscript[m, 4,6->4])//(Subscript[m, 4,5->4])//(Subscript[m, 1,4->1])
(*Kinks are inverses*)
(Subscript[R, 1,2]^(+))(Subscript[nr, 3])(Subscript[R, 5,4]^(-))(Subscript[nr, 6])//(Subscript[m, 1,3->1])//(Subscript[m, 1,2->1])//(Subscript[m, 4,6->4])//(Subscript[m, 4,5->4])//(Subscript[m, 1,4->1])

Compute Trefoil

z31=(Subscript[R, 1,14]^(+))(Subscript[R, 5,2]^(-))(Subscript[nr, 3])(Subscript[ul, 4])(Subscript[R, 19,6]^(+))(Subscript[R, 7,10]^(-))(Subscript[nl, 8])(Subscript[ur, 9])(Subscript[R, 11,20]^(+))(Subscript[nr, 12])(Subscript[ul, 13])(Subscript[R, 15,18]^(-))(Subscript[nl, 16])(Subscript[ur, 17]);
(Do[z31=z31//(Subscript[m, 1,k->1]), {k,2,20}]; z31=z31 /. (Subscript[a_, 1]):>a)
FromCoefficientRules[CoefficientRules[z31[[4]],{c,u,w}]/.{(e_->a_):>(e->Simplify[a]//Factor)},{c,u,w}]

(*Compare with Dror's Trefoil*)
-(((((1-t+(t^2)))^2) (-1+2 t-3 (t^2)+2 (t^3)))/(t^3))-((c (((1-t+(t^2)))^3) (4+t-5 (t^2)-(t^3)+(t^4)))/(2 (t^4)))-(((((1-t+(t^2)))^3) (-4-5 t+(t^3)) u w)/(2 (t^4)))

{ (-1+2 t-3 (t^2)+2 (t^3)),(4+t-5 (t^2)-(t^3)+(t^4)),(-4-5 t+(t^3))}//Factor

(*Mirror trefoil, *)
z31m=(Subscript[R, 14,1]^(-))(Subscript[R, 2,5]^(+))(Subscript[nr, 3])(Subscript[ul, 4])(Subscript[R, 6,19]^(-))(Subscript[R, 10,7]^(+))(Subscript[nl, 8])(Subscript[ur, 9])(Subscript[R, 20,11]^(-))(Subscript[nr, 12])(Subscript[ul, 13])(Subscript[R, 18,15]^(+))(Subscript[nl, 16])(Subscript[ur, 17]);
(Do[z31m=z31m//(Subscript[m, 1,k->1]), {k,2,20}]; z31m=z31m /. (Subscript[a_, 1]):>a)
FromCoefficientRules[CoefficientRules[z31m[[4]],{c,u,w}]/.{(e_->a_):>(e->Simplify[a]//Factor)},{c,u,w}]

(*the 1-co invariant DOES distinguish it from the usual trefoil. So it is STRONGER than Alexander.*)
(z31m≡ z31)/.t->2//Simplify

(*The figure eight knot*)

z41=(Subscript[R, 1,8]^(+))(Subscript[R, 2,6]^(-))(Subscript[R, 10,3]^(+))(Subscript[R, 5,9]^(-))(Subscript[ur, 4])(Subscript[nr, 7]);
(Do[z41=z41//(Subscript[m, 1,k->1]), {k,2,10}]; z41=z41 /. (Subscript[a_, 1]):>a)
FromCoefficientRules[CoefficientRules[z41[[4]],{c,u,w}]/.{(e_->a_):>(e->Simplify[a]//Factor)},{c,u,w}]