This is a program to compute the colored Alexander polynomial following Ohtsuki. In what follows, n is the dimension of the representation (color), q = exp(2 π (Sqrt[-1])/n) , and λ is a complex parameter.

First we define the quantum integer [n], note that by definition [0]=1

quantum[n_]:=If[n=== 0,1,(((q^(n/2))-(q^(-(n/2))))/((q^(1/2))-(q^(-(1/2)))))
];

And the quantum factorial

qfact[n_]:=Product[quantum[i],{i,0,n}];

Next we define the action of E, here m is the power of E, k is the basis vector and n is the dimension of the representation

EE[m_,k_,n_]:=Product[quantum[n-k+i+λ],{i,1,m}];

Now the action of F

FF[m_,k_,n_]:=Product[quantum[k+i],{i,0,m-1}];

Now the action of the R matrix

Rp[i_,j_,k_,l_,n_]:=
Which[i+j≠k+l,0,i<l,0,True,
(m=i-l;
If[m>Min[k-1,n-l,n-1],0,(q^((((n-1)(n-1+λ))/2)-((((n-1+λ))^2)/4)+(((n-2k+2m+1+λ)(n-2l-2m+1+λ))/4)))((q^((m(m-1))/4))/(qfact[m]))((((q^(1/2))-(q^(-(1/2)))))^m)FF[m,l,n]EE[m,k,n]])
];

We also write the matrix form of Rp for our convenience

RpMatrix[n_]:= Apply[Rp,Flatten[Table[Flatten[Table[{i,j,k,l,n},{k,1,n},{l,1,n}],1],{i,1,n},{j,1,n}],1],{2}]//Simplify

Now the action of negative R matrix

Rm[i_,j_,k_,l_,n_]:=
Which[i+j≠k+l,0,i>l,0,True,
(m=l-i;
If[m>Min[l-1,n-k,n-1],0,(q^(-(((n-1)(n-1+λ))/2)+((((n-1+λ))^2)/4)-(((n-2k+1+λ)(n-2l+1+λ))/4)))((q^(-((m(m-1))/4)))/(qfact[m]))((((q^(-(1/2)))-(q^(1/2))))^m)EE[m,l,n]FF[m,k,n]])
];

And the matrix form of Rm for our convenience

RmMatrix[n_]:= Apply[Rm,Flatten[Table[Flatten[Table[{i,j,k,l,n},{k,1,n},{l,1,n}],1],{i,1,n},{j,1,n}],1],{2}]//Simplify

Now we are ready to write our main program, here n is the color of the representation

ColouredAlexander[Knot_,n_]:=Module[{m},
m=Max[List@@@List@@Knot];
Sum[Knot/.{
Xp[i_,j_,k_,l_]:> Rp[(Subscript[s, i]),(Subscript[s, j]),(Subscript[s, k]),(Subscript[s, l]),n],
Xm[i_,j_,k_,l_]:> Rm[(Subscript[s, i]),(Subscript[s, j]),(Subscript[s, k]),(Subscript[s, l]),n],
Cu[k_]:> (q^(-(((1-n)(n-2(Subscript[s, k])+1+λ))/2))),
Ca[k_]:> (q^(((1-n)(n-2(Subscript[s, k])+1+λ))/2))
},##]&@@({(Subscript[s, #]),1,n}&/@Range[m])/n//Simplify
]

Now let’s compute a few knots. Like the Alexander polynomial, we need to keep one component open. Hence, we present our knot as the closure of a braid, except we leave the first strand unclosed, we label the first strand by 1 and continue from top to bottom and we end with the label 1.

The trefoil, color=3

ColouredAlexander[Xp[4,1,2,5]Xp[2,5,6,3]Xp[6,3,4,1]Cu[4],3]

The figure eight knot, n=3

ColouredAlexander[Ca[4]Ca[7]Xp[1,4,5,2]Xm[2,7,8,3]Xp[5,8,1,6]Xm[6,3,4,7],3]

The Hopf link, n=3

ColouredAlexander[Ca[3]Xp[1,3,4,2]Xp[4,2,1,3],3]

The (5,2) torus knot, n=3

ColouredAlexander[Ca[6]Xp[1,6,7,2]Xp[7,2,3,8]Xp[3,8,9,4]Xp[9,4,5,10]Xp[5,10,1,6],3]