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]]

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

bbSimplify=Expand[Factor[#]]&; n=10;
b=Product[If[Random[]<1/2, Rp[i,i], Rm[i,i]], {i, n}];
b = b /. (Subscript[T, _])->T;
ts=hs=Range[n];
Print[β[k=0]=b];
While[CT3[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}

{ω, σ, μ}=List @@ β[25]

{tails, heads} = {tL[μ], hL[μ]};
(mat = Outer[((∂_(t[#1],h[#2]))μ)&, tL[μ], hL[μ]]) // MatrixForm

Expand[Simplify[Flatten[Minors[mat,3]]/(ω^2)]]

Expand[Simplify[Flatten[Minors[mat,4]]/(ω^3)]]

Expand[Simplify[Flatten[Minors[mat,5]]/(ω^4)]]