Pensieve header: Zw and Ж // Zw for virtual knots with two crossings.

Options[SelectedNotebook[],InputAliases]

Жж // FullForm

SetDirectory["C:\\drorbn\\AcademicPensieve\\2014-11"];
Get["../Projects/WKO4/FreeLie.m"];
Get["../Projects/WKO4/AwCalculus.m"];
$SeriesShowDegree=2;

(Subscript[Z, t:(l|s)])[K1_**K2_] := (Subscript[Z, t])[K1]**(Subscript[Z, t])[K2];
(Subscript[Z, t:(l|s)])[K1_ K2_] := (Subscript[Z, t])[K1](Subscript[Z, t])[K2];

(Subscript[ЖZ, t:(l|s)])[K1_**K2_] := (Subscript[ЖZ, t])[K1]**(Subscript[ЖZ, t])[K2];
(Subscript[ЖZ, t:(l|s)])[K1_ K2_] := (Subscript[ЖZ, t])[K1](Subscript[ЖZ, t])[K2];

(SuperPlus[R])[a_,b_] // (Subscript[Z, t:(l|s)]) := (Subscript[E, t])[⟨a->LS[0], b->LS[LW@a]⟩, CWS[0]];
(SuperMinus[R])[a_,b_] // (Subscript[Z, t:(l|s)]) := (Subscript[E, t])[⟨a->LS[0], b->-LS[LW@a]⟩, CWS[0]]

Zw[Tangle[skel_, diag_]] := Module[{res,c,k},
res=(Subscript[Z, s])[diag /. {(SuperPlus[X])->(SuperPlus[R]), (SuperMinus[X])->(SuperMinus[R])}];
For[c=1, c≤Length[skel], ++c,
For[k=2, k≤Length[skel[[c]]], ++k,
res = res // dm[skel[[c,1]], skel[[c,k]], skel[[c,1]]]
]];
res
]

Zw[Tangle[
{Strand[r,1,2,3], Strand[g,4,5,6], Strand[b,7,8,9]},
(SuperMinus[X])[r,6](SuperPlus[X])[2,4](SuperMinus[X])[g,9](SuperPlus[X])[5,7](SuperMinus[X])[b,3](SuperPlus[X])[8,1]
]]@{3}

