User:Ben/KRhomology
From Knot Atlas
< User:Ben
Jump to navigationJump to search
Calculations
Since calculations have now been incorporated into the normal KAtlas data structure, I don't feel like there's much point in having a table of them here.
Macaulay2 program
Save this as a file (called KR.m2), open Macaulay2 (in command line or emacs), and type load "KR.m2".
KRpoly is probabby the command you want (but it only works for knots at the moment). It outputs .
Using texMath puts things in format for LaTeX.
Changes from the previous version: the important change is in the construction of the Rouquier complex. Now it works by breaking up the braid into (at the moment, very simple) patterns it recognizes, and uses simplified Rouquier complexes for those chunks. This seems to be make a big difference in computational time, indicating that a program that could simplify large Rouquier complexes could lead to very large computational savings. I've made some progress in this direction, but am still struggling to produce something truly robust.
Here's a sample session:
Macaulay 2, version 0.9
--Copyright 1993-2001, D. R. Grayson and M. E. Stillman
--Singular-Factory 1.3b, copyright 1993-2001, G.-M. Greuel, et al.
--Singular-Libfac 0.3.2, copyright 1996-2001, M. Messollen
i1 : load "KR.m2"
KR.m2:113:11: warning: local declaration of N shields variable with same name
--loaded KR.m2
i2 : texMath KRpoly (K01,true)
o2 = 1
i3 : texMath KRpoly (K31,true)
o3 = s^{2} t^{2}+{q} t^{2}+1
i4 :
Here's the code for the program.
--This file defines a new object for Macaulay2, called a "Link."
--Like all objects in Macaulay2, a Link is just a hash table.
--Defining a link lets you store information about it for later use.
Link = new Type of MutableHashTable
Link.synonym = "link"
new Link := Link => (cl) -> (
C:=newClass(Link,new MutableHashTable);
C)
--braidClosure is currently the only useful way of defining a link.
--I think it should be clear from the examples below how to use it.
--(Remember to use {}, not () or [])
braidClosure = L ->(
K:=new Link;
K#braid=L;
K)
--This defines all links of 7 or fewer crossings by a braid closure.
K01=braidClosure {1};
K31=braidClosure {1,1,1};
K41=braidClosure {1,-2,1,-2};
K51=braidClosure {1,1,1,1,1};
K52=braidClosure {-1,-1,-2,1,-2};
K61=braidClosure {1,1,2,-1,-3,2,-3};
K62=braidClosure {-1,-1,-1,2,-1,2};
K63=braidClosure {-1,-1,2,-1,2,2};
K71=braidClosure {-1,-1,-1,-1,-1,-1,-1}
K72=braidClosure {-1,-1,-1,-2,1,-2,-3,2,-3}
K73=braidClosure {1,1,1,1,1,2,-1,2}
K74=braidClosure {1,1,2,-1,2,2,3,-2,3}
K75=braidClosure {-1,-1,-1,-1,-2,1,-2,-2}
K76=braidClosure {-1,-1,2,-1,-3,2,-3}
K77=braidClosure {1,-2,1,-2,3,-2,3}
--Now all programs using the Rouqier complex (KR, KRHom, KRpoly) take an extra argument, which should be a truth value.
--If this is "true," then the program will simplify chunks of the Rouquier complex using prescribed homotopies.
--If it is "false," it will use the old brute force method.
--Preliminary results indicate that the program will run MUCH faster if you use the "true" option,
--but it is not 100% vetted yet. there might well be mistakes hiding in there. Let the user beware.
--this program now produces a complex homotopic to the Rouquier complex of the input braid,
--as well as a presentation for the module that corresponds to closing the braid (in matrix form).
KR = (K,v) -> (
if not K#?braid then error "no braid representation" else (
Kb:=K#braid;
P:=K#nbcross=#Kb;
Ka:=apply(Kb,abs);
Kt:=apply(Kb,i->(i>0));
Ks:=sort Ka;
bind:=K#bindex=last(Ks)+1;
Cvars:=new MutableList from toList (-bind..-1);
I:=0;
J:=0;
Kp:={};
newv:=0;
while I<P do (
print I;
M:=1;
while (Kb#?(I+M) and Kb#(I+M)==Kb#I) do M=M+1;
if (M>1 and v) then (
print ("used IImod " | toString(M));
Kp=append(Kp, (("II",M),(Cvars#(Ka_I-1),Cvars#(Ka_I+1-1),newv,Kt_I)));
newvp=newv+2;
J=I+M)
else if ((Kb#?(I+2) and Ka_I==Ka_(I+2)) and v) then (
if Ka_I==Ka_(I+1)+1 then (
if (Kb_(I+1)==Kb_(I+3) and Kb_I==Kb_(I+2)) then (
print "used babamod";
Kp=append(Kp,("baba",(Cvars#(Ka_I),Cvars#(Ka_I-1),Cvars#(Ka_I-2),newv+1,newv,newv+2,Kt_I,Kt_(I+1),Kt_(I+2),Kt_(I+3))));
J=I+4;
)
else (
print "used abamod";
Kp=append(Kp,("aba",(Cvars#(Ka_I),Cvars#(Ka_I-1),Cvars#(Ka_I-2),newv+1,newv,newv+2,Kt_I,Kt_(I+1),Kt_(I+2))));
J=I+3;
);
Cvars#(Ka_I-2)=newv+2;
newvp=newv+3)
else if Ka_I==Ka_(I+1)-1 then (
if (Kb_(I+1)==Kb_(I+3) and Kb_I==Kb_(I+2)) then (
print "used babamod";
Kp=append(Kp,("baba",(Cvars#(Ka_I-1),Cvars#(Ka_I),Cvars#(Ka_I+1),newv,newv+1,newv+2,Kt_I,Kt_(I+1),Kt_(I+2),Kt_(I+3))));
J=I+4;
)
else(
print "used abamod";
Kp=append(Kp,("aba",(Cvars#(Ka_I-1),Cvars#(Ka_I),Cvars#(Ka_I+1),newv,newv+1,newv+2,Kt_I,Kt_(I+1),Kt_(I+2))));
J=I+3;
);
Cvars#(Ka_I+1)=newv+2;
newvp=newv+3
)
else (
print "used stmod";
Kp=append(Kp,("st",(Cvars#(Ka_I-1),Cvars#(Ka_I),newv,Kt_I)));
newvp=newv+2;
J=I+1)
)
else (
print "used stmod";
Kp=append(Kp,("st",(Cvars#(Ka_I-1),Cvars#(Ka_I),newv,Kt_I)));
newvp=newv+2;
J=I+1);
Cvars#(Ka_I-1)=newv;
Cvars#(Ka_I)=newv+1;
I=J;
newv=newvp;
);
print Kp;
elim=newv-bind;
R:=QQ[vars(1 .. newv+bind),MonomialOrder=>Eliminate elim];
Kp=apply(Kp,(S1,S2) -> (S1,apply(S2,i-> (if (class i===ZZ and i<0) then x=i+newv+bind else x=i; x))));
Kmod:= chainComplex( gradedModule(R^1));
for J from 0 to #Kp-1 do (
if ((Kp_J)_0)_0=="II" then Kmod=Kmod**IImod join((Kp_J)_1, (((Kp_J)_0)_1,R))
else if (Kp_J)_0=="aba" then Kmod=Kmod**abamod append((Kp_J)_1,R)
else if (Kp_J)_0=="baba" then Kmod=Kmod**babamod append((Kp_J)_1,R)
else if (Kp_J)_0=="st" then Kmod=Kmod**stmod append((Kp_J)_1,R)
else error "oops, missed a case"
);
-- scan(spots Kmod, i -> if Kmod#dd#?i then print (isWellDefined Kmod.dd_i));
M:=matrix {apply(bind, I-> R_(Cvars#I)-R_(newv+I))};
return (Kmod,M);
);
)
--this produces a simpler complex for an arbitrary number of twists of two adjacent strands.
IImod = (H,I,J,W,n,S) -> (
i:=ideal(S_H+S_I-S_J-S_(J+1),S_H*S_I-S_J*S_(J+1));
Dp:=chainComplex map(S^{0}/i,S^{-1}/i,S_I-S_J);
Dn:=chainComplex map(S^{2}/i,S^{1}/i,S_I-S_J)[1];
if mod(n,2)==0 then C=ftmod(H,I,J,W,S);
if mod(n,2)==1 then C=stmod(H,I,J,W,S);
while n>2 do (
if W then C=C[-2]**S^{-2}++Dp
else C=C[2]**S^{2}++Dn;
n=n-2;
);
C)
--this produces a simpler complex for a full twist of two strands. Now just feeds into "IImod."
ftmod = (H,I,J,W,S) -> (
i:=ideal(S_H+S_I-S_J-S_(J+1),S_H*S_I-S_J*S_(J+1));
j:=ideal(S_H-S_J,S_I-S_(J+1));
if W then (
M0=S^1/i;
M1=S^{-1}/i;
M2=S^{-2}/j;
f1=map(M0,M1,S_H-S_I-S_J+S_(J+1));
f2=map(M1,M2,S_J-S_I);
C=chainComplex(f1,f2));
if not W then (
M0=S^{2}/j;
M1=S^{2}/i;
M2=S^{1}/i;
f1=map(M0,M1);
f2=map(M1,M2,S_H-S_J-S_I+S_(J+1));
C=chainComplex(f1,f2)[2]);
C)
--this produces the standard Rouquier complex for a single crossing
stmod = (H,I,J,W,S) -> (
if W then (
Mp=S^1/ideal(S_H+S_I-S_J-S_(J+1),S_H*S_I-S_J*S_(J+1));
Np=S^{-1}/ideal(S_H-S_J,S_I-S_(J+1));
C=chainComplex(map(Mp,Np,(S_J-S_I))))
else (
Mn=S^{1}/ideal(S_H+S_I-S_J-S_(J+1),S_H*S_I-S_J*S_(J+1));
Nn=S^{1}/ideal(S_H-S_J,S_I-S_(J+1));
C=chainComplex(map(Nn,Mn))[1]);
C)
--this produces a simplified Rouquier for braids of length 3 lifting the longest element of S_3.
abamod = (G,H,I,J,K,L,W,V,X,S) -> (
i:=ideal(S_G-S_J,S_H-S_K,S_I-S_L);
j1:=ideal(S_H+S_G-S_J-S_K,S_H*S_G-S_J*S_K,S_I-S_L);
j2:=ideal(S_H+S_I-S_L-S_K,S_H*S_I-S_L*S_K,S_G-S_J);
k1:=ideal(S_H+S_G+S_I-S_J-S_K-S_L, (S_I-S_K)*(S_I-S_L),(S_J-S_G)*(S_J-S_H));
k2:=ideal(S_H+S_G+S_I-S_J-S_K-S_L, (S_L-S_H)*(S_I-S_L),(S_J-S_G)*(S_G-S_K));
l:=ideal(S_H+S_G+S_I-S_J-S_K-S_L, S_H*S_G+S_I*S_G+S_I*S_H-S_J*S_K-S_L*S_J-S_K*S_L, S_H*S_G*S_I-S_J*S_K*S_L);
if ((not W) and (not V) and (not X)) then (
M0=S^{3}/i;
M1=S^{3}/j1++S^{3}/j2;
M2=S^{3}/k1++S^{3}/k2;
M3=S^{3}/l;
f1=map(M0,M1,matrix{{1_S,-1}});
f2=map(M1,M2,matrix{{1_S,-1},{1,-1}});
f3=map(M2,M3,matrix{{1_S},{1}});
C=chainComplex(f1,f2,f3)[3]
)
else if (W and V and X) then (
M0=S^1/l;
M1=S^{-1}/k1++S^{-1}/k2;
M2=S^{-2}/j1++S^{-2}/j2;
M3=S^{-3}/i;
f1=map(M0,M1,matrix{{S_I-S_J,-S_G+S_L}});
f2=map(M1,M2,matrix{{S_I-S_K,-S_H+S_J},{S_H-S_L,-S_G+S_K}});
f3=map(M2,M3,matrix{{-S_K+S_G},{-S_L+S_H}});
C=chainComplex(f1,f2,f3)
)
else if ((not W) and (not V) and X) then (
M0=S^{2}/k2++S^{1}/i;
M1=S^{2}/l++S^{1}/j1++S^{1}/j2;
M2=S^{1}/k1;
f1=map(M0,M1,matrix{{1,S_H-S_L,S_G-S_K},{0,-1,1}});
f2=map(M1,M2,matrix{{S_I-S_J},{1},{1}});
C=chainComplex(f1,f2)[1]
)
else if (W and (not V) and (not X)) then (
M0=S^{2}/k1++S^{1}/i;
M1=S^{2}/l++S^{1}/j1++S^{1}/j2;
M2=S^{1}/k2;
f1=map(M0,M1,matrix{{1,S_I-S_K,S_H-S_J},{0,-1,1}});
f2=map(M1,M2,matrix{{S_G-S_L},{1},{1}});
C=chainComplex(f1,f2)[1]
)
else if (W and V and (not X)) then (
M2=S^{0}/k2++S^{-1}/i;
M1=S^{1}/l++S^{0}/j1++S^{0}/j2;
M0=S^{1}/k1;
f1=map(M0,M1,matrix {{-1,-S_I+S_K,S_J-S_H}});
f2=map(M1,M2,matrix {{S_G-S_L,0},{1,S_H-S_J},{1,-S_I+S_K}});
C=chainComplex(f1,f2)[1])
else if ((not W) and V and X) then (
M2=S^{0}/k1++S^{-1}/i;
M1=S^{1}/l++S^{0}/j1++S^{0}/j2;
M0=S^{1}/k2;
f1=map(M0,M1,matrix {{-1,-S_L+S_H,S_G-S_K}});
f2=map(M1,M2,matrix {{S_J-S_I,0},{1,S_K-S_G},{1,-S_L+S_H}});
C=chainComplex(f1,f2)[1]
)
else if ((not W) and V and (not X)) then (
C=new ChainComplex;
C.ring=S;
C#0 = cokernel map(S^{{1}, {1}, {2}}, S^{{1}, {0}, {0}, {0}, {0}, {0}, {-1}, {-1}, {-1}}, {{0, S_H+S_G-S_K-S_J, 0, 0, 0, S_I-S_L, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J, 0, 0}, {0, 0, S_I+S_H+S_G-S_K-S_J-S_L, S_H+S_G-S_K-S_J, -S_H-S_G+S_K+S_J, 0, 0, -S_H*S_G+S_K*S_J, S_H^2+S_H*S_G+S_G^2-S_H*S_K-S_G*S_K-S_H*S_J-S_G*S_J+S_K*S_J-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L}, {S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, S_H*S_G-S_H*S_K-S_G*S_K+S_K^2-S_H*S_J-S_G*S_J+S_K*S_J+S_J^2, S_H^2+S_G^2-S_K^2-S_J^2-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L, 0, 0, S_H*S_K*S_J+S_G*S_K*S_J-S_K^2*S_J-S_K*S_J^2, 0}});
C#1 = cokernel map(S^{{0}}, S^{{-1}, {-1}, {-2}}, {{S_H+S_G-S_K-S_J, S_I-S_L, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J}});
C#-2 = cokernel map(S^{{2}}, S^{{1}, {1}, {0}}, {{S_G-S_J, S_I+S_H-S_K-S_L, S_H^2-S_H*S_K-S_H*S_L+S_K*S_L}});
C#-1 = cokernel map(S^{{1}, {2}, {2}}, S^{{1}, {1}, {0}, {0}, {0}, {0}, {0}, {0}, {0}}, {{0, 0, S_G-S_J, S_H-S_K, S_I-S_L, 0, 0, 0, 0}, {S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, 0, 0, 0, S_H*S_G-S_H*S_J-S_G*S_J+S_J^2, S_H^2+S_G^2-S_H*S_K-S_G*S_K+S_K*S_J-S_J^2-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L, 0}, {0, S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, 0, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J, 0, 0, S_H^2+S_H*S_G-S_H*S_K-S_H*S_J-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L}});
C#dd#0 = map(cokernel map(S^{{1}, {2}, {2}}, S^{{1}, {1}, {0}, {0}, {0}, {0}, {0}, {0}, {0}}, {{0, 0, S_G-S_J, S_H-S_K, S_I-S_L, 0, 0, 0, 0}, {S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, 0, 0, 0, S_H*S_G-S_H*S_J-S_G*S_J+S_J^2, S_H^2+S_G^2-S_H*S_K-S_G*S_K+S_K*S_J-S_J^2-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L, 0}, {0, S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, 0, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J, 0, 0, S_H^2+S_H*S_G-S_H*S_K-S_H*S_J-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L}}), cokernel map(S^{{1}, {1}, {2}}, S^{{1}, {0}, {0}, {0}, {0}, {0}, {-1}, {-1}, {-1}}, {{0, S_H+S_G-S_K-S_J, 0, 0, 0, S_I-S_L, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J, 0, 0}, {0, 0, S_I+S_H+S_G-S_K-S_J-S_L, S_H+S_G-S_K-S_J, -S_H-S_G+S_K+S_J, 0, 0, -S_H*S_G+S_K*S_J, S_H^2+S_H*S_G+S_G^2-S_H*S_K-S_G*S_K-S_H*S_J-S_G*S_J+S_K*S_J-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L}, {S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, S_H*S_G-S_H*S_K-S_G*S_K+S_K^2-S_H*S_J-S_G*S_J+S_K*S_J+S_J^2, S_H^2+S_G^2-S_K^2-S_J^2-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L, 0, 0, S_H*S_K*S_J+S_G*S_K*S_J-S_K^2*S_J-S_K*S_J^2, 0}}), {{-1, 0, 0}, {S_H+S_G-S_J-S_L, -S_K, -1}, {0, S_G-S_K-S_J, -1}});
C#dd#1 = map(cokernel map(S^{{1}, {1}, {2}}, S^{{1}, {0}, {0}, {0}, {0}, {0}, {-1}, {-1}, {-1}}, {{0, S_H+S_G-S_K-S_J, 0, 0, 0, S_I-S_L, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J, 0, 0}, {0, 0, S_I+S_H+S_G-S_K-S_J-S_L, S_H+S_G-S_K-S_J, -S_H-S_G+S_K+S_J, 0, 0, -S_H*S_G+S_K*S_J, S_H^2+S_H*S_G+S_G^2-S_H*S_K-S_G*S_K-S_H*S_J-S_G*S_J+S_K*S_J-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L}, {S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, S_H*S_G-S_H*S_K-S_G*S_K+S_K^2-S_H*S_J-S_G*S_J+S_K*S_J+S_J^2, S_H^2+S_G^2-S_K^2-S_J^2-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L, 0, 0, S_H*S_K*S_J+S_G*S_K*S_J-S_K^2*S_J-S_K*S_J^2, 0}}), cokernel map(S^{{0}}, S^{{-1}, {-1}, {-2}}, {{S_H+S_G-S_K-S_J, S_I-S_L, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J}}), {{S_G-S_J}, {S_G-S_L}, {S_G^2-S_G*S_K-S_G*S_J-S_G*S_L+S_K*S_L+S_J*S_L}});
C#dd#-1 = map(cokernel map(S^{{2}}, S^{{1}, {1}, {0}}, {{S_G-S_J, S_I+S_H-S_K-S_L, S_H^2-S_H*S_K-S_H*S_L+S_K*S_L}}), cokernel map(S^{{1}, {2}, {2}}, S^{{1}, {1}, {0}, {0}, {0}, {0}, {0}, {0}, {0}}, {{0, 0, S_G-S_J, S_H-S_K, S_I-S_L, 0, 0, 0, 0}, {S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, 0, 0, 0, S_H*S_G-S_H*S_J-S_G*S_J+S_J^2, S_H^2+S_G^2-S_H*S_K-S_G*S_K+S_K*S_J-S_J^2-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L, 0}, {0, S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, 0, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J, 0, 0, S_H^2+S_H*S_G-S_H*S_K-S_H*S_J-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L}}), {{-S_H+S_L, -1, 1}});)
else if (W and (not V) and X) then (
C=new ChainComplex;
C.ring=S;
C#0 = cokernel map(S^{{0}, {0}, {1}}, S^{{0}, {-1}, {-1}, {-1}, {-1}, {-1}, {-2}, {-2}, {-2}}, {{0, S_H+S_G-S_K-S_J, 0, S_I-S_L, 0, 0, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J, 0, 0}, {0, 0, S_I+S_H+S_G-S_K-S_J-S_L, 0, S_H+S_G-S_K-S_J, -S_H-S_G+S_K+S_J, 0, S_H^2+S_H*S_G+S_G^2-S_H*S_K-S_G*S_K-S_H*S_J-S_G*S_J+S_K*S_J-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L, -S_H*S_G+S_K*S_J}, {S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, 0, S_H*S_G-S_H*S_K-S_G*S_K+S_K^2-S_H*S_J-S_G*S_J+S_K*S_J+S_J^2, S_H^2+S_G^2-S_K^2-S_J^2-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L, 0, 0, S_H*S_K*S_J+S_G*S_K*S_J-S_K^2*S_J-S_K*S_J^2}});
C#1 = cokernel map(S^{{-1}, {0}, {0}}, S^{{-1}, {-1}, {-2}, {-2}, {-2}, {-2}, {-2}, {-2}, {-2}}, {{0, 0, S_G-S_J, S_H-S_K, S_I-S_L, 0, 0, 0, 0}, {S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, 0, 0, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J, 0, 0, S_H^2+S_H*S_G-S_H*S_K-S_H*S_J-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L}, {0, S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, 0, 0, S_H*S_G-S_H*S_J-S_G*S_J+S_J^2, S_H^2+S_G^2-S_H*S_K-S_G*S_K+S_K*S_J-S_J^2-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L, 0}});
C#2 = cokernel map(S^{{-1}}, S^{{-2}, {-2}, {-3}}, {{S_G-S_J, S_I+S_H-S_K-S_L, S_H^2-S_H*S_K-S_H*S_L+S_K*S_L}});
C#-1 = cokernel map(S^{{1}}, S^{{0}, {0}, {-1}}, {{S_H+S_G-S_K-S_J, S_I-S_L, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J}});
C#dd#0 = map(cokernel map(S^{{1}}, S^{{0}, {0}, {-1}}, {{S_H+S_G-S_K-S_J, S_I-S_L, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J}}), cokernel map(S^{{0}, {0}, {1}}, S^{{0}, {-1}, {-1}, {-1}, {-1}, {-1}, {-2}, {-2}, {-2}}, {{0, S_H+S_G-S_K-S_J, 0, S_I-S_L, 0, 0, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J, 0, 0}, {0, 0, S_I+S_H+S_G-S_K-S_J-S_L, 0, S_H+S_G-S_K-S_J, -S_H-S_G+S_K+S_J, 0, S_H^2+S_H*S_G+S_G^2-S_H*S_K-S_G*S_K-S_H*S_J-S_G*S_J+S_K*S_J-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L, -S_H*S_G+S_K*S_J}, {S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, 0, S_H*S_G-S_H*S_K-S_G*S_K+S_K^2-S_H*S_J-S_G*S_J+S_K*S_J+S_J^2, S_H^2+S_G^2-S_K^2-S_J^2-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L, 0, 0, S_H*S_K*S_J+S_G*S_K*S_J-S_K^2*S_J-S_K*S_J^2}}), {{S_G-S_J, -S_J, -1}});
C#dd#1 = map(cokernel map(S^{{0}, {0}, {1}}, S^{{0}, {-1}, {-1}, {-1}, {-1}, {-1}, {-2}, {-2}, {-2}}, {{0, S_H+S_G-S_K-S_J, 0, S_I-S_L, 0, 0, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J, 0, 0}, {0, 0, S_I+S_H+S_G-S_K-S_J-S_L, 0, S_H+S_G-S_K-S_J, -S_H-S_G+S_K+S_J, 0, S_H^2+S_H*S_G+S_G^2-S_H*S_K-S_G*S_K-S_H*S_J-S_G*S_J+S_K*S_J-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L, -S_H*S_G+S_K*S_J}, {S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, 0, S_H*S_G-S_H*S_K-S_G*S_K+S_K^2-S_H*S_J-S_G*S_J+S_K*S_J+S_J^2, S_H^2+S_G^2-S_K^2-S_J^2-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L, 0, 0, S_H*S_K*S_J+S_G*S_K*S_J-S_K^2*S_J-S_K*S_J^2}}), cokernel map(S^{{-1}, {0}, {0}}, S^{{-1}, {-1}, {-2}, {-2}, {-2}, {-2}, {-2}, {-2}, {-2}}, {{0, 0, S_G-S_J, S_H-S_K, S_I-S_L, 0, 0, 0, 0}, {S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, 0, 0, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J, 0, 0, S_H^2+S_H*S_G-S_H*S_K-S_H*S_J-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L}, {0, S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, 0, 0, S_H*S_G-S_H*S_J-S_G*S_J+S_J^2, S_H^2+S_G^2-S_H*S_K-S_G*S_K+S_K*S_J-S_J^2-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L, 0}}), {{S_G-S_K, 1, 0}, {0, -1, -1}, {0, -S_H+S_K+S_J, S_J}});
C#dd#2 = map(cokernel map(S^{{-1}, {0}, {0}}, S^{{-1}, {-1}, {-2}, {-2}, {-2}, {-2}, {-2}, {-2}, {-2}}, {{0, 0, S_G-S_J, S_H-S_K, S_I-S_L, 0, 0, 0, 0}, {S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, 0, 0, S_G^2-S_G*S_K-S_G*S_J+S_K*S_J, 0, 0, S_H^2+S_H*S_G-S_H*S_K-S_H*S_J-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L}, {0, S_I+S_H+S_G-S_K-S_J-S_L, 0, 0, 0, 0, S_H*S_G-S_H*S_J-S_G*S_J+S_J^2, S_H^2+S_G^2-S_H*S_K-S_G*S_K+S_K*S_J-S_J^2-S_H*S_L-S_G*S_L+S_K*S_L+S_J*S_L, 0}}), cokernel map(S^{{-1}}, S^{{-2}, {-2}, {-3}}, {{S_G-S_J, S_I+S_H-S_K-S_L, S_H^2-S_H*S_K-S_H*S_L+S_K*S_L}}), {{1}, {-S_G+S_K}, {-S_H+S_J}});
)
else error "looks like I forgot a case";
C)
--these extend Macaulay2's ability to take tensor products and induced maps.
ChainComplex ** Matrix := ChainComplexMap => (C,f) ->(
map(C ** target f,C** source f,i -> id_(C_i)**f))
RingMap ** GradedModule := GradedModule => (f,C) -> (
D := new GradedModule;
D#ring= target f;
scan(spots C, i->D#i=f**C#i);
D)
inducedchainMap = (C,D) -> (
map(
C,D,i->( inducedMap(C_i,D_i)) --print "found another induced map";
)
)
chainhomology = (FB,GB) -> (
CB:=source FB;
H:=inducedchainMap(ker FB,image GB,id_CB);
E:=coker H;
E)
--this has input a chain complex C and a sequence M.
--The output is the complexes Tor^i(C,coker M) if M is a regular sequence.
Torify = (C,M) -> (
J:=rank source M;
KD:=apply(J+2,I->(print ("took tensor product " | toString I); C**koszul(I,M)));
Lt=apply(J+1,I->(
F:=KD_I;
G:=KD_(I+1);
E:=inducedchainMap(ker F,image G);
print ("found E " | toString I);
H:=coker E;
print ("found K-homology " | toString I);
H));
Lt)
--This has input a braid, output the K-homology of KR double complex (i.e. the complexes of Tor's)
KRHom = (K,v) -> (
L:=Torify(KR(K,v));
M:=apply(L,homology);
N:=apply(M,prune);
K#KRHom=N;
N)
spots = C -> select(keys C, i -> class i === ZZ)
degrees(GradedModule) := Function => C -> (
i -> degrees C_i)
--input, a knot K. output ((1-t)/(1+q*t))*(the graded Hilbert
--polynomial of K). THIS CURRENTLY ONLY WORKS FOR KNOTS, NOT LINKS.
KRpoly = (K,v) -> (
L:=KRHom(K,v);
R:=ring L_0;
print "hello";
Rn:=#generators R;
S:=QQ[t];
f=map(S,R,apply(toList (1..Rn),i->t));
M:=apply(L, C -> f**C);
N:=apply(M,degrees);
K#KRdeg=N;
Pring=QQ[q,s,t,Inverses=>true];
spoM:=sort (spots M_0);
P:=sum(apply(toList (0..#M-1), i-> (
q^i*sum(apply(spoM, j-> (
s^j*sum(apply(flatten N_i j, k->t^k))
)
))
)
));
K#KRpoly=P;
P//(q*t+1))
--Basically the same as KRHom with more readable output.
KRdisp =(K,v) -> (
L:=KRHom (K,v);
N:=stack(between(" ", apply(#L,i->net i | " " | net L_i)));
N)
