SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\APerturbedAlexanderInvariant"];
<< APAI.m

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

Proof of Reidemeister 3:

Join[(Subscript[gRules, 1,j,k]),(Subscript[gRules, 1,i,k+1]),(Subscript[gRules, 1,i+1,j+1])] // Column

Join[(Subscript[gRules, 1,20,30]),(Subscript[gRules, 1,10,31]),(Subscript[gRules, 1,11,21])] // Column

Eliminate[Join[(Subscript[gRules, 1,j,k]),(Subscript[gRules, 1,i,k+1]),(Subscript[gRules, 1,i+1,j+1])],{(Subscript[g, i+1,β]),(Subscript[g, j+1,β]),(Subscript[g, k+1,β])}]

(Subscript[gRules, 1,10,20])⋃(Subscript[gRules, 1,11,30])⋃(Subscript[gRules, 1,21,31])// Column

Eliminate[(Subscript[gRules, 1,10,20])⋃(Subscript[gRules, 1,11,30])⋃(Subscript[gRules, 1,21,31]),{(Subscript[g, 11,β]),(Subscript[g, 21,β]),(Subscript[g, 31,β])}]

lhs=(Subscript[R, 1])[1,20,30]+(Subscript[R, 1])[1,10,31]+(Subscript[R, 1])[1,11,21]//.(Subscript[gRules, 1,20,30])⋃(Subscript[gRules, 1,10,31])⋃(Subscript[gRules, 1,11,21]);
rhs=(Subscript[R, 1])[1,10,20]+(Subscript[R, 1])[1,11,30]+(Subscript[R, 1])[1,21,31]//.(Subscript[gRules, 1,10,20])⋃(Subscript[gRules, 1,11,30])⋃(Subscript[gRules, 1,21,31]);
Simplify[lhs==rhs]

Next comes Reid1, where we use results from an earlier example:

(({{1, (T^(-1)), 1}, {0, (T^(-1)), 1}, {0, 0, 1}}))//Inverse//MatrixForm

(Subscript[R, 1])[1,2,1]-1((Subscript[g, 2,2])-1/2) /. (Subscript[g, α_,β_]):>(({{1, (T^(-1)), 1}, {0, (T^(-1)), 1}, {0, 0, 1}}))[[α,β]]

Invariance under the other moves is proven similarly.

Alternative (Subscript[R, 1])’s:

Simplify[(Subscript[R, 1])[s,i,j]==s((1-(T^s))(Subscript[g, j,i])((Subscript[g, j,i])-(Subscript[g, i,i]))+2(Subscript[g, j,j])(Subscript[g, j,i])-(Subscript[g, j,i])(Subscript[g, i,j])-(Subscript[g, j,j])(Subscript[g, i,i])-(Subscript[g, j,i])+(Subscript[g, i,i])-1/2)//.(Subscript[gRules, s,i,j])]

Simplify[(Subscript[R, 1])[s,i,j]==s(((Subscript[g, j,j+1])-(Subscript[g, j,j]))((Subscript[g, j,i])-(Subscript[g, i,i]))+2(Subscript[g, j,j])(Subscript[g, j,i])-(Subscript[g, j,i])(Subscript[g, i,j])-(Subscript[g, j,j])(Subscript[g, i,i])-(Subscript[g, j,i])+(Subscript[g, i,i])-1/2)//.(Subscript[gRules, s,i,j])]

Simplify[(Subscript[R, 1])[s,i,j]==s((Subscript[g, j,i]) (-1-(Subscript[g, i,j])+(Subscript[g, j,j])+(Subscript[g, j,1+j]))-(Subscript[g, i,i]) (-1+(Subscript[g, j,1+j]))-1/2)//.(Subscript[gRules, s,i,j])]

Simplify[(Subscript[R, 1])[s,i,j]==s((Subscript[g, j,i]) ((Subscript[g, j,j])+(Subscript[g, j,j+1])-(Subscript[g, i,j])-1)-(Subscript[g, i,i]) ((Subscript[g, j,j+1])-1)-1/2)//.(Subscript[gRules, s,i,j])]

Simplify[(Subscript[R, 1])[s,i,j]==s((Subscript[g, j,i]) ((Subscript[g, j+1,j])+(Subscript[g, j,j+1])-(Subscript[g, i,j]))-(Subscript[g, i,i]) ((Subscript[g, j,j+1])-1)-1/2)//.(Subscript[gRules, s,i,j])]

Simplify[((Subscript[g, j,i]) ((Subscript[g, j+1,j])+(Subscript[g, j,j+1])-(Subscript[g, i,j]))-(Subscript[g, i,i]) ((Subscript[g, j,j+1])-1)-1/2)]

Simplify[{(Subscript[g, j,j]),(Subscript[g, j,j+1]),(Subscript[g, i,j]),(Subscript[g, j+1,j])+(Subscript[g, j,j+1])}//.(Subscript[gRules, s,i,j])]