Pensieve header: Mathematica notebook for the 2-variable perturbed Alexander invariant.

Initialization

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\HigherRank"];
Once[<<KnotTheory`; <<Rot.m];
(Subscript[T, 3])=(Subscript[T, 1])(Subscript[T, 2]);
(SuperPlus[((SuperPlus[α_]))]):=(α^("++"));    (* this is for cosmetic reasons only *)
(Subscript[δ, i_,j_]):=If[i===j,1,0];

The Target Program

(Subscript[R, 1])[{s_,i_,j_}]:=TBD;
θ[{s0_,i0_,j0_},{s1_,i1_,j1_}]:=TBD;
CF[ℰ_]:=Factor@Together[ℰ];
λ[K_]:=Module[{Cs,φ,n,A,s,i,j,k,Δ,G,gEval,c,λ1},
{Cs,φ}=Rot[K]; n=Length[Cs];
A=IdentityMatrix[2n+1];
Cases[Cs,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=(({{-(T^s), (T^s)-1}, {0, -1}})))];
Δ=(T^((-Total[φ]-Total[Cs[[All,1]]])/2))Det[A];
G=Inverse[A];
gEval[ℰ_]:=CF[ℰ/.{(Subscript[g, ν_,α_,β_]):>(G[[α,β]]/.T->(Subscript[T, ν]))}];
λ1=Plus[
Sum[(Subscript[R, 1])[Cs[[k]]], {k,n}],
Sum[θ[Cs[[k0]],Cs[[k1]]], {k0,n}, {k1,n}],
Sum[3/2-(Subscript[g, 1,k,k])-(Subscript[g, 2,k,k])-(Subscript[g, 3,k,k]),{k,2n}]
];
{Δ,((Δ^2)/.T->(Subscript[T, 1]))((Δ^2)/.T->(Subscript[T, 2]))((Δ^2)/.T->(Subscript[T, 3]))λ1}//gEval
];

Step-by-step Run-Through

CF[ℰ_]:=Factor@Together[ℰ];

K={
PD[X[4,2,5,1],X[2,6,3,5],X[6,4,7,3]],
Knot[6,2]
}[[1]]

{Cs,φ}=Rot[K]

n=Length[Cs];
A=IdentityMatrix[2n+1];
Cases[Cs,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=(({{-(T^s), (T^s)-1}, {0, -1}})))];

A//MatrixForm

Δ=(T^((-Total[φ]-Total[Cs[[All,1]]])/2))Det[A]

G=Inverse[A];
G//MatrixForm

gEval[ℰ_]:=CF[ℰ/.{(Subscript[g, ν_,α_,β_]):>(G[[α,β]]/.T->(Subscript[T, ν]))}];

The g-Rules

(Subscript[gRules, s_,i_,j_]):={
(Subscript[g, ν_,i,β_]):>(Subscript[δ, i,β])+(Subscript[T, ν]^s)(Subscript[g, ν,i+1,β])+(1-(Subscript[T, ν]^s))(Subscript[g, ν,j+1,β]),(Subscript[g, ν_,j,β_]):>(Subscript[δ, j,β])+(Subscript[g, ν,j+1,β]),
(Subscript[g, ν_,α_,i]):>(Subscript[T, ν]^(-s))((Subscript[g, ν,α,i+1])-(Subscript[δ, α,i+1])),(Subscript[g, ν_,α_,j]):>(Subscript[g, ν,α,j+1])-(1-(Subscript[T, ν]^s))(Subscript[g, ν,α,i])-(Subscript[δ, α,j+1])
}

(gs=Table[{(Subscript[g, 1,α,β]),(Subscript[g, 2,α,β]),(Subscript[g, 3,α,β])},{α,2n+1},{β,2n+1}])[[1;;2,1;;2,1;;2]]

Cs

(gs/.(Subscript[gRules, Sequence@@Cs[[1]]]))[[1;;2,1;;2,1;;2]]

gEval[gs-(gs/.Flatten@Table[(Subscript[gRules, Sequence@@c]),{c,Cs}])]

Fixing θ.

Sum[(Subscript[g, 3,])]

Invariance of (Subscript[y, αβγ]) under remote R2s

Clear[i,j];
Cs={{1,i,j},{-1,(SuperPlus[i]),(SuperPlus[j])}}
Z=Module[{s,i,j},Sum[{s,i,j}=c;
(Subscript[g, 3,α,i])((S^s)((T^s)-1)(Subscript[g, 1,(SuperPlus[j]),β])(Subscript[g, 2,(SuperPlus[i]),γ])+((S^s)-1)(T^s)(Subscript[g, 1,(SuperPlus[i]),β])(Subscript[g, 2,(SuperPlus[j]),γ])+((S^s)+(T^s)-2 (TS^s))(Subscript[g, 1,(SuperPlus[j]),β])(Subscript[g, 2,(SuperPlus[j]),γ])),
{c,Cs}]]
Simplify[Z//.(Subscript[gRules, 1,i,j])⋃(Subscript[gRules, -1,(SuperPlus[i]),(SuperPlus[j])])/._If->0]

Invariance of (Subscript[y, αβγ]) under remote R3s

Clear[i,j,k];
Cs={{1,i,j},{1,(SuperPlus[i]),k},{1,(SuperPlus[j]),(SuperPlus[k])}}
Z=Module[{s,i,j},Sum[{s,i,j}=c;
(Subscript[g, 3,α,i])((S^s)((T^s)-1)(Subscript[g, 1,(SuperPlus[j]),β])(Subscript[g, 2,(SuperPlus[i]),γ])+((S^s)-1)(T^s)(Subscript[g, 1,(SuperPlus[i]),β])(Subscript[g, 2,(SuperPlus[j]),γ])+((S^s)+(T^s)-2 (TS^s))(Subscript[g, 1,(SuperPlus[j]),β])(Subscript[g, 2,(SuperPlus[j]),γ])),
{c,Cs}]]
lhs=Simplify[Z//.(Subscript[gRules, 1,i,j])⋃(Subscript[gRules, 1,(SuperPlus[i]),k])⋃(Subscript[gRules, 1,(SuperPlus[j]),(SuperPlus[k])])/._If->0]

Clear[i,j,k];
Cs={{1,j,k},{1,i,(SuperPlus[k])},{1,(SuperPlus[i]),(SuperPlus[j])}}
Z=Module[{s,i,j},Sum[{s,i,j}=c;
(Subscript[g, 3,α,i])((S^s)((T^s)-1)(Subscript[g, 1,(SuperPlus[j]),β])(Subscript[g, 2,(SuperPlus[i]),γ])+((S^s)-1)(T^s)(Subscript[g, 1,(SuperPlus[i]),β])(Subscript[g, 2,(SuperPlus[j]),γ])+((S^s)+(T^s)-2 (TS^s))(Subscript[g, 1,(SuperPlus[j]),β])(Subscript[g, 2,(SuperPlus[j]),γ])),
{c,Cs}]]
rhs=Simplify[Z//.(Subscript[gRules, 1,j,k])⋃(Subscript[gRules, 1,i,(SuperPlus[k])])⋃(Subscript[gRules, 1,(SuperPlus[i]),(SuperPlus[j])])/._If->0]

Simplify[lhs==rhs]

Setting up (Subscript[R, 1])

gs=Flatten@Table[{(Subscript[g, p,i,i]),(Subscript[g, p,i,j]),(Subscript[g, p,j,i]),(Subscript[g, p,j,j])},{p,3}];
bas={1}⋃gs⋃Flatten@Table[gs[[p]]gs[[q]], {p,Length[gs]},{q,p,Length[gs]}]⋃Flatten@Table[gs[[p]]gs[[q]]gs[[r]], {p,Length[gs]},{q,p,Length[gs]},{r,q,Length[gs]}]⋃{(Subscript[y, i,i,i]),(Subscript[y, i,i,j]),(Subscript[y, i,j,i]),(Subscript[y, i,j,j]),(Subscript[y, j,i,i]),(Subscript[y, j,i,j]),(Subscript[y, j,j,i]),(Subscript[y, j,j,j])};
len=Length[bas]
vars=Table[(Subscript[c, p])=0;(Subscript[c, p])=.;(Subscript[c, p]),{p,2len}];
(Subscript[R, 1])[1,i_,j_]:=Evaluate[Sum[(Subscript[c, p])bas[[p]],{p,len}]];
(Subscript[R, 1])[-1,i_,j_]:=Evaluate[Sum[(Subscript[c, len+p])bas[[p]],{p,Length[bas]}]];

Solving R2b

Clear[i,j];
eqn=Expand[(Subscript[R, 1])[1,i,j]+(Subscript[R, 1])[-1,(SuperPlus[i]),(SuperPlus[j])]//.(Subscript[gRules, 1,i,j])⋃(Subscript[gRules, -1,(SuperPlus[i]),(SuperPlus[j])])⋃(Subscript[yRules, 1,i,j])⋃(Subscript[yRules, -1,(SuperPlus[i]),(SuperPlus[j])])/._If->0]

gys=Cases[eqn,(Subscript[g, _,_,_]),∞]⋃Cases[eqn,(Subscript[y, __]),∞]

eqns=CoefficientRules[eqn,gys]/.(_->c_):>(c==0)

Short[{sol}=Solve[eqns,vars],5]

Short[sol/.(v_->val_):>(v=CF[val])]

Last@(Subscript[R, 1])[1,i,j]

Short[(Subscript[R, 1])[1,i,j],10]

Solving R3

Clear[i,j,k];
lhs=Expand[(Subscript[R, 1])[1,i,j]+(Subscript[R, 1])[1,(SuperPlus[i]),k]+(Subscript[R, 1])[1,(SuperPlus[j]),(SuperPlus[k])]//.(Subscript[gRules, 1,i,j])⋃(Subscript[gRules, 1,(SuperPlus[i]),k])⋃(Subscript[gRules, 1,(SuperPlus[j]),(SuperPlus[k])])⋃(Subscript[yRules, 1,i,j])⋃(Subscript[yRules, 1,(SuperPlus[i]),k])⋃(Subscript[yRules, 1,(SuperPlus[j]),(SuperPlus[k])])/._If->0];
rhs=Expand[(Subscript[R, 1])[1,j,k]+(Subscript[R, 1])[1,i,(SuperPlus[k])]+(Subscript[R, 1])[1,(SuperPlus[i]),(SuperPlus[j])]//.(Subscript[gRules, 1,j,k])⋃(Subscript[gRules, 1,i,(SuperPlus[k])])⋃(Subscript[gRules, 1,(SuperPlus[i]),(SuperPlus[j])])⋃(Subscript[yRules, 1,j,k])⋃(Subscript[yRules, 1,i,(SuperPlus[k])])⋃(Subscript[yRules, 1,(SuperPlus[i]),(SuperPlus[j])])/._If->0];
eqn=lhs-rhs

Short[vars=Union@Cases[eqn,(Subscript[c, _]),∞]]

gys=Cases[eqn,(Subscript[g, _,_,_]),∞]⋃Cases[eqn,(Subscript[y, __]),∞]

Short[eqns=CoefficientRules[eqn,gys]/.(_->c_):>(c==0)]

Short[{sol}=Solve[eqns,vars],5]

Short[sol/.(v_->val_):>(v=CF[val])]

Short[(Subscript[R, 1])[1,i,j],5]

(Subscript[R, 1])[1,i,j]//Simplify