SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\Theta"];
Once[<<Theta.m]

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

RandomVK[5]

CF[ℰ_] := Collect[
Expand@Collect[ℰ,(Subscript[g, __])|(Subscript[δ, __])|(Subscript[χ, __]),F]/.F->Factor@*PowerExpand,
(Subscript[χ, i0==i1])
];

(Subscript[Θ, F1_,F2_])[K_]:=Module[{X,φ,n,A,Δ,G,ev,θ,k,k1,k2},
{X,φ}=Rot[K]; n=Length[X]; A=IdentityMatrix[2n+1];
Cases[X,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=(({{-(T^s), (T^s)-1}, {0, -1}})))];
Δ=(T^((-Total[φ]-Total[X[[All,1]]])/2))Det[A];
G=Inverse[A];
ev[ℰ_]:=Factor[ℰ/.(SuperPlus[k_]):>k+1/.{(Subscript[g, ν_,α_,β_]):>(G[[α,β]]/.T->(Subscript[T, ν])),(Subscript[χ, True])->1,(Subscript[χ, False])->0}];
θ=ev@Sum[F1//.Thread[{s,i,j}->X[[k]]], {k,n}];
θ+=ev@Sum[F2//.Thread[{s0,i0,j0}->X[[k1]]]//.Thread[{s1,i1,j1}->X[[k2]]], {k1,n}, {k2,n}];
θ+=ev@Sum[(Subscript[F, 3])[φ[[k]],k], {k,Length@φ}];
Factor@{Δ,(Δ/.T->(Subscript[T, 1]))(Δ/.T->(Subscript[T, 2]))(Δ/.T->(Subscript[T, 3]))θ}
];

FO=CF[(Subscript[χ, i0==i1])(Subscript[F, 1])[{s0,i0,j0}]+(Subscript[F, 2])[{s0,i0,j0},{s1,i1,j1}]]

PolyPlot[(Subscript[Θ, 0,FO])[Knot[7,1]], ImageSize->Tiny]

(Subscript[δ, i_,j_]):=(Subscript[χ, i==j]);
bRules[{s_,i_,j_}]:={ (* b for "push indices backwards" *)
(Subscript[g, ν_,(SuperPlus[j]),β_]):>(Subscript[g, ν,j,β])-(Subscript[δ, j,β]),(Subscript[g, ν_,(SuperPlus[i]),β_]):>(Subscript[T, ν]^(-s))(Subscript[g, ν,i,β])+(1-(Subscript[T, ν]^(-s)))(Subscript[g, ν,j,β])-(Subscript[T, ν]^(-s)) (Subscript[δ, i,β])-(1-(Subscript[T, ν]^(-s))) (Subscript[δ, j,β]),
(Subscript[g, ν_,α_,(SuperPlus[i])]):>(Subscript[T, ν]^s)(Subscript[g, ν,α,i])+(Subscript[δ, α,(SuperPlus[i])]),(Subscript[g, ν_,α_,(SuperPlus[j])]):>(Subscript[g, ν,α,j])+(1-(Subscript[T, ν]^s))(Subscript[g, ν,α,i])+(Subscript[δ, α,(SuperPlus[j])])
};
bRules[X___List]:=Union@@Table[bRules[c],{c,{X}}]

{(Subscript[g, ν,i,β]),(Subscript[g, ν,j,β])}/.gRules[{s,i,j}]

Expand[{(Subscript[g, ν,i,β]),(Subscript[g, ν,j,β])}/.gRules[{s,i,j}]/.bRules[{s,i,j}]]

(Subscript[D, {s_,i_,j_}])[ℰ_]:=CF[
CF[
((ℰ/.#->(SuperPlus[i]))+(ℰ/.#->(SuperPlus[j]))-(ℰ/.#->i)-(ℰ/.#->j))/.{(Subscript[g, ν_,α_,β:(SuperPlus[(i|j)])]):>(Subscript[g, ν,α,β])-(Subscript[δ, α,β])}/.bRules[{s,i,j}]
] /. (Subscript[χ, j1==i0])|(Subscript[χ, i1==j0])->0/.(Subscript[χ, j1==j0])|(Subscript[χ, i1==i0])->(Subscript[χ, i0==i1])/.(Subscript[χ, eq_Equal]^2)->(Subscript[χ, eq])//.{(Subscript[χ, i0==i1])(Subscript[g, ν_,i1,β_]):>(Subscript[χ, i0==i1])(Subscript[g, ν,i0,β]),(Subscript[χ, i0==i1])(Subscript[g, ν_,j1,β_]):>(Subscript[χ, i0==i1])(Subscript[g, ν,j0,β]),(Subscript[χ, i0==i1])(Subscript[g, ν_,α_,i1]):>(Subscript[χ, i0==i1])(Subscript[g, ν,α,i0]),(Subscript[χ, i0==i1])(Subscript[g, ν_,α_,j1]):>(Subscript[χ, i0==i1])(Subscript[g, ν,α,j0])}
]

(Subscript[D, {s1,i1,j1}])[(Subscript[g, 1,#,i0]) (Subscript[g, 2,#,j0]) (Subscript[g, 3,j0,#])]

(Subscript[D, {s_,i_,j_}])[ℰ_]:=CF[Plus[
ℰ/.{(Subscript[g, ν_,#,β_]):>(Subscript[g, ν,(SuperPlus[i]),β]),(Subscript[g, ν_,α_,#]):>(Subscript[g, ν,α,(SuperPlus[i])])},
ℰ/.{(Subscript[g, ν_,#,β_]):>(Subscript[g, ν,(SuperPlus[j]),β]),(Subscript[g, ν_,α_,#]):>(Subscript[g, ν,α,(SuperPlus[j])])},
-ℰ/.{(Subscript[g, ν_,#,β_]):>(Subscript[g, ν,i,β]),(Subscript[g, ν_,α_,#]):>(Subscript[g, ν,α,i])},
-ℰ/.{(Subscript[g, ν_,#,β_]):>(Subscript[g, ν,j,β]),(Subscript[g, ν_,α_,#]):>(Subscript[g, ν,α,j])}
]/.bRules[{s,i,j}]
];
(Subscript[B, L_])[ℰ_]:=CF[
(ℰ/.{(Subscript[g, ν_,#,β_]):>(Subscript[g, ν,L,β]),(Subscript[g, ν_,α_,#]):>(Subscript[g, ν,α,L])})-(ℰ/.{(Subscript[g, ν_,#,β_]):>(Subscript[g, ν,1,β]),(Subscript[g, ν_,α_,#]):>(Subscript[g, ν,α,1])})/.{
(Subscript[g, _,L,β_])->(Subscript[χ, L==β]),(Subscript[g, _,_,L])->1,(Subscript[g, _,α_,1])->(Subscript[χ, α==1])}
];

(Subscript[D, {s1,i1,j1}])[(Subscript[g, 1,#,i0]) ]

(Subscript[D, {s1,i1,j1}])[(Subscript[g, 3,j0,#])]

(Subscript[B, 2n+1])[(Subscript[g, 3,j0,#])]

(Subscript[Θ, -(Subscript[B, 19])[(Subscript[g, 3,j,#])],(Subscript[D, {s1,i1,j1}])[(Subscript[g, 3,j0,#])]])[Knot[9,1]]

(Subscript[Θ, -(Subscript[B, 19])[(Subscript[g, 1,j,#])],(Subscript[D, {s1,i1,j1}])[(Subscript[g, 1,j0,#])]])[Knot[9,7]]

PolyPlot[(Subscript[Θ, -(Subscript[B, 19])[(Subscript[g, 1,j,#])],(Subscript[D, {s1,i1,j1}])[(Subscript[g, 1,j0,#])]])[Knot[9,7]], ImageSize->Tiny]

PolyPlot[(Subscript[Θ, -(Subscript[B, 19])[(Subscript[g, 1,#,i]) (Subscript[g, 2,#,j]) (Subscript[g, 3,j,#])],FO+(Subscript[D, {s1,i1,j1}])[(Subscript[g, 1,#,i0]) (Subscript[g, 2,#,j0]) (Subscript[g, 3,j0,#])]])[Knot[9,1]], ImageSize->Tiny]

List@@Expand[((Subscript[g, 1,#,i0])+(Subscript[g, 1,#,j0]))((Subscript[g, 2,#,i0])+(Subscript[g, 2,#,j0]))((Subscript[g, 3,i0,#])+(Subscript[g, 3,j0,#]))]

Column[(#->(Subscript[D, {s1,i1,j1}])[#])&/@List@@Expand[((Subscript[g, 1,#,i0])+(Subscript[g, 1,#,j0]))((Subscript[g, 2,#,i0])+(Subscript[g, 2,#,j0]))((Subscript[g, 3,i0,#])+(Subscript[g, 3,j0,#]))]]