Knotpkg.html

Procedures for 2-cocycle and 3-cocycle invariants
Contents: co2Solution:=proc(Quandle,m::posint)
calc2cocInvar:=proc(Quandle,Knot,m::posint, (optional)solutions)

                       co3Solution:=proc(Quandle,m::posint)
                       calc3cocInvar:=proc(Quandle,Knot,m::posint,(optional) solutions)
                       connSumKnots:=proc(Knots_list)
                       mirrorKnot:=proc(L)
                       barKnot:=proc(L)
                       quandlesize:=proc(Quandle)
                       makeinv:=proc(Quandle)

Date: Last updated 3/09/04
      : Updated 4/01/04 added comments

> restart;

> quandlesize:=proc(Quandle)
#Procedure to determine how many elements are in the quandle
#Input: A zero indexed two dimensional array representing the
# the multiplication table for the quandle.
#Output: A positive integer. Representing the number of elements in the set.
local T;
option remember; #create table to avoid multiple function calls
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:

> 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:

> co2Solution:=proc(Quandle,m::posint)
#Procedure to calculate the solutions to the 2-cocycle conditions
#Input: (1) a Quandle.
#       (2) the modulus.
#Output: Solutions
local x,y,z,i,EQ,f,vars,A,quanod,E,Sol,Sol_list,j,temp,
     testsol;
option remember;
print(co2solproccall);
quanod:=quandlesize(Quandle);
f:=array(0..(quanod-1),0..(quanod-1));
EQ:=[];                             #defining the 2-cocycle condition
for x from 0 to (quanod-1) do
  for y from 0 to (quanod-1) do
     for z from 0 to (quanod-1) do
       E[x,y,z]:= f[x,y]+f[Quandle[x,y], z]-f[x,z]-f[Quandle[x,z],Quandle[y,z]]:
       EQ:=[op(EQ),E[x,y,z]=0]:
od: od: od:
for i from 0 to (quanod-1) do
EQ:=[op(EQ),f[i,i]=0]:
od:
vars:=[seq(seq(f[i,j],j=0..(quanod-1)),i=0..(quanod-1))];
A:=linalg[genmatrix](EQ,vars,b):
Sol:=Linsolve(A,b,'r',t) mod m:
Sol_list:=convert(Sol,list):
temp:=1;
     #create the array of solutions
for i from 0 to (quanod-1) do
for j from 0 to (quanod-1) do
          f[i,j]:=Sol_list[temp]:
          temp:=temp+1;
od:od:

testsol:=[];
for i from 1 to nops(EQ) do
testsol:=[op(testsol),map(x->x mod m,eval(EQ[i]))];
od;
testsol:=convert(testsol,set);
#test to see if the solutions satisfy the equations
if testsol={0=0} then return(f);
else printf("%s %s %s\n",co2Solution,solutions, invalid);
fi;

end:

> calc2cocInvar:=proc(Quandle,Knot,m::posint)
#Procedure to calculate the state sum term for a knot
#Input: (1) A quandle.
#       (2) A knot represented as a list in braid word form.
#       (3) The modulus.
#       (4) Optional. The solutions to the 2-cocycle conditions.
#           note:No error testing is done. The user must make sure
#                 the solutions were calculated from the same quandle
#                 and modulus.
#Output: The state sum of the knot.
local SST,SSTcontri,jj3,jj5,jj6,jj8,s,num,Color,brind,
     indx,ColDiffMatch0,ColorDiff0,Ginv,quandleorder,
     coSolutions;
SST:=0;

quandleorder:=quandlesize(Quandle);
    #For the optional fourth argument. The user sends the cocycle solution as input.
if nargs<4 then
coSolutions:=co2Solution(Quandle,m);
else
coSolutions:=args[4];
fi;

