Pensieve header: APAI for links, using the adjugate matrix (by Roland).

APAI for links, adj version.

Once[<<KnotTheory`]

A version of Dror’s Rot program that computes the rotation numbers from PD code of a link (the component containing edge 1 is assumed to be opened)
The output is a list of crossings each written as {sign,i,j,(SuperPlus[i]),(SuperPlus[j])} and a list of rotation numbers for the edges. There are 2cr+1 edges where cr is the number of crossings.

NextHead[fr_]:=Min[Select[fr,(Abs[#]>1&&IntegerQ[#])&]]
FindNextCross[todo_,Nh_]:=First@Select[todo,If[PositiveQ[#],#[[1]]==Nh||#[[4]]==Nh,#[[1]]==Nh||#[[2]]==Nh]&]
Bend[X[a_,b_,c_,d_],h_]:=If[PositiveQ[X[a,b,c,d]],If[h==a,{I d,c,b},{c,b,-I a}],If[h==a,{d,c,-I b},{ I a,d,c}]]
CheckCap[fr_,rots_]:=Module[{i,newrots=rots, newfront=fr},
Do[If[Abs[fr[[i]]]===Abs[fr[[i+1]]],
If[IntegerQ[fr[[i]]],newrots[[Abs[fr[[i]]]]]=(-I+fr[[i+1]]/fr[[i]])/(2I),newrots[[Abs[fr[[i]]]]]=(I+fr[[i]]/fr[[i+1]])/(2I)];
newfront = Delete[newfront,{{i},{i+1}}];Break[];
],{i,Length[fr]-1}];
Return[{newfront,newrots}]
]
RotLink[pd_]:=Module[{safety=0,front={1},Nh=1,rots=ConstantArray[0,2Length[pd]+1]},
While[safety<1000&&!(front==={1}&&Nh!=1),
safety++;
If[Length[SequenceCases[Abs/@front,{a_,a_}]]>0,
{front,rots} = CheckCap[front,rots];,
front=Flatten[front/. Nh->Bend[FindNextCross[pd,Nh],Nh]]
];
Nh=NextHead[front];
];
Return[{Cases[List@@pd,X[a_,b_,c_,d_]->If[PositiveQ[X[a,b,c,d]],{1,d,a,b,c},{-1,b,a,d,c}]]/.{{s_,k_,l_,1,m_}:>{s,k,l,2Length[pd]+1,m},{s_,k_,l_,m_,1}:>{s,k,l,m,2Length[pd]+1}},rots}];
]

A slight modification of the usual APAI program to compute for rotational link diagrams.

adj[m_]:=Map[Reverse,Minors[Transpose[m],Length[m]-1],{0,1}]Table[(-1)^(i+j),{i,Length[m]},{j,Length[m]}]

ρ[Cs_,φ_]:=Module[{n,A,s,i,j,k,Δ,G,ρ1},
(Subscript[R, 1])[s_,i_,j_,ip_,jp_]:=s((Subscript[g, j,i])((Subscript[g, jp,j])+(Subscript[g, j,jp])-(Subscript[g, i,j]))-(Subscript[g, i,i])((Subscript[g, j,jp])-Δ 1)-(Δ^2)1/2);
 n=Length[Cs];
A=IdentityMatrix[2n+1];
Cases[Cs,{s_,i_,j_,ip_,jp_}:>(A[[{i,j},{ip,jp}]]+=(({{-(T^s), (T^s)-1}, {0, -1}})))];
Δ=(T^((-Total[φ]-Total[Cs[[All,1]]])/2))Det[A];
G=(T^((-Total[φ]-Total[Cs[[All,1]]])/2)) adj[A];
ρ1=(∑_(k=1)^n)(Subscript[R, 1])@@Cs[[k]] -Δ (∑_(k=1)^(2n))φ[[k]]((Subscript[g, k,k])-Δ 1/2);
Factor@Expand@Factor@{Δ,ρ1/.(SuperPlus[α_]):>α+1/.(Subscript[g, α_,β_]):>G[[α,β]]}];
ρLink[L_]:={L,ρ@@RotLink[PD[L]]}

ρLink/@AllKnots[{3,5}]//Column

ρLink/@AllLinks[{2,10}]//Column

ρLink/@AllLinks[{11,11}]//Column

MVA0=Select[AllLinks[],(MultivariableAlexander[#][t]==0)&]

ρLink/@MVA0

It remains to verify that this version of ρ does not depend on the component that was opened up.
Here are some preliminary tests suggesting that this is indeed the case:

(*Test trefoil*)
ρ[{{1,1,4,2,5},{1,5,2,6,3},{1,3,6,4,7}},{0,0,0,-1,0,0,0}]

(*Hopf link opened up in two ways*)
ρ[{{1,1,4,2,3},{1,3,2,4,5}},{0,0,0,-1,0}]//Expand
ρ[{{1,4,1,5,2},{1,2,5,3,4}},{0,0,0,1,0}]//Expand

(*(Subscript[L, 4,1]) opened up in two ways, and its mirror image?!*)
ρ[{{1,1,6,2,7},{1,7,2,8,3},{1,3,8,4,9},{1,9,4,6,5}},{0,0,0,0,0,-1,0,0,0}]//Expand
ρ[{{1,6,1,7,2},{1,2,7,3,8},{1,8,3,9,4},{1,4,9,5,6}},{0,0,0,0,0,1,0,0,0}]//Expand
ρ@@RotLink[PD[Link[4,Alternating,1]]]//Expand

ρ[{{1,3,10,4,11},{-1,9,6,10,7},{1,5,2,6,3},{1,11,4,8,5},{-1,1,8,2,9}},{0,0,0,1,0,0,0,0,0,0,-1}]//Expand