(* ::Package:: *)

(* ::Text:: *)
(*Pensieve header: January 13: Computing the Jones polynomial, cleaner procedure.*)


(* ::Input:: *)
(*Knot=Xm[1,12,2,13]Xm[7,2,8,3]Xm[3,8,4,9]Xm[11,4,12,5]Xp[13,7,14,6]Xp[9,15,10,14]Xp[15,11,16,10]Xp[5,1,6,16]*)


SetAttributes[P, Orderless];
Jones[Knot_] := Module[{t1,t2},
t1=Expand[Knot /. {
Xp[i_,j_,k_,l_] :> q*P[i,j]P[k,l]-q^2*P[i,l]P[j,k],
Xm[i_,j_,k_,l_] :> -q^(-2)*P[i,j]P[k,l]+1/q*P[i,l]P[j,k]
}];
t2=t1 //. P[a_,b_]P[b_,c_] :> P[a,c];
Simplify[t2 /. {P[i_,i_] :> (q+1/q), P[i_,j_]^2 :> (q+1/q)}]
]


(* ::Input:: *)
(*Jones[Knot]*)
