KnotpkgT.html

Worksheet for twisted 2 cocycle invariants

> restart;

Procedure to calculate the solutions to the twisted cocycle condition

> #read "/home/saito/grad/chad/Quandle":
#read "/home/saito/public_html/Maple/Chad/qtest.m";
read "E:knot_table":
read "E:Quandle":
read "E:qtest.m";

> co2TwistedSol:=proc(Quandle,polym,m::posint)
local x,y,z,i,EQ,f,F,vars,A,quanod,E,Sol,Sol_list,j,
     temp, deg,Cof,testsol,ttemp,TempPoly,TempEq,
     TempList,k,LL,GG,b,ss;
option remember;
Cof:=[];
if type(polym,polynom) then
  deg:=degree(polym,t);
else
  printf("%s\n",ERROR);
  return;
fi;
Cof:=coeffs(polym);
if gcd(Cof[1],m)<>1 and gcd(Cof[nops(Cof)],m)<>1 then
printf("%s","ERROR: Not a finite ring.");
return;
else
continue;
fi;
quanod:=quandlesize(Quandle);

f:=array(0..quanod-1,0..quanod-1,0..(deg-1));
EQ:=[];
for i from 0 to quanod-1 do
for j from 0 to quanod-1 do
    F[i,j]:=sum(f[i,j,k]*t^k, k=0..deg-1);
od:od:

for x from 0 to (quanod-1) do
  for y from 0 to (quanod-1) do
     for z from 0 to (quanod-1) do
        TempEq[x,y,z]:=t*F[x,y]+F[Quandle[x,y], z]-t*F[x,z]
                       -F[Quandle[x,z],Quandle[y,z]]+(t-1)*F[y,z]:
                              # The equation for each (x,y,z).
        TempPoly:=Rem(TempEq[x,y,z],polym,t) mod m;

                              # Mod ``polym'' and mod m, so that the equation is formulated in
                              # Z_m[t,t^(-1)]/(polym) .
                              # The number m is a prime (it's not clear if this works for non-prime).

        TempList:=PolynomialTools[CoefficientList](TempPoly,t);
                              # For each (x,y,z), this is the list of coefficients of t^k.

        for i from 1 to nops(TempList) do
            E[x,y,z,i-1]:=TempList[i];
            EQ:=[op(EQ),E[x,y,z,i-1]=0];
        od;

     od:
  od:
od:
#7/1/04
#will add Reid. type I move to the list of equations
for i from 0 to (quanod-1) do
for j from 0 to (deg-1) do
   EQ:=[op(EQ), f[i,i,j]=0];
od;
od;

vars:=[seq(seq(seq(f[i,j,k],i=0..quanod-1),j=0..quanod-1),k=0..deg-1)];
A:=linalg[genmatrix](EQ,vars);
b:=vector(linalg[rowdim](A),0);
Sol:=Linsolve(A,b,'r',ss) mod m;

# At this point the solution is in a vector form, in the order of
# (f[0,0,0],f[1,0,0],...]).
# From here the free variables are renamed so that the subscripts starts with 1
# and put the solutions back into polynomial form.

Sol_list:=convert(Sol,list);
LL:=indets(Sol_list);
LL:=convert(LL,list);

x:='x'; # Unassign x. (But ``unassign(x)'' didn't seem to work.)
temp:=1; # The first subscript for the new set of free variables x_1, x_2, ....
GG:=[];

for i from 1 to nops(LL) do
ttemp:=op(LL[i]); # ttemp is the original subscript of the free variables in ss.
GG:=[op(GG),ss[ttemp]=x[temp]*t^(iquo(ttemp,quanod^2))];
    # The first block matrix (whose size is quanod^2 where quanod is the order of X)
    # is for f[i,j,0], and so on, so iquo(ttemp,quanod^2) is the degree of the free variable.
temp:=temp+1;
od;

Sol_list:=subs(GG,Sol_list); # Puts new free variables x in polynomial forms back into Sol_list.
temp:=1;
for k from 0 to deg-1 do
for j from 0 to quanod-1 do
   for i from 0 to quanod-1 do
     f[i,j,k]:=collect(Sol_list[temp],t): # Puts the solutions back into f in polynomial form.
     temp:=temp+1:
