Pensieve header: Normally Ordered Exponentials at 1-Co in the t variables.

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.

(*Dror's Logos for the algebra g_1.
Λ[k_]:=(1-(Subscript[t, k]))((α^2)(β^2)+4α β δ μ+2(δ^2)(μ^2))/2+2(μ^2)(α β+δ μ)(Subscript[c, k])-β(2μ-1)(α β+2δ μ)(Subscript[u, k])+2β δ (μ^2)(Subscript[c, k])(Subscript[u, k])-(β^2)δ(3μ-1)(Subscript[u, k]^2)/2+α(α β+2 δ μ)(Subscript[w, k])+2α δ (μ^2)(Subscript[c, k])(Subscript[w, k])-2((Subscript[t, k])-1)(δ^2)(α β+δ μ)(Subscript[u, k])(Subscript[w, k])+2(δ^2)(μ^2)(Subscript[c, k])(Subscript[u, k])(Subscript[w, k])-β (δ^2)(2μ-1)(Subscript[u, k]^2)(Subscript[w, k])+(α^2)δ(1+μ)(Subscript[w, k]^2)/2+α (δ^2)(Subscript[u, k])(Subscript[w, k]^2)-((Subscript[t, k])-1)(δ^4)(Subscript[u, k]^2)(Subscript[w, k]^2)/2;
*)

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

(*Test meta-associativity*)
Q0=𝔼[1,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}],0];
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

(*The R-matrix*)
(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[c, i])(Subscript[u, i])(Subscript[w, j])+(Subscript[u, i])(Subscript[w, j])+(1/4)((Subscript[u, i])^2)((Subscript[w, j])^2)]

(*Check Reidemeister 2,3*)

(*Compute Trefoil*)

(*Since 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[ul, i_]):=𝔼[((Subscript[t, i])^(-1/2)),0,0,-(Subscript[c, i])]
(Subscript[ur, i_]):=𝔼[1,0,0,0]
(Subscript[nl, i_]):=𝔼[((Subscript[t, i])^(1/2)),0,0,(Subscript[c, i])]
(Subscript[nr, i_]):=𝔼[1,0,0,0]

z2=(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[z2=z2//(Subscript[m, 1,k->1]), {k,2,20}]; z2=z2 /. (Subscript[a_, 1]):>a)

FromCoefficientRules[CoefficientRules[z2[[4]],{c,u,w}]/.{(e_->a_):>(e->Simplify[a])},{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)))