k=0;
Outer[{++k ,#1*#2} -> (Zw[Tangle[{Strand[1,2,3,4]}, #1*#2]])&,
{(SuperPlus[X])[1,3], (SuperMinus[X])[1,3], (SuperPlus[X])[3,1], (SuperMinus[X])[3,1]},
{(SuperPlus[X])[2,4], (SuperMinus[X])[2,4], (SuperPlus[X])[4,2], (SuperMinus[X])[4,2]}
] // Flatten // ColumnForm

(SuperPlus[R])[a_,b_] // (Subscript[ЖZ, s]) := ((SuperPlus[R])[q,b]**(SuperPlus[R])[a,b]**(SuperMinus[R])[q,a]) // (Subscript[Z, s]) // hη[q];
(SuperMinus[R])[a_,b_] // (Subscript[ЖZ, s]) := ((SuperPlus[R])[q,a]**(SuperMinus[R])[a,b]**(SuperMinus[R])[q,b]) // (Subscript[Z, s]) // hη[q];

(SuperPlus[R])[1,2] // (Subscript[ЖZ, s])

(SuperPlus[R])[1,2]**(SuperMinus[R])[1,2] // (Subscript[ЖZ, s])

lhs=(SuperPlus[R])[1,2]**(SuperPlus[R])[1,3]**(SuperPlus[R])[2,3] // (Subscript[ЖZ, s]); rhs=(SuperPlus[R])[2,3]**(SuperPlus[R])[1,3]**(SuperPlus[R])[1,2] // (Subscript[ЖZ, s]);
{lhs@{3}, (lhs≡rhs)@{5}}

ЖZw[Tangle[skel_, diag_]] := Module[{res,c,k},
res=(Subscript[ЖZ, s])[diag /. {(SuperPlus[X])->(SuperPlus[R]), (SuperMinus[X])->(SuperMinus[R])}];
For[c=1, c≤Length[skel], ++c,
For[k=2, k≤Length[skel[[c]]], ++k,
res = res // dm[skel[[c,1]], skel[[c,k]], skel[[c,1]]]
]];
res
]

k=0;
Outer[{++k ,#1*#2} -> (ZK[k] = ЖZw[Tangle[{Strand[1,2,3,4]}, #1*#2]])&,
{(SuperPlus[X])[1,3], (SuperMinus[X])[1,3], (SuperPlus[X])[3,1], (SuperMinus[X])[3,1]},
{(SuperPlus[X])[2,4], (SuperMinus[X])[2,4], (SuperPlus[X])[4,2], (SuperMinus[X])[4,2]}
] // Flatten // ColumnForm

K1=Tangle[{Strand[1,2,3,4]}, (SuperPlus[X])[1,2](SuperPlus[X])[3,4]];

(ZK[1] ≡ ЖZw[K1])@{4}

k=0;
Gather[
Outer[(++k ->#1*#2)&,
{(SuperPlus[X])[1,3], (SuperMinus[X])[1,3], (SuperPlus[X])[3,1], (SuperMinus[X])[3,1]},
{(SuperPlus[X])[2,4], (SuperMinus[X])[2,4], (SuperPlus[X])[4,2], (SuperMinus[X])[4,2]}
] // Flatten ,
TrueQ[(ЖZw[Tangle[{Strand[1,2,3,4]},#1[[2]]]]≡ЖZw[Tangle[{Strand[1,2,3,4]},#2[[2]]]])@2]&
] // ColumnForm

Print /@ Gather[
Flatten[{
Outer[(#1*#2)&,
{(SuperPlus[X])[1,3], (SuperMinus[X])[1,3], (SuperPlus[X])[3,1], (SuperMinus[X])[3,1]},
{(SuperPlus[X])[2,4], (SuperMinus[X])[2,4], (SuperPlus[X])[4,2], (SuperMinus[X])[4,2]}],
Outer[(#1*#2)&,
{(SuperPlus[X])[1,2], (SuperMinus[X])[1,2], (SuperPlus[X])[2,1], (SuperMinus[X])[2,1]},
{(SuperPlus[X])[3,4], (SuperMinus[X])[3,4], (SuperPlus[X])[4,3], (SuperMinus[X])[4,3]}],
Outer[(#1*#2)&,
{(SuperPlus[X])[1,4], (SuperMinus[X])[1,4], (SuperPlus[X])[4,1], (SuperMinus[X])[4,1]},
{(SuperPlus[X])[2,3], (SuperMinus[X])[2,3], (SuperPlus[X])[3,2], (SuperMinus[X])[3,2]}]
}],
TrueQ[(ЖZw[Tangle[{Strand[1,2,3,4]},#1]]≡ЖZw[Tangle[{Strand[1,2,3,4]},#2]])@4]&
];

Print /@ Gather[
Flatten[{
Outer[(#1*#2)&,
{(SuperPlus[X])[1,3], (SuperMinus[X])[1,3], (SuperPlus[X])[3,1], (SuperMinus[X])[3,1]},
{(SuperPlus[X])[2,4], (SuperMinus[X])[2,4], (SuperPlus[X])[4,2], (SuperMinus[X])[4,2]}],
Outer[(#1*#2)&,
{(SuperPlus[X])[1,2], (SuperMinus[X])[1,2], (SuperPlus[X])[2,1], (SuperMinus[X])[2,1]},
{(SuperPlus[X])[3,4], (SuperMinus[X])[3,4], (SuperPlus[X])[4,3], (SuperMinus[X])[4,3]}],
Outer[(#1*#2)&,
{(SuperPlus[X])[1,4], (SuperMinus[X])[1,4], (SuperPlus[X])[4,1], (SuperMinus[X])[4,1]},
{(SuperPlus[X])[2,3], (SuperMinus[X])[2,3], (SuperPlus[X])[3,2], (SuperMinus[X])[3,2]}]
}],
TrueQ[(Zw[Tangle[{Strand[1,2,3,4]},#1]]≡Zw[Tangle[{Strand[1,2,3,4]},#2]])@4]&
];