Pensieve Header: A very simple Kauffman-bracket program, written in-class during my summer class on <a href=http://www.math.toronto.edu/~drorbn/classes/0910/Homology>Homology</a>, Accra, Ghana, June 2010.

<< KnotTheory`

K1=PD[Knot[8,17]]

K=PD[X[6,4,1,3], X[4,2,5,1], X[2,6,3,5]]

SetAttributes[p, Orderless];
KB[K_] := (
t1=K /. X[i_, j_, k_, l_] :>  A p[i,j]p[k,l] + B p[j,k]p[l,i];
t2=Expand[Times@@t1];
t3= t2 //. {
p[i_,j_]p[j_,k_] :> p[i,k],
p[i_,j_]^2 :> p[i,i]
};
t4=t3 /. p[i_,i_] :> d;
t5=Expand[t4/. {B-> 1/A, d-> -A^2-1/A^2}]
)

KB[K]

KB[PD[X[3,6,4,1], X[1,4,2,5], X[5,2,6,3]]]

Simplify[
KB[K]/KB[PD[X[3,6,4,1], X[1,4,2,5], X[5,2,6,3]]]
]

KB[PD[X[2,4,3,1],X[3,4,6,5]]]

KB[K1]

Short[t3, 5]

Jones[Knot[8,17]][q]

Simplify[KB[K1]/(-A^2-1/A^2)]

all=Jones[#][q]& /@ AllKnots[]

Length[Union[all]]

Length[AllKnots[]]

all37=KB /@ PD /@ AllKnots[{3,7}]

all37 /. A-> -1

all37 /. A-> E^(Pi I/3)

Simplify[all37 /. A-> E^(Pi I/3)]