Ginv:=makeinv(Quandle);
brind:=max(op(map(x->abs(x),Knot)))+1;

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
      if Knot[jj6]<100 then
        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
              # Virtual crossing:
        for jj8 from 1 to brind[KT] do
          if jj8 = abs(bw[KT][jj6])-100 then
             Color[jj6+1][jj8]:=Color[jj6][jj8+1]:
          fi:
          if jj8 = abs(bw[KT][jj6])-100+1 then
             Color[jj6+1][jj8]:=Color[jj6][jj8-1]:
          fi:
          if jj8 < abs(bw[KT][jj6])-100 then
             Color[jj6+1][jj8]:=Color[jj6][jj8]:
          fi:
          if jj8 > abs(bw[KT][jj6])-100+1 then
             Color[jj6+1][jj8]:=Color[jj6][jj8]:
          fi:
         od:
      fi:
    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
        if Knot[s]<100 then

       SSTcontri:=SSTcontri + coSolutions[Color[s][abs(Knot[s])], Color[s][abs(Knot[s])+1] ] :
        fi;
      else
       SSTcontri:=SSTcontri - coSolutions[Color[s+1][abs(Knot[s])], Color[s+1][abs(Knot[s])+1] ] :
      fi:
    od:                                         # Closing the state-sum term, for s.

     SST:=SST + u^(map( z -> z mod m, SSTcontri ) ):
  fi:                                                 # Closing the ColDiffMatch
od:                                                 # Closing indx loop (one color here at a time, for indx).
return(SST);
end:

> mirrorKnot:=proc(L)
local i,S,braidIndex;
braidIndex:=max(op(map(x->abs(x),L)))+1;
S:=[];
for i from 1 to nops(L) do
  if L[i]<0 then
    S:=[op(S),braidIndex+L[i]];
  else
    S:=[op(S),(-1)*(braidIndex-L[i])];
  fi;
od;
return(S);
end:

> barKnot:=proc(L)
local i,S;
S:=[];
for i from 1 to nops(L) do
S:=[L[i],op(S)];
od;
return(S);
end:

> connSumKnots:=proc(Knots_list)
#Procedure to form the braid word of a connected sum of knots.
#Input: A list.
#       [1] A list of lists. The elements of the list are lists
#           representing the braid words of the knots
#            in the order that they are to be connected.
#           ex. [[1,1,1],[1,1,1],[1,-2,1,-2]]
#Output: A list, [L].
#       [L] The new braid word.
# ex. of a function call
# ConnSumKnots([[1,1,1],[1,1,1],[1,-2,1,-2]]);

local newIndex, i,k, j, NewKnot,Braid_Index_list;
NewKnot:=[];
Braid_Index_list:[];
newIndex:=0;
for k from 1 to nops(Knots_list) do
Braid_Index_list[k]:=max(op(map(x->abs(x),Knots_list[k])))+1;
od;
for i from 1 to nops(Knots_list) do
  for j from 1 to nops(Knots_list[i]) do
     if Knots_list[i][j]<0 then
        NewKnot:=[op(NewKnot),Knots_list[i][j]-newIndex];
     else
        NewKnot:=[op(NewKnot),Knots_list[i][j]+newIndex];
     fi;
  od;
  newIndex:=newIndex+Braid_Index_list[i];
  if i<> nops(Knots_list) then
     NewKnot:=[op(NewKnot),newIndex];
  fi;
od;
return(NewKnot);
end:

> co3Solution:=proc(Quandle,m::posint)
#Procedure to calculate the solutions to the 3-cocycle conditions
#Input: (1) a Quandle.
#       (2) the modulus.
#Output: Solutions
local x,y,z,i,w,k,EQ,h,vars,A,quanod,E,Sol,Sol_list,j,temp,
testsol;
option remember;
print(co3solproccall);
quanod:=quandlesize(Quandle);
h:=array(0..(quanod-1),0..(quanod-1),0..(quanod-1));
EQ:=[];                             #defining the 3-cocycle condition
for x from 0 to (quanod-1) do
  for y from 0 to (quanod-1) do
     for z from 0 to (quanod-1) do
       for w from 0 to (quanod-1) do
       E[x,y,z,w]:= h[x,z,w] - h[x,y,w] + h[x,y,z]