od:od:od:

testsol:=map(`mod`,evalm(A &* Sol - b),m);
testsol:=convert(testsol,set);

if testsol={0} then
  return(f);
else
  printf("%s","ERROR: co2TwistedSol solutions are not valid");
  return;
fi;
end:

> makeinv:=proc(Quandle)
#Procedure that will create a zero indexed two dimensional array
#representing the multiplication table for the second property of a quandle.
# ie. There exists a unique c such that a=c*b. Will be used to calculate the
#     colors for a negative crossing.
#Input: A zero indexed 2-dim array representing the multiplication
#       table for the quandle.
#Output:A zero indexed 2-dim array.
local i,j,temp,L,quandleorder;
option remember;
quandleorder:=quandlesize(Quandle);
L:=array(0..quandleorder-1,0..quandleorder-1,[]):
for i from 0 to quandleorder-1 do
for j from 0 to quandleorder-1 do
   temp:=Quandle[i,j];
   L[j,temp]:=i;
od;
od;
return(L);
end:

> tinverse:=proc(polym,m)
local i,temp,L,deg,tinv,Cof,lowdeg,coffinv,tmppgcd;
option remember;
if type(polym,polynom) then
  deg:=degree(polym,t);
else
  printf("%s\n",ERROR);
  return;
fi;
Cof:=PolynomialTools[CoefficientList](polym,t);
temp:=1;
   while Cof[temp]=0 do
     temp:=temp+1;
   od;
if gcd(Cof[temp],m)=1 and gcd(Cof[nops(Cof)],m)=1 then
continue;
else
printf("%s","ERROR, Not a finite ring.");
return;
fi;
lowdeg:=0; # lowdeg is the lowest degree of polym.
while Cof[lowdeg+1]=0 do
lowdeg:=lowdeg+1;
od;
tinv:=0;
for i from (lowdeg+2) to nops(Cof) do
tinv:=tinv-Cof[i]*t^(i-(lowdeg+2));
od;
# For example, if t^2+2*t+3=polym, then first do 3=-2*t-t^2 and
# compute 3*t^(-1)=-2-t. Then the next step cancels 3.

tmppgcd:=igcdex(Cof[lowdeg+1],m,'s','r');
# This is 1 iff the coeff of the lowest dgree is invertible (and it should be).

if tmppgcd<>1 then
  printf("%s %d %s %d","ERROR: Inverse dne for ",Cof[lowdeg+1],"mod",m);
else
  coffinv:=s mod m; # This is he inverse of the coeff of the lowest dgree.
fi;
tinv:=tinv*coffinv;
tinv:=Rem(tinv,polym,t) mod m;
return(tinv);
end:

> co2TwistedInvar:=proc(Quandle,Knot,polym,m::posint)
local i,j,k,x,y,z,quandleorder,F,f,tinv,brind,
     SSTcontri,SST,jj3,jj5,jj6,jj8,s,num,
     Color,ColDiffMatch0,ColorDiff0,Ginv,
     indx,ttemp,deg;

SST:=[];
quandleorder:=quandlesize(Quandle);
tinv:=tinverse(polym,m);
Ginv:=makeinv(Quandle);
brind:=max(op(map(x->abs(x),Knot)))+1;
deg:=degree(polym,t);
    #For the optional 5th argument. The user sends the twisted cocycle solution as input.
if nargs<5 then
f:=co2TwistedSol(Quandle,polym,m);
else
f:=args[5];
fi;

for i from 0 to quandleorder-1 do
for j from 0 to quandleorder-1 do
    F[i,j]:=sum(f[i,j,k], k=0..deg-1);
#Removed the *t^k from the def of F[i,j] since the t terms are
#introduced in the solutions by the procedure co2TwistedSol()

od:od:

for jj3 from 1 to (nops(Knot)+1) do                # Color vectors.
    Color[jj3]:=array(1..brind):
