SetDirectory["C:\\drorbn\\AcademicPensieve\\2012-05"];
<< KnotTheory`
<< bbCalculus.m

b=Rp[2,3]**Rp[1,3]**Rp[1,2]**Rm[2,1]**Rp[3,2]

CT1[B[ω_, σ_, μ_]] := Simplify[ω(σ - Total[h /@ hL[σ]])== (μ /. _t -> 1)]

CT1[b]

CT2[B[ω_, _, μ_]] := Module[
{μ1, tails, heads, mat},
μ1 = μ /. (Subscript[T, _])->T;
{tails, heads} = {tL[μ1], hL[μ1]};
If[Length[tails]<2 || Length[heads]<2, True,
mat = Outer[((∂_(t[#1],h[#2]))μ1)&, tL[μ1], hL[μ1]];
And @@ ((1==Denominator[Factor[(T^1000)#/ω]])& /@ Flatten[Minors[mat, 2]])
]
]

CT2[b]

BB@@b /. (Subscript[T, _])->T

CT2[
B[T-2,((h[1])/T)+(T^2) h[2]+(T^2) h[3],h[1] ((-1+(1/T)) T t[2]+(1-(1/T)) (-1+T) t[3])+h[2] ((((-1+T) t[1])/T)+(-1+(1/T)) (1-T) T t[2]+(((-1+T) (-1+2 T) t[3])/T))+h[3] ((((-1+T) t[1])/T)+(-1+T) (-1+T (1+T)) t[2]+(((1-T) (-1+T) (-1+T (1+T)) t[3])/T))]
]

CT[b_B] := CT1[b]&&CT2[b]

CT[
B[T-2,((h[1])/T)+(T^2) h[2]+(T^2) h[3],h[1] ((-1+(1/T)) T t[2]+(1-(1/T)) (-1+T) t[3])+h[2] ((((-1+T) t[1])/T)+(-1+(1/T)) (1-T) T t[2]+(((-1+T) (-1+2 T) t[3])/T))+h[3] ((((-1+T) t[1])/T)+(-1+T) (-1+T (1+T)) t[2]+(((1-T) (-1+T) (-1+T (1+T)) t[3])/T))]
]

CT[b]

Test[K_] := Module[
{b,ok},
b=Times@@(PD[K] /.
X[i_,j_,k_,l_] :> If[PositiveQ[X[i,j,k,l]], Rp[l,i], Rm[j,i]]);
b = b /. (Subscript[T, _])->T;
ok=CT2[b];
Do[b=dm[1,k,1][b]; ok=ok&&CT2[b], {k,2,2Crossings[K]}];
{ok,b[[1]], Alexander[K][T]}
]

Test[Knot[10,165]]

(# -> Test[#][[1]])& /@ AllKnots[7]

Analyze[K_] := Module[
{b,ok},
b=Times@@(PD[K] /.
X[i_,j_,k_,l_] :> If[PositiveQ[X[i,j,k,l]], Rp[l,i], Rm[j,i]]);
b = b /. (Subscript[T, _])->T;
ok=CT2[b];
Do[
b=dm[1,k,1][b];
ok=ok&&CT2[b];
Print[{k, b, ok}],
{k,2,2Crossings[K]}];
{ok,b[[1]], Alexander[K][T]}
]

False && Analyze[Knot[7,7]]

bbSimplify=Expand[Factor[#]]&; n=10;
b=Product[If[Random[]<1, Rp[i,i], Rm[i,i]], {i, n}];
b = b /. (Subscript[T, _])->T;
ts=hs=Range[n];
Print[β[k=0]=b];
While[CT2[b] && Length[ts]+Length[hs]>2,
i= ts[[ RandomInteger[{1,Length[ts]}] ]];
j= hs[[ RandomInteger[{1,Length[hs]}] ]];
r=Random[];
Which[
(r-=0.6)<0, (
Print[{++k,{ts, hs},"swapth", {i,j}}];
Print[β[k]=b= b // swapth[i,j]]
),
(r-=0.2)<0, (
j= ts[[ RandomInteger[{1,Length[ts]}] ]];
If[i≠j,
Print[{++k,{ts, hs},"tm", {i,j,i}}];
Print[β[k]=b= b // tm[i,j,i]];
ts=DeleteCases[ts,j]
]
),
True, (
i= hs[[ RandomInteger[{1,Length[hs]}] ]];
If[i≠j,
Print[{++k,{ts, hs},"hm", {i,j,i}}];
Print[β[k]=b= b // hm[i,j,i]];
hs=DeleteCases[hs,j]
]
)
]
];
{CT2[b], b}

Det[(({{((2-4 T+(T^2)-3 (T^3)+15 (T^4)-13 (T^5)-9 (T^6)+15 (T^7)-4 (T^9)-4 (T^10)+6 (T^11)-2 (T^12))/(T^7)), ((-2+4 T-(T^2)+3 (T^3)-15 (T^4)+13 (T^5)+9 (T^6)-15 (T^7)+4 (T^9)+4 (T^10)-6 (T^11)+2 (T^12))/(T^8))}, {T-1, (1/T)-1}}))]

(({{((-1+2 T-2 (T^3)+(T^4)+(T^5))/(T^6)), h[3], h[5], h[9]}, {t[1], (((((-1+T))^2) (1+T) (1-T+(T^3)))/(T^6)), ((-1+2 T-2 (T^3)+(T^4)+(T^5)-2 (T^7)+(T^8))/(T^6)), ((1-T-3 (T^2)+5 (T^3)-4 (T^5)+(T^6)+(T^7))/(T^6))}, {t[2], (((((-1+T))^2) (1+T) (1-T+(T^3)))/(T^7)), -((1-4 T+5 (T^2)-3 (T^4)+(T^6)-(T^8)+(T^9))/(T^7)), -(((1-T+(T^3)) (-1+T+2 (T^2)-3 (T^3)+(T^5)))/(T^7))}, {t[5], -(((((-1+T))^2) (1-T+(T^3)))/(T^7)), (((-1+T) (-1+T+(T^3)) (1-T+(T^4)))/(T^7)), -(((((-1+T))^2) (1-T+(T^3)))/(T^7))}, {t[6], 0, -((1-2 T+(T^3))/(T^9)), 0}, {t[8], 0, 0, (((-1+T) (-1+2 T-2 (T^3)+(T^4)+(T^5)))/(T^5))}, {t[10], (((-1+T) (1-T+(T^3)))/(T^6)), ((-1+3 T-2 (T^2)+(T^3)-2 (T^4)+(T^5))/(T^5)), (((-1+T) (1-T+(T^3)))/(T^6))}, {"1+Σ/ω", T, (1/(T^3)), (T^2)}}))

Det[(({{((-1+3 T-2 (T^2)+(T^3)-2 (T^4)+(T^5))/(T^5)), (((-1+T) (1-T+(T^3)))/(T^6))}, {(1/(T^3))-1, (T^2)-1}}))]//Factor

((-1+2 T-2 (T^3)+(T^4)+(T^5))/(T^6))//Factor

β[14]

renmin[B[ω_, _, μ_], {i1_,i2_}, {j1_,j2_}] := bbSimplify[(1/ω)Det[(({{(∂_(t[i1],h[j1]))μ, (∂_(t[i1],h[j2]))μ}, {(∂_(t[i2],h[j1]))μ, (∂_(t[i2],h[j2]))μ}}))]]

renmin[β[14], {9,10},{1,2}]

renmin[β[14], {8,10},{1,2}]

renmin[β[14], {7,10},{1,2}]

renmin[β[14], {7,10},{1,3}]

Collect[β[14][[3]]/β[14][[1]] /. _h ->1, _t, Factor]