Pensieve Header: A very short implementation of the Arrow Polynomial.

https://drorbn.net/bbs/show?shot=SantosK-250717-132117.jpg :

<< KnotTheory`

pd=PD[Knot[3,1]]

pd/.x:X[i_,j_,k_,l_]:>If[PositiveQ[x],
A (Subscript[P, 0])[i,j](Subscript[P, 0])[l,k]+(A^(-1))(Subscript[P, 1])[l,i](Subscript[P, -1])[j,k],
(A^(-1))(Subscript[P, 0])[i,l](Subscript[P, 0])[j,k]+A (Subscript[P, 1])[i,j](Subscript[P, -1])[k,l]
]

Expand[Times@@pd/.x:X[i_,j_,k_,l_]:>If[PositiveQ[x],
A (Subscript[P, 0])[i,j](Subscript[P, 0])[l,k]+(A^(-1))(Subscript[P, 1])[l,i](Subscript[P, -1])[j,k],
(A^(-1))(Subscript[P, 0])[i,l](Subscript[P, 0])[j,k]+A (Subscript[P, 1])[i,j](Subscript[P, -1])[k,l]
]]

Expand[Times@@pd/.x:X[i_,j_,k_,l_]:>If[PositiveQ[x],
A (Subscript[P, 0])[i,j](Subscript[P, 0])[l,k]+(A^(-1))(Subscript[P, 1])[l,i](Subscript[P, -1])[j,k],
(A^(-1))(Subscript[P, 0])[i,l](Subscript[P, 0])[j,k]+A (Subscript[P, 1])[i,j](Subscript[P, -1])[k,l]
]]//. {
(Subscript[P, α_])[i_,j_](Subscript[P, β_])[j_,k_]:>(Subscript[P, α+β])[i,k],
(Subscript[P, α_])[i_,j_](Subscript[P, β_])[k_,j_]:>(Subscript[P, α-β])[i,k],
(Subscript[P, α_])[j_,i_](Subscript[P, β_])[j_,k_]:>(Subscript[P, -α+β])[i,k]
}

AP[K_]:=Module[{t},
t=Expand[Times@@PD[K]/.x:X[i_,j_,k_,l_]:>If[PositiveQ[x],
A (Subscript[P, 0])[i,j](Subscript[P, 0])[l,k]+(A^(-1))(Subscript[P, 1])[l,i](Subscript[P, -1])[j,k],(A^(-1))(Subscript[P, 0])[i,l](Subscript[P, 0])[j,k]+A (Subscript[P, 1])[i,j](Subscript[P, -1])[k,l]
]]//. {
(Subscript[P, α_])[i_,j_](Subscript[P, β_])[j_,k_]:>(Subscript[P, α+β])[i,k],(Subscript[P, α_])[i_,j_](Subscript[P, β_])[k_,j_]:>(Subscript[P, α-β])[i,k],(Subscript[P, α_])[j_,i_](Subscript[P, β_])[j_,k_]:>(Subscript[P, -α+β])[i,k]
} /. {
(Subscript[P, α_])[k_,k_]:>(-(A^2)-(A^(-2)))(Subscript[V, Abs@α/2]), (((Subscript[P, _])[_,_])^2)->(-(A^2)-(A^(-2)))(Subscript[V, 0])
}/.{(Subscript[V, 0])->1, (Subscript[P, α_])[i_,j_]/;i>j:>(Subscript[P, -α])[j,i]};
Factor[t/(-(A^2)-(A^(-2)))]
]

AP[Knot[3,1]]

AP[PD[X[2,4,3,1],X[3,1,4,2]]]

AP@PD[X[2,6,3,1],X[4,1,5,2],X[5,4,6,3]]

AP@PD[X[5,3,6,2],X[6,1,7,2]]

AP@PD[X[5,2,6,3],X[6,2,7,1]]

lhs=AP@PD[X[9,6,10,5],X[10,2,11,1],X[6,3,7,2]]

rhs=AP@PD[X[5,2,6,1],X[9,3,10,2],X[10,7,11,6]]

lhs==rhs