- h[Quandle[x,y],z,w] + h[Quandle[x,z],Quandle[y,z],w]- h[Quandle[x,w],Quandle[y,w],Quandle[z,w]]:
EQ:=[op(EQ),E[x,y,z,w]=0]:
od: od: od:od:
for i from 0 to (quanod-1) do
for j from 0 to (quanod-1) do
   EQ:=[op(EQ),h[i,j,j]=0]:
od:od:
vars:=[seq(seq(seq(h[i,j,k],k=0..(quanod-1)),j=0..(quanod-1)),i=0..(quanod-1))];
A:=linalg[genmatrix](EQ,vars,b):
Sol:=Linsolve(A,b,'r',t) mod m:
Sol_list:=convert(Sol,list):
temp:=1;
for i from 0 to (quanod-1) do
for j from 0 to (quanod-1) do
   for k from 0 to (quanod-1) do
          h[i,j,k]:=Sol_list[temp]:
          temp:=temp+1;
od:od:od:
testsol:=[];
for i from 1 to nops(EQ) do
testsol:=[op(testsol),map(x->x mod m,eval(EQ[i]))];
od;
testsol:=convert(testsol,set);

if testsol={0=0} then return(h);
else printf("%s %s %s\n",co3Solution,solutions, invalid);
fi;
end:

> calc3cocInvar:=proc(Quandle,Knot,m::posint)
#Procedure to calculate the state sum term for a knot
#Input: (1) A quandle.
#       (2) A knot represented as a list in braid word form.
#       (3) The modulus.
#       (4) Optional. The solutions to the 3-cocycle conditions.
#           note:No error testing is done. The user must make sure
#                 the solutions were calculated from the same quandle
#                 and modulus.
#Output: The state sum of the knot.
local SST,SSTcontri,jj3,jj5,jj6,jj8,s,num,Color,brind,
     indx,ColDiffMatch0,ColorDiff0,Ginv,quandleorder,
     coSolutions,Facecolors,facecolors,
     precolorface,nowcolor,colcoloring;
SST:=0;

quandleorder:=quandlesize(Quandle);

if nargs<4 then
coSolutions:=co3Solution(Quandle,m);
else
coSolutions:=args[4];
fi;

Ginv:=makeinv(Quandle);
brind:=max(op(map(x->abs(x),Knot)))+1;

for jj3 from 1 to (nops(Knot)+1) do                # Color vectors.
    Color[jj3]:=array(1..brind):
    Facecolors[jj3]:=array(0..brind-1):
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.

                                                  # 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
#The braid has a valid coloring so every possible color will contribute to the state sum.
     for facecolors from 0 to (quandleorder-1) do
       SSTcontri:=0;      # State-sum contributions.

       for precolorface from 1 to (nops(Knot)+1) do

           Facecolors[precolorface][0]:=facecolors:

       od;
for nowcolor from 1 to nops(Knot) do

        for colcoloring from 0 to (abs(Knot[nowcolor])-1) do
         Facecolors[nowcolor][colcoloring+1]:=Quandle[Facecolors[nowcolor][colcoloring],Color[nowcolor][colcoloring+1]]:

od:

    od:
    for s from 1 to nops(Knot) do
      if Knot[s] > 0 then
       SSTcontri:= SSTcontri +
coSolutions[Facecolors[s][abs(Knot[s])-1],Color[s][abs(Knot[s])], Color[s][abs(Knot[s])+1] ] :
      else
         SSTcontri:=SSTcontri -
coSolutions[Facecolors[s][abs(Knot[s])-1],Color[s+1][abs(Knot[s])], Color[s+1][abs(Knot[s])+1] ] :
      fi:
    od:                                         # Closing the state-sum term, for s.


    SST:=SST + u^(map( z -> z mod m, SSTcontri ) ):
od: #closes facecolors
fi:                                                 # Closing the ColDiffMatch
od:                                                 # Closing indx loop (one color here at a time, for indx).
return(SST);
end: