Pensieve header: The 2-variable perturbed Alexander invariant: No g-quadratic solution.

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

Lower Rank 2 Gassner: (Modified from Rank2Gassner.nb)

(Subscript[LR2G, i_,j_])[ℰ_]:=Expand[ℰ/.{(Subscript[e, i]):>T (Subscript[e, i])+(1-T) (Subscript[e, j]),(Subscript[f, i]):>S (Subscript[f, i])+(1-S) (Subscript[f, j]),
(Subscript[g, i]):>T S (Subscript[g, i])+(1-T S) (Subscript[g, j])
+S (T-1) (Subscript[e, j]) (Subscript[f, i])+(S-1) T (Subscript[e, i]) (Subscript[f, j])+(S+T-2 S T) (Subscript[e, j]) (Subscript[f, j])}];
(Subscript[(OverBar[LR2G]), i_,j_])[ℰ_]:=Expand[ℰ/.{(Subscript[e, i]):>(T^(-1)) (Subscript[e, i])+(1-(T^(-1))) (Subscript[e, j]),(Subscript[f, i]):>(S^(-1)) (Subscript[f, i])+(1-(S^(-1))) (Subscript[f, j]),
(Subscript[g, i]):>(T^(-1)) (S^(-1)) (Subscript[g, i])+(1-(T^(-1)) (S^(-1))) (Subscript[g, j])
-(S^(-1))(1-(T^(-1))) (Subscript[e, j]) (Subscript[f, i])-(T^(-1))(1-(S^(-1))) (Subscript[e, i]) (Subscript[f, j])+((S^(-1))+(T^(-1))-2(S^(-1))(T^(-1))) (Subscript[e, j]) (Subscript[f, j])}];
bas={(Subscript[e, 1]),(Subscript[e, 2]),(Subscript[e, 3]),(Subscript[f, 1]),(Subscript[f, 2]),(Subscript[f, 3]),(Subscript[e, 1])(Subscript[f, 1]),(Subscript[e, 1])(Subscript[f, 2]),(Subscript[e, 1])(Subscript[f, 3]),(Subscript[e, 2])(Subscript[f, 1]),(Subscript[e, 2])(Subscript[f, 2]),(Subscript[e, 2])(Subscript[f, 3]),(Subscript[e, 3])(Subscript[f, 1]),(Subscript[e, 3])(Subscript[f, 2]),(Subscript[e, 3])(Subscript[f, 3]),(Subscript[g, 1]),(Subscript[g, 2]),(Subscript[g, 3])};
(bas//(Subscript[LR2G, 1,2])//(Subscript[(OverBar[LR2G]), 1,2]))==bas
(bas//(Subscript[LR2G, 3,2])//(Subscript[(OverBar[LR2G]), 3,2]))==bas
(lhs=bas//(Subscript[LR2G, 1,2])//(Subscript[LR2G, 1,3])//(Subscript[LR2G, 2,3]))==(bas//(Subscript[LR2G, 2,3])//(Subscript[LR2G, 1,3])//(Subscript[LR2G, 1,2]))

(Subscript[R, 1])[s_,i_,j_]:=TBD; (* a sign(s)-dependent quadratic polynomial in (Subscript[g, 1αβ]), (Subscript[g, 2αβ]), (Subscript[g, 3αβ]), and (Subscript[y, αβγ]), where deg (Subscript[y, αβγ])=2 and α,β,γ∈{i,j}, with coefficients in ℤ[(T^(±1)),(S^(±1))]. *)
CF[ℰ_]:=Factor@Together[ℰ];
λ[K_]:=Module[{Cs,φ,n,A,s,i,j,k,Δ,G,gEval,Y,yEval,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[ℰ/.(SuperPlus[α_]):>α+1/.
{(Subscript[g, 1,α_,β_]):>G[[α,β]], (Subscript[g, 2,α_,β_]):>(G[[α,β]]/.T->S),(Subscript[g, 3,α_,β_]):>(G[[α,β]]/.T->TS)}];
Y[α_,β_,γ_]:=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}];
yEval[ℰ_]:=CF[ℰ/.(Subscript[y, α_,β_,γ_]):>Y[α,β,γ]];
λ1=(∑_(k=1)^n)(Subscript[R, 1])@@Cs[[k]] - (∑_(k=1)^(2n))φ[[k]]((Subscript[g, 1,k,k])+(Subscript[g, 2,k,k])+(Subscript[g, 3,k,k]));
{Δ,Δ(Δ/.T->S)(Δ/.T->TS)λ1}//yEval//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[ℰ/.(SuperPlus[α_]):>α+1/.
{(Subscript[g, 1,α_,β_]):>G[[α,β]], (Subscript[g, 2,α_,β_]):>(G[[α,β]]/.T->S),(Subscript[g, 3,α_,β_]):>(G[[α,β]]/.T->TS)}];

Clear[Y]
Y[α_,β_,γ_]:=Y[α,β,γ]=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}];
Column[MatrixForm/@Table[Y[α,β,γ],{α,3},{β,3},{γ,3}]]

