SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\Theta"];
Once[<<KnotTheory`]

(Subscript[χ, False])=0; (Subscript[χ, True])=1;

CF[ℰ_] := Expand@Collect[ℰ,(Subscript[g, __]),F]/.F->Factor;

(Subscript[T, 3])=(Subscript[T, 1])(Subscript[T, 2]);

(Subscript[F, 1])[{s_,i_,j_}]:=CF[
s(1/2-(Subscript[g, 3,i,i])+(Subscript[T, 2]^s)(Subscript[g, 1,i,i])(Subscript[g, 2,j,i])-(Subscript[g, 1,i,i])(Subscript[g, 2,j,j])-((Subscript[T, 2]^s)-1)(Subscript[g, 2,j,i])(Subscript[g, 3,i,i])+2(Subscript[g, 2,j,j])(Subscript[g, 3,i,i])-(1-(Subscript[T, 3]^s))(Subscript[g, 2,j,i])(Subscript[g, 3,j,i])-(Subscript[g, 2,i,i])(Subscript[g, 3,j,j])-(Subscript[T, 2]^s)(Subscript[g, 2,j,i])(Subscript[g, 3,j,j])+(Subscript[g, 1,i,i])(Subscript[g, 3,j,j])+(((Subscript[T, 1]^s)-1)(Subscript[g, 1,j,i])((Subscript[T, 2]^(2s))(Subscript[g, 2,j,i])-(Subscript[T, 2]^s)(Subscript[g, 2,j,j])+(Subscript[T, 2]^s)(Subscript[g, 3,j,j]))+((Subscript[T, 3]^s)-1)(Subscript[g, 3,j,i])(1-(Subscript[T, 2]^s)(Subscript[g, 1,i,i])+(Subscript[g, 2,i,j])+((Subscript[T, 2]^s)-2)(Subscript[g, 2,j,j])-((Subscript[T, 1]^s)-1)((Subscript[T, 2]^s)+1) (Subscript[g, 1,j,i])))/((Subscript[T, 2]^s)-1))]

(Subscript[F, 2])[{s0_,i0_,j0_},{s1_,i1_,j1_}]:=CF[s1((Subscript[T, 1]^s0)-1)((((Subscript[T, 2]^s1)-1))^(-1))((Subscript[T, 3]^s1)-1)(Subscript[g, 1,j1,i0])(Subscript[g, 3,j0,i1])( ((Subscript[T, 2]^s0)(Subscript[g, 2,i1,i0])-(Subscript[g, 2,i1,j0]))- ((Subscript[T, 2]^s0)(Subscript[g, 2,j1,i0])-(Subscript[g, 2,j1,j0])))]

b0=Simplify[Together[s(-1+(Subscript[T, 2]^s))(Subscript[F, 1])[{s,i,j}]]/.
{(Subscript[T, 2])->1,(s^2)->1,(Subscript[g, 2,α_,β_]):>(Subscript[χ, α<=β]), (Subscript[g, 3,α_,β_]):>(Subscript[g, 1,α,β])}/.{(Subscript[χ, j≤j])->1,(Subscript[χ, j≤i])->1-(Subscript[χ, i≤j])}
]

Simplify[b0//. {(-1+(Subscript[T, 1]^s))(Subscript[g, 1,j,i])->(Subscript[g, 1,j,j])-(Subscript[g, 1,j,(SuperPlus[j])])}]

b1=Simplify[Together[s1(-1+(Subscript[T, 2]^s1))(Subscript[F, 2])[{s0,i0,j0},{s1,i1,j1}]]/.
{(Subscript[T, 2])->1,(s1^2)->1,(Subscript[g, 2,α_,β_]):>(Subscript[χ, α<=β]),(Subscript[g, 3,α_,β_]):>(Subscript[g, 1,α,β])}
]

Simplify[b1//. {(-1+(Subscript[T, 1]^s0))(Subscript[g, 1,j1,i0])->(Subscript[g, 1,j1,j0])-(Subscript[g, 1,j1,(SuperPlus[j0])]),(-1+(Subscript[T, 1]^s1))(Subscript[g, 1,j0,i1])->(Subscript[g, 1,j0,j1])-(Subscript[g, 1,j0,(SuperPlus[j1])])}]

b2=Simplify[Together[s0(-1+(Subscript[T, 2]^s0))(Subscript[F, 2])[{s1,i1,j1},{s0,i0,j0}]]/.
{(Subscript[T, 2])->1,(s0^2)->1,(Subscript[g, 2,α_,β_]):>(Subscript[χ, α<=β]),(Subscript[g, 3,α_,β_]):>(Subscript[g, 1,α,β])}
]

Simplify[(b1+b2)/2]

Simplify[Factor[(b1+b2)/2]//. {(-1+(Subscript[T, 1]^s0))(Subscript[g, 1,j1,i0])->(Subscript[g, 1,j1,j0])-(Subscript[g, 1,j1,(SuperPlus[j0])]),(-1+(Subscript[T, 1]^s1))(Subscript[g, 1,j0,i1])->(Subscript[g, 1,j0,j1])-(Subscript[g, 1,j0,(SuperPlus[j1])])}]

Testing

Rot[X_List]:=X;
Rot[K_]:=Cases[PD[K],x_X:>(Piecewise[{{{1,x[[4]],x[[1]]}, PositiveQ@x}, {{-1,x[[2]],x[[1]]}, True}}])]

Res[K_]:=Module[{X,n,A,G,ev,r,k,k1,k2},
(* 1 *) X=Rot[K]; n=Length[X]; A=IdentityMatrix[2n+1];
(* 2 *) Cases[X,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=(({{-(T^s), (T^s)-1}, {0, -1}})))];
(* 3 *) G=Inverse[A];
(* 4 *) ev[ℰ_]:=Factor[ℰ /. (SuperPlus[i_]):> i+1 /.(Subscript[g, α_,β_]):>G[[α,β]]];
(* 5 *) r=ev[Sum[F1[X[[k]]], {k,n}]];
(* 6 *) r+=ev[Sum[F2[X[[k1]],X[[k2]]], {k1,n}, {k2,n}]];
(* 7 *) Factor[r]
];

F1[{s_,i_,j_}]:=-(((Subscript[g, i,i])+(Subscript[g, j,j])-2 (Subscript[g, j,(SuperPlus[j])])) ((Subscript[g, j,j])-(Subscript[g, j,(SuperPlus[j])])));
F2[{s0_,i0_,j0_},{s1_,i1_,j1_}]:=-((Subscript[χ, i1≤i0])-(Subscript[χ, i1≤j0])-(Subscript[χ, j1≤i0])+(Subscript[χ, j1≤j0])) (-(Subscript[χ, j0==(SuperPlus[j1])])+(Subscript[χ, j0==(SuperPlus[i1])])+(Subscript[g, j0,i1])-(Subscript[g, j0,(SuperPlus[i1])])) ((Subscript[g, j1,j0])-(Subscript[g, j1,(SuperPlus[j0])]));
F2[{s0_,i0_,j0_},{s1_,i1_,j1_}]:=((Subscript[χ, i1≤i0])-(Subscript[χ, i1≤j0])-(Subscript[χ, j1≤i0])+(Subscript[χ, j1≤j0])) ((Subscript[g, j0,j1])-(Subscript[g, j0,(SuperPlus[j1])])) ((Subscript[g, j1,j0])-(Subscript[g, j1,(SuperPlus[j0])]));

F1[{s,i,j}]//TeXForm

Rot[Knot[3,1]]
Res[Knot[3,1]]

Res/@AllKnots[{3,10}]

RandomVK[n_]:=Prepend[#,2RandomInteger[1]-1]&/@Partition[PermutationList[RandomPermutation[2n],2n],2];

RandomVK[5]

Res/@Table[RandomVK[10],100]

Rev[X_List]:=Module[{n=Length@X}, X/.{s_,i_,j_}:>{s,2n+1-i,2n+1-j}]

Rev[{{1,5,7},{1,10,1},{-1,2,4},{-1,9,8},{-1,6,3}}]

Res@Rev[{{1,5,7},{1,10,1},{-1,2,4},{-1,9,8},{-1,6,3}}]

nRules[{s_,i_,j_}]:={
(Subscript[g, j,β_]):>(Subscript[g, (SuperPlus[j]),β]),(Subscript[g, i,β_]):>(T^s)(Subscript[g, (SuperPlus[i]),β])+(1-(T^s))(Subscript[g, (SuperPlus[j]),β]),(Subscript[g, α_,(SuperPlus[i])]):>(T^s)(Subscript[g, α,i]),(Subscript[g, α_,(SuperPlus[j])]):>(Subscript[g, α,j])+(1-(T^s))(Subscript[g, α,i]),
(Subscript[χ, j<=β_]):>(Subscript[χ, (SuperPlus[j])<=β]),(Subscript[χ, i<=β_]):>(Subscript[χ, (SuperPlus[i])<=β]),(Subscript[χ, α_<=(SuperPlus[i])]):>(Subscript[χ, α<=i]),(Subscript[χ, α_<=(SuperPlus[j])]):>(Subscript[χ, α<=j])
};
nRules[X___List]:=Union@@Table[nRules[c],{c,{X}}]

nRules[{s,i,j}]

nRules[{s0,i0,j0},{s1,i1,j1}]

a1=Simplify[Together[(s1/((-1+(T^s0))(-1+(T^s1))))(-1+(Subscript[T, 2]^s1))(Subscript[F, 2])[{s0,i0,j0},{s1,i1,j1}]]/.
{(Subscript[T, 2])->1,(s1^2)->1,(Subscript[g, 2,α_,β_]):>(Subscript[χ, α<=β]),(Subscript[g, 1|3,α_,β_]):>(Subscript[g, α,β]),(Subscript[T, 1])->T}/.nRules[{s0,i0,j0},{s1,i1,j1}]
]

a2=Simplify[Together[(s0/((-1+(T^s0))(-1+(T^s1))))(-1+(Subscript[T, 2]^s0))(Subscript[F, 2])[{s1,i1,j1},{s0,i0,j0}]]/.
{(Subscript[T, 2])->1,(s0^2)->1,(Subscript[g, 2,α_,β_]):>(Subscript[χ, α<=β]),(Subscript[g, 1|3,α_,β_]):>(Subscript[g, α,β]),(Subscript[T, 1])->T}/.nRules[{s0,i0,j0},{s1,i1,j1}]
]

Simplify[a1+a2]

(Subscript[D, {s_,i_,j_}])[ℰ_]:=CF[((ℰ/.#->(SuperPlus[i]))+(ℰ/.#->(SuperPlus[j]))-(ℰ/.#->i)-(ℰ/.#->j))/.nRules[{s,i,j}]]

(Subscript[D, {s,i,j}])[{(Subscript[g, α,#]),(Subscript[g, α,#]^2)}]

List@@Expand[((Subscript[χ, #<=i0])+(Subscript[χ, #<=j0]))((Subscript[g, (SuperPlus[i0]),#])+(Subscript[g, (SuperPlus[j0]),#]))((Subscript[g, #,i0])+(Subscript[g, #,j0]))]

{(Subscript[χ, #≤i0]) (Subscript[g, #,i0]) (Subscript[g, (SuperPlus[i0]),#]),(Subscript[χ, #≤j0]) (Subscript[g, #,i0]) (Subscript[g, (SuperPlus[i0]),#]),(Subscript[χ, #≤i0]) (Subscript[g, #,j0]) (Subscript[g, (SuperPlus[i0]),#]),(Subscript[χ, #≤j0]) (Subscript[g, #,j0]) (Subscript[g, (SuperPlus[i0]),#]),(Subscript[χ, #≤i0]) (Subscript[g, #,i0]) (Subscript[g, (SuperPlus[j0]),#]),(Subscript[χ, #≤j0]) (Subscript[g, #,i0]) (Subscript[g, (SuperPlus[j0]),#]),(Subscript[χ, #≤i0]) (Subscript[g, #,j0]) (Subscript[g, (SuperPlus[j0]),#]),(Subscript[χ, #≤j0]) (Subscript[g, #,j0]) (Subscript[g, (SuperPlus[j0]),#])}//(Subscript[D, {s1,i1,j1}])

{0,0,0,0,1,-1,0,0}.{(Subscript[χ, #≤i0]) (Subscript[g, #,i0]) (Subscript[g, (SuperPlus[i0]),#]),(Subscript[χ, #≤j0]) (Subscript[g, #,i0]) (Subscript[g, (SuperPlus[i0]),#]),(Subscript[χ, #≤i0]) (Subscript[g, #,j0]) (Subscript[g, (SuperPlus[i0]),#]),(Subscript[χ, #≤j0]) (Subscript[g, #,j0]) (Subscript[g, (SuperPlus[i0]),#]),(Subscript[χ, #≤i0]) (Subscript[g, #,i0]) (Subscript[g, (SuperPlus[j0]),#]),(Subscript[χ, #≤j0]) (Subscript[g, #,i0]) (Subscript[g, (SuperPlus[j0]),#]),(Subscript[χ, #≤i0]) (Subscript[g, #,j0]) (Subscript[g, (SuperPlus[j0]),#]),(Subscript[χ, #≤j0]) (Subscript[g, #,j0]) (Subscript[g, (SuperPlus[j0]),#])}//(Subscript[D, {s1,i1,j1}])

({1,-1}.{(Subscript[χ, #≤i0]) (Subscript[g, #,i0]) (Subscript[g, (SuperPlus[j0]),#]),(Subscript[χ, #≤j0]) (Subscript[g, #,i0]) (Subscript[g, (SuperPlus[j0]),#])}//(Subscript[D, {s1,i1,j1}]))==(-1+(T^s1))a1

List@@Expand[((Subscript[χ, (SuperPlus[i1])<=#])+(Subscript[χ, (SuperPlus[j1])<=#]))((Subscript[g, #,i1])+(Subscript[g, #,j1]))((Subscript[g, (SuperPlus[i1]),#])+(Subscript[g, (SuperPlus[j1]),#]))]

{(Subscript[χ, (SuperPlus[i1])≤#1]) (Subscript[g, #1,i1]) (Subscript[g, (SuperPlus[i1]),#1]),(Subscript[χ, (SuperPlus[j1])≤#1]) (Subscript[g, #1,i1]) (Subscript[g, (SuperPlus[i1]),#1]),(Subscript[χ, (SuperPlus[i1])≤#1]) (Subscript[g, #1,j1]) (Subscript[g, (SuperPlus[i1]),#1]),(Subscript[χ, (SuperPlus[j1])≤#1]) (Subscript[g, #1,j1]) (Subscript[g, (SuperPlus[i1]),#1]),(Subscript[χ, (SuperPlus[i1])≤#1]) (Subscript[g, #1,i1]) (Subscript[g, (SuperPlus[j1]),#1]),(Subscript[χ, (SuperPlus[j1])≤#1]) (Subscript[g, #1,i1]) (Subscript[g, (SuperPlus[j1]),#1]),(Subscript[χ, (SuperPlus[i1])≤#1]) (Subscript[g, #1,j1]) (Subscript[g, (SuperPlus[j1]),#1]),(Subscript[χ, (SuperPlus[j1])≤#1]) (Subscript[g, #1,j1]) (Subscript[g, (SuperPlus[j1]),#1])}//(Subscript[D, {s0,i0,j0}])