Pensieve header: January 11: Computing the Jones polynomial, rough procedure.

t1=Xp[1,5,2,4]Xp[5,3,6,2]Xp[3,1,4,6]

t1

t2=t1 /. Xp[i_,j_,k_,l_] :> q*P[i,j]P[k,l]-q^2*P[i,l]P[j,k]

t3=Expand[t2]

t4=t3 //. P[a_,b_]P[b_,c_] :> P[a,c]

t5=t4 /. {P[i_,i_] :> (q+1/q), P[i_,j_]^2 :> (q+1/q)}

Simplify[t5]

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

t2=t1 /. {
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]
}

t3=Expand[t2]

SetAttributes[P, Orderless]

Short[t4=t3 //. P[a_,b_]P[b_,c_] :> P[a,c], 15]

t5=t4 /. {P[i_,i_] :> (q+1/q), P[i_,j_]^2 :> (q+1/q)}

Simplify[t5]

1+1