Pensieve header: Roland checking Joe Boninger’s conjecture that for a closure of a positive braid the coefficients of $\rho_1$ are all positive. Continued pensieve://Talks/Oaxaca-2210/Rho_d-Positivity.nb.

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\APAI"];
Once[<<KnotTheory`; <<Rot.m];

(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);
ρ[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/.(Subscript[g, α_,β_]):>G[[α,β]]}];

Mat[u_]:=Transpose@Table[Prepend[Table[Coefficient[((((x^(1/2))-(x^(-1/2))))^(2j))//Expand,(x^k)],{k,1,u}],(Expand[((((x^(1/2))-(x^(-1/2))))^(2j))]/.{(x^(a_Integer)):>0,x->0})],{j,0,u}]
ToConway[P_]:=If[P===0,0,Module[{CC,deg=Exponent[P,T],M},M=Inverse[Mat[deg]];
CC=Expand[P]/.{(T^(j_)):>
If[j<0,0,(T^j)]};
Total[CoefficientRules[CC,T]]/.{({a_}->b_):>b  M[[;;,a+1]].Table[(z^(2i)),{i,0,deg}]}//Expand
]]

ToConway[7+3/(T^2)+3(T^2)-101(T^4)-101/(T^4)]
%/.{z->(x^(1/2))-(x^(-1/2))}//Expand

(Subscript[Cρ, 1])[K_]:=ToConway[Expand@Together[ρ[K][[2]](-T)/(((-1+T))^2)]]
(Subscript[Cρ, 0])[K_]:=ToConway[Expand@Together[ρ[K][[1]]]]
CheckForConstantSigns[P_]:=If[Length@Union[Sign/@(MonomialList[P,z]/.z->1)]==1,True,False]
(Subscript[PosKnots, i_])[n_]:=Table[If[CheckForConstantSigns[(Subscript[Cρ, i])[K]],K,Nothing],{K,AllKnots[{3,n}]}]

(Subscript[PosKnots, 1])[10];

(Subscript[PosKnots, 0])[10];

(*False Alexander positives detected by (Subscript[ρ, 1]), i.e. knots that are not positive braid closures where the Alex is positive.*)
Complement[(Subscript[PosKnots, 0])[10],(Subscript[PosKnots, 1])[10]]

{(Subscript[Cρ, 1])[#],(Subscript[Cρ, 0])[#]}&@Knot[9,41]

(*Copied from KnotInfo*)
PosBraidKnots={Knot[3,1],Knot[5,1],Knot[7,1],Knot[8,19],Knot[9,1],Knot[10,124],Knot[10,139],Knot[10,152],Knot[11,Alternating,367],Knot[11,NonAlternating,77],Knot[12,NonAlternating,242],Knot[12,NonAlternating,472],Knot[12,NonAlternating,574],Knot[12,NonAlternating,679],Knot[12,NonAlternating,688],Knot[12,NonAlternating,725],Knot[12,NonAlternating,888]};

(*Checking Boninger's conjecture up to 12 crossings*)
CheckForConstantSigns[(Subscript[Cρ, 1])[#]]&/@PosBraidKnots