od;
num:=quandleorder^brind;                                        #number of possible colorings

for indx from 0 to (num-1) do                          # One color at a time.
  for jj5 from 1 to brind do
     Color[1][jj5]:=iquo(indx,quandleorder^(jj5-1)) mod quandleorder:
  od:

  for jj6 from 1 to nops(Knot) do                # Computing all color vectors.
    if Knot[jj6] > 0 then                        #The case when braid word element is >0
        for jj8 from 1 to brind do
          if jj8 = abs(Knot[jj6]) then
            Color[jj6+1][jj8]:= Color[jj6][jj8+1]:
          fi:
          if jj8 = abs(Knot[jj6])+1 then
            Color[jj6+1][jj8]:=Quandle[Color[jj6][jj8-1],Color[jj6][jj8]] :
          fi:
          if jj8 < abs(Knot[jj6]) then
            Color[jj6+1][jj8]:=Color[jj6][jj8]:
          fi:
          if jj8 > abs(Knot[jj6])+1 then
            Color[jj6+1][jj8]:=Color[jj6][jj8]:
          fi:
        od:

    else
                                # The case braid word element is < 0
      for jj8 from 1 to brind do
        if jj8 = abs(Knot[jj6]) then
          Color[jj6+1][jj8]:=Ginv[Color[jj6][jj8], Color[jj6][jj8+1]]:
        fi;
        if jj8 = abs(Knot[jj6])+1 then
          Color[jj6+1][jj8]:=Color[jj6][jj8-1]:
        fi;
        if jj8 < abs(Knot[jj6]) then
          Color[jj6+1][jj8]:=Color[jj6][jj8]:
        fi:
        if jj8 > abs(Knot[jj6])+1 then
          Color[jj6+1][jj8]:=Color[jj6][jj8]:
        fi:
      od:
    fi:
  od:                                                 # closes jj6.
  SSTcontri:=0:                                # State-sum contributions.
                                                  # Finding if the colors match.
  ColorDiff0:=evalm(Color[1]-Color[nops(Knot)+1]);
  ColDiffMatch0:=sum(abs(ColorDiff0[jj]),jj=1..brind);
                      # This is zero iff the top color vec matches the bottom.
  if ColDiffMatch0 =0 then

    for s from 1 to nops(Knot) do
      if Knot[s] > 0 then

ttemp:=tinv^abs((-abs(Knot[s])+1))*F[Color[s][abs(Knot[s])], Color[s][abs(Knot[s])+1] ];

SSTcontri:=SSTcontri + Rem(ttemp,polym,t) mod m:

     else

ttemp:=tinv^(abs(-abs(Knot[s])+1))*F[Color[s+1][abs(Knot[s])], Color[s+1][abs(Knot[s])+1] ];
SSTcontri:=SSTcontri+Rem(-ttemp,polym,t) mod m:
      fi:
    od:                                         # Closing the state-sum term, for s.

     SST:=[op(SST),Rem(SSTcontri,polym,t) mod m];
  fi:                                                 # Closing the ColDiffMatch
od:                                                 # Closing indx loop (one color here at a time, for indx).
return(SST);
end:

> CollectTerms:=proc(SST::list)
local T,SSTs,i,j,temp;
T:=[];
SSTs:=convert(SST,set);
for i in SSTs do
temp:=0:
for j from 1 to nops(SST) do
if SST[j]=i then temp:=temp+1:fi:
od:
T:=[op(T),[temp,i]]:
od:
return(T);
end:

> quandlesize:=proc(Quandle)
local T;
option remember;
T:=convert(Quandle,matrix);
if linalg[rowdim](T)<>linalg[coldim](T) then
prinf("%s %s %s\n",ERROR, quandle, dimensions);
else return(linalg[rowdim](T));
fi;
end:

> #save quandlesize,CollectTerms,co2TwistedInvar,tinverse,makeinv,co2TwistedSol, "E:KnotpkgT.m";

> print(co2TwistedSol(Q4_3,t+1,2));

> print(co2TwistedSol(Q4_3,t^2+t+1,2));