Pensieve header: Mathematica notebook for A Perturbed Alexander Invariant.

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\APAI"];

Once[<<KnotTheory`; <<Rot.m];

(Subscript[R, 1])[s_,i_,j_]:=s((Subscript[g, j,i])((Subscript[g, (SuperPlus[j]),j])+(Subscript[g, j,(SuperPlus[j])])-(Subscript[g, i,j]))-(Subscript[g, i,i])((Subscript[g, j,(SuperPlus[j])])-1)-1/2);
ρ[K_]:=ρ[K]=Module[{Cs,φ,n,A,s,i,j,k,Δ,G,ρ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];
ρ1=(∑_(k=1)^n)(Subscript[R, 1])@@Cs[[k]] - (∑_(k=1)^(2n))φ[[k]]((Subscript[g, k,k])-1/2);
Factor@{Δ,(Δ^2)ρ1/.(SuperPlus[α_]):>α+1/.(Subscript[g, α_,β_]):>G[[α,β]]}];

The g-Rules

(Subscript[δ, i_,j_]):=If[i===j,1,0];
(Subscript[gRules, s_,i_,j_]):={(Subscript[g, i,β_]):>(Subscript[δ, i,β])+(Subscript[T, j]^s)(Subscript[g, (SuperPlus[i]),β])+(1-(Subscript[T, j]^s))(Subscript[g, (SuperPlus[j]),β]),(Subscript[g, j,β_]):>(Subscript[δ, j,β])+(Subscript[g, (SuperPlus[j]),β]),
(Subscript[g, α_,i]):>(Subscript[T, j]^(-s))((Subscript[g, α,(SuperPlus[i])])-(Subscript[δ, α,(SuperPlus[i])])),(Subscript[g, α_,j]):>(Subscript[g, α,(SuperPlus[j])])-(1-(Subscript[T, j]^s))(Subscript[g, α,i])-(Subscript[δ, α,(SuperPlus[j])])}
(SuperPlus[((SuperPlus[α_]))]):=(α^("++"));    (* this is for cosmetic reasons only *)

Invariance Under R3

lhs=Simplify[(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[T, (SuperPlus[α_])])->(Subscript[T, α])]
rhs=Simplify[(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[T, (SuperPlus[α_])])->(Subscript[T, α])]
Simplify[lhs==rhs]

Invariance Under R2c

Simplify[(Subscript[R, 1])[-1,i,(SuperPlus[j])]+(Subscript[R, 1])[1,(SuperPlus[i]),j]-((Subscript[g, (SuperPlus[j]),(SuperPlus[j])])-1/2)]
lhs=Simplify[(Subscript[R, 1])[-1,i,(SuperPlus[j])]+(Subscript[R, 1])[1,(SuperPlus[i]),j]-((Subscript[g, (SuperPlus[j]),(SuperPlus[j])])-1/2)//.(Subscript[gRules, -1,i,(SuperPlus[j])])⋃(Subscript[gRules, 1,(SuperPlus[i]),j])/.(Subscript[T, (SuperPlus[α_])])->(Subscript[T, α])]

Invariance Under R1l

lhs1=(Subscript[R, 1])[1,(SuperPlus[i]),i]-((Subscript[g, (SuperPlus[i]),(SuperPlus[i])])-1/2)
lhs2=lhs1//.{(Subscript[g, (SuperPlus[i]),β_]):>(T^(-1))(Subscript[δ, (SuperPlus[i]),β])+(Subscript[g, (SuperPlus[(SuperPlus[i])]),β]),(Subscript[g, i,β_]):>(Subscript[δ, i,β])+(Subscript[g, (SuperPlus[i]),β])}
Simplify[lhs2]

R1r, R2b, and (SuperPlus[Sw]).

Simplify[(Subscript[R, 1])[1,i,(SuperPlus[i])]+((Subscript[g, (SuperPlus[i]),(SuperPlus[i])])-1/2)//.{      (* R1r *)
(Subscript[g, i,β_]):>(Subscript[δ, i,β])+T (Subscript[g, (SuperPlus[i]),β])+(1-T)(Subscript[g, (SuperPlus[(SuperPlus[i])]),β]),(Subscript[g, (SuperPlus[i]),β_]):>(Subscript[δ, (SuperPlus[i]),β])+(Subscript[g, (SuperPlus[(SuperPlus[i])]),β]),
(Subscript[g, α_,i]):>(T^(-1))((Subscript[g, α,(SuperPlus[i])])-(Subscript[δ, α,(SuperPlus[i])])),(Subscript[g, α_,(SuperPlus[i])]):>T (Subscript[g, α,(SuperPlus[(SuperPlus[i])])])-(1-T)(Subscript[δ, α,(SuperPlus[i])])-T (Subscript[δ, α,(SuperPlus[(SuperPlus[i])])]) }]

Simplify[(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[T, (SuperPlus[α_])])->(Subscript[T, α])]  (* R2b *)

((Subscript[g, i,i])-1/2)+((Subscript[g, j,j])-1/2)-((Subscript[g, (SuperPlus[i]),(SuperPlus[i])])-1/2)-((Subscript[g, (SuperPlus[j]),(SuperPlus[j])])-1/2)//.(Subscript[gRules, 1,i,j])  (* (SuperPlus[Sw]) *)