Column[MatrixForm/@Table[Y[α,β,γ]//gEval,{α,3},{β,3},{γ,3}]]

yEval[ℰ_]:=CF[ℰ/.(Subscript[y, α_,β_,γ_]):>Y[α,β,γ]]

The g-Rules

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

(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}])]

The y-Rules

(Subscript[yRules, s_,i_,j_]):={
(Subscript[y, i,β_,γ_]):>(TS^s)(Subscript[y, (SuperPlus[i]),β,γ])+(1-(TS^s))(Subscript[y, (SuperPlus[j]),β,γ])+((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]),γ])),
(Subscript[y, j,β_,γ_]):>(Subscript[y, (SuperPlus[j]),β,γ]),
(Subscript[y, α_,i,γ_]):>(T^(-s))(Subscript[y, α,(SuperPlus[i]),γ])+(1-(S^s))(Subscript[g, 3,α,i])(Subscript[g, 2,(SuperPlus[j]),γ]),
(Subscript[y, α_,j,γ_]):>(Subscript[y, α,(SuperPlus[j]),γ])-(1-(T^s))(Subscript[y, α,i,γ])-(Subscript[g, 3,α,i])((S^s)((T^s)-1)(Subscript[g, 2,(SuperPlus[i]),γ])+((S^s)+(T^s)-2 (TS^s))(Subscript[g, 2,(SuperPlus[j]),γ])),
(Subscript[y, α_,β_,i]):>(S^(-s))(Subscript[y, α,β,(SuperPlus[i])])+(1-(T^s))(Subscript[g, 3,α,i])(Subscript[g, 1,(SuperPlus[j]),β]),
(Subscript[y, α_,β_,j]):>(Subscript[y, α,β,(SuperPlus[j])])-(1-(S^s))(Subscript[y, α,β,i])-(Subscript[g, 3,α,i])((T^s)((S^s)-1)(Subscript[g, 1,(SuperPlus[i]),β])+((S^s)+(T^s)-2 (TS^s))(Subscript[g, 1,β,(SuperPlus[j])]))
}

(ys=Table[(Subscript[y, α,β,γ]),{α,2n+1},{β,2n+1},{γ,2n+1}])[[1;;2,1;;2,1;;2]]

Cs

(ys/.(Subscript[yRules, Sequence@@Cs[[1]]]))[[1;;2,1;;2,1;;2]]

yEval[ys-(ys/.(Subscript[yRules, Sequence@@Cs[[1]]]))][[1,1,1]]

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

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]}]⋃{(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]}]];

(Subscript[R, 1])[-1,(SuperPlus[i]),7]

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]

covars=Cases[eqn,(Subscript[g, ___]),∞]⋃Cases[eqn,c_.*(g1:(Subscript[g, _,_,_]))(g2:(Subscript[g, _,_,_])):>g1 g2,∞]⋃Cases[eqn,(Subscript[g, __]^2),∞]⋃Cases[eqn,(Subscript[y, __]),∞]

Short[eqns={eqn==0}⋃Union@Table[Coefficient[eqn,cv]==0,{cv,covars}]/.{(Subscript[(g|y), _,_,_])->0},5]

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

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

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

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

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

Short[
covars=Cases[eqn,c_.*(g1:(Subscript[g, _,_,_]))(g2:(Subscript[g, _,_,_])):>g1 g2,∞]⋃Cases[eqn,(Subscript[g, __]^2),∞]⋃Cases[eqn,(Subscript[y, __]),∞],
5]

Short[eqns={eqn==0}⋃Union@Table[Coefficient[eqn,cv]==0,{cv,covars}]/.{(Subscript[(g|y), _,_,_])->0},5]

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

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

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

Simplify[(Subscript[R, 1])[1,i,j]/. {(Subscript[c, 155])->0,(Subscript[c, 189])->0,(Subscript[c, 175])->0,(Subscript[c, 178])->0,(Subscript[c, 166])->0,(Subscript[c, 145])->0}]

The most general no-mixed-terms solution:

Simplify[{(Subscript[R, 1])[-1,i,j],(Subscript[R, 1])[1,i,j]}/. {(Subscript[c, 118|129|148|152|167|171])->0}]

The most general no-mixed-terms quadratic-only solution:

Simplify[{(Subscript[R, 1])[-1,i,j],(Subscript[R, 1])[1,i,j]}/. {(Subscript[c, 1|101|103|106|110|115|118|121|128|129|136|145|148|152|155|166|167|171|178])->0}]

The most general quadratic-only solution: (has mixed terms!)

Simplify[{(Subscript[R, 1])[-1,i,j],(Subscript[R, 1])[1,i,j]}/. {(Subscript[c, 1|101|103|106|110|115|121|128|136|145|155|166|178])->0}]

The most general no-(Subscript[g, 3,_,_]) solution: (has mixed terms)

Simplify[{(Subscript[R, 1])[-1,i,j],(Subscript[R, 1])[1,i,j]}/. {(Subscript[c, 145|148|152|155|166|167|171|175|178|189])->0}]