User:Ben/KRhomology: Difference between revisions

From Knot Atlas
Jump to navigationJump to search
 
(18 intermediate revisions by 6 users not shown)
Line 1: Line 1:
==Calculations==
==Actual 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.
Here is a table of known KR homologies. We let <math>KR_K(q,s,t)</math> be the Hilbert series of KR homology. Note that a factor of the Hilbert series of the unknot appears in all of them. This will not be true of links, I believe.


Look for example at pages like [[3_1]] and [[Data:3_1/Khovanov_Rozansky_Polynomial]].
Unfortunately, computation seems to bog down very fast. [[6_1]] has been giving me a lot of trouble, probably because it has braid index 4. If someone with a faster machine would run it, I would be very appreciative.


==Macaulay2 program==
{|align=center border=1
WARNING: This program is obsolete... and the newer version is probably broken. Complain to Ben?
|-
| [[0_1]]
| <math>\frac{{q} {t}+1}{1-t}</math>
|-
| [[3_1]]
| <math>\left(\frac{{q} {t}+1}{1-t}\right)(s^{2} t^{2}+{q} t^{2}+1)</math>
|-
| [[4_1]]
| <math>\left(\frac{{q} {t}+1}{1-t}\right)(t^{{-1}}+{q} {t}+{q} s^{{-1}}+{q} s^{{-{2}}} t^{{-1}}+q^{2} s^{{-{2}}} {t})</math>
|-
| [[5_1]]
| <math>\left(\frac{{q} {t}+1}{1-t}\right)(1+s^{2} t^{2}+s^{4} t^{4}+{q} s^{2} t^{4}+{q} t^{2})</math>
|-
| [[5_2]]
| <math>\left(\frac{{q} {t}+1}{1-t}\right)({q}+q^{2} s^{{-{2}}}+t^{{-{2}}}+q^{2} s^{{-{3}}} t^{{-1}}+{q} s^{{-{2}}} t^{{-{2}}})</math>
|-
| [[6_2]]
| <math>\left(\frac{{q} {t}+1}{1-t}\right)({q} {t}+q^{2} s^{{-{2}}} {t}+{q} s^{{-1}}+t^{{-1}}+2 {q} s^{{-{2}}} t^{{-1}}+s^{{-1}} t^{{-{2}}}+q^{2} s^{{-{4}}} t^{{-1}}+{q}s^{{-{3}}} t^{{-{2}}}+s^{{-{2}}} t^{{-{3}}}+{q} s^{{-{4}}} t^{{-{3}}})</math>
|-
| [[6_3]]
| <math>{\left(\frac{{q} {t}+1}{1-t}\right)(q} {s} t^{2}+q^{2} s^{{-1}} t^{2}+{q} {t}+{s}+q^{2} s^{{-{2}}} {t}+3 {q} s^{{-1}}+t^{{-1}}+q^{2} s^{{-{3}}}+{q} s^{{-{2}}} t^{{-1}}+s^{{-1}} t^{{-{2}}}+{q} s^{{-{3}}} t^{{-{2}}})</math>
|}


Save this as a file (called KR.m2), open Macaulay2 (in command line or emacs), and type <code>load "KR.m2"</code>.
I've been running more calculations on panda and neuron, two of the fast computers in the math department. I've got panda working through all the braid index 3 knots, and it's started giving some results. --[[User:Scott|Scott]] 02:16, 30 Nov 2005 (EST)
<code>KRpoly</code> is probably the command you want (but it only works for knots at the moment). It outputs <math>\frac{1-t}{qt+1}KR_K(q,s,t)</math>.
{|align=center border=1
Using <code>texMath</code> puts things in format for LaTeX.
|-
| [[7_3]]
| <math>\left(\frac{{q} {t}+1}{1-t}\right)({q} s^{3} t^{5}+s^{4} t^{4}+q^{2} {s} t^{5}+{q} s^{2} t^{4}+s^{3} t^{3}+2 {q} {s} t^{3}+s^{2} t^{2}+q^{2} s^{{-1}} t^{3}+{q} t^{2}+{s} {t}+{q} s^{{-1}} {t}+1)</math>
| (This took about half an hour, and consumed about a gig of memory.)
|-
| [[7_5]]
| <math> \left(\frac{{q} {t}+1}{1-t}\right) (q^{2} s^{{-{2}}}+{q} s^{{-1}} t^{{-1}}+q^{2} s^{{-{3}}} t^{{-1}}+2 {q} s^{{-{2}}} t^{{-{2}}}+s^{{-1}} t^{{-{3}}}+2 q^{2} s^{{-{4}}} t^{{-{2}}}+2 {q} s^{{-{3}}} t^{{-{3}}}+s^{{-{2}}} t^{{-{4}}}+q^{2} s^{{-{5}}} t^{{-{3}}}+2 {q} s^{{-{4}}} t^{{-{4}}}+s^{{-{3}}} t^{{-{5}}}+q^{2} s^{{-{6}}} t^{{-{4}}}+{q} s^{{-{5}}} t^{{-{5}}})</math>
|}


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.
neuron is, at this moment, still struggling with [[6_1]]. --[[User:Scott|Scott]] 02:16, 30 Nov 2005 (EST)


The program posted on Jan. 15 had a bug in it, and shouldn't be used. That bug is now fixed.
==Theoretical stuff==
I have some ideas which I hope will be of interest to ya'll, but I'd like to mull them a bit longer. Maybe when I get back on Wednesday.

==Macaulay2 program==
Save this as a file (called KR.m2), open Macaulay2 (in command line or emacs), and type <code>load "KR.m2"</code>.
<code>KRpoly</code> is probabby the command you want (but it only works for knots at the moment). It outputs <math>\frac{1-t}{qt+1}KR_K(q,s,t)</math>.
Using <code>texMath</code> puts things in format for LaTeX.


Line 60: Line 26:
--loaded KR.m2
--loaded KR.m2


i2 : texMath KRpoly K01
i2 : texMath KRpoly (K01,true)


o2 = 1
o2 = 1


i3 : texMath KRpoly K31
i3 : texMath KRpoly (K31,true)


o3 = s^{2} t^{2}+{q} t^{2}+1
o3 = s^{2} t^{2}+{q} t^{2}+1
Line 72: Line 38:
Here's the code for the program.
Here's the code for the program.
<pre>
<pre>
--KR.m2
--This file defines a new object for Macaulay2, called a "Link."
--This file defines a new object for Macaulay2, called a "Link."
--Like all objects in Macaulay2, a Link is just a hash table.
--Like all objects in Macaulay2, a Link is just a hash table.
Line 87: Line 52:
--(Remember to use {}, not () or [])
--(Remember to use {}, not () or [])
braidClosure = L ->(
braidClosure = L ->(
K=new Link;
K:=new Link;
K#braid=L;
K#braid=L;
K)
K)
Line 108: Line 73:
K77=braidClosure {1,-2,1,-2,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.
--This outputs a List of complexes, one in each Hochschild degree.
--If this is "true," then the program will simplify chunks of the Rouquier complex using prescribed homotopies.
--The homology of these complexes is actual KR homology. Mostly this function
--If it is "false," it will use the old brute force method.
--just feeds into others.
--Preliminary results indicate that the program will run MUCH faster if you use the "true" option,
KR = K -> (
--but it is not 100% vetted yet. there might well be mistakes hiding in there. Let the user beware.
if K#?KR then return K#KR else (

if not K#?braid then error "no braid representation" else (
--this program now produces a complex homotopic to the Rouquier complex of the input braid,
Kb=K#braid;
--as well as a presentation for the module that corresponds to closing the braid (in matrix form).
P=K#nbcross=#Kb;
KR = (K,v) -> (
Ka=apply(Kb,abs);
if not K#?braid then error "no braid representation" else (
Kt=apply(Kb,i->(i>0));
Ks=sort Ka;
Kb:=K#braid;
--error Ks;
P:=K#nbcross=#Kb;
bind=K#bindex=last(Ks)+1;
Ka:=apply(Kb,abs);
R=QQ[vars(1 .. 2*P+bind)];
Kt:=apply(Kb,i->(i>0));
Kmod = chainComplex( gradedModule(R^1));
Ks:=sort Ka;
Cvars=new MutableList from toList (0..bind);
bind:=K#bindex=last(Ks)+1;
--error Cvars#3;
Cvars:=new MutableList from toList (-bind..-1);
for I from 0 to P-1 do (
I:=0;
J:=0;
Kmod=Kmod**KhMods(Cvars#(Ka_I)-1,Cvars#(Ka_I+1)-1,bind+2*I,R,Kt_I);
Cvars#(Ka_I)=bind+2*I+1;
Kp:={};
Cvars#(Ka_I+1)=bind+2*I+2;
newv:=0;
while I<P do (
);
print I;
Ml=toList (1..bind);
M:=1;
M=matrix {apply(Ml, I-> R_(Cvars#I-1)-R_(I-1))};
while (Kb#?(I+M) and Kb#(I+M)==Kb#I) do M=M+1;
K#KR=Torify(Kmod,M);
return K#KR)
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.
--this function just makes the modules used in the complex above.
KhMods = (H,I,J,S,W) -> (
IImod = (H,I,J,W,n,S) -> (
Mp=S^1/ideal(S_H+S_I-S_J-S_(J+1),S_H*S_I-S_J*S_(J+1));
i:=ideal(S_H+S_I-S_J-S_(J+1),S_H*S_I-S_J*S_(J+1));
if W then (
Np=S^{-1}/ideal(S_H-S_J,S_I-S_(J+1));
C=stmod(H,I,J,W,S)**S^{-n+1};
Mn=S^{1}/ideal(S_H+S_I-S_J-S_(J+1),S_H*S_I-S_J*S_(J+1));
L=singleton(C.dd_1);
Nn=S^{1}/ideal(S_H-S_J,S_I-S_(J+1));
for j from 2 to n do (
if W then C=chainComplex(map(Mp,Np,(S_J-S_I))) else C=chainComplex(map(Nn,Mn))[1];
if mod(j,2)==0 then L=prepend(map(S^{-n+j}/i,S^{-n+j-1}/i,S_H-S_J),L)
C)
else L=prepend(map(S^{-n+j}/i,S^{-n+j-1}/i,S_I-S_J),L);
);
D=chainComplex L;
)
else (
C=stmod(H,I,J,W,S)**S^{n-1};
L=singleton(C.dd_0);
for j from 2 to n do (
if mod(j,2)==0 then L=append(L,map(S^{n-j+2}/i,S^{n-j+1}/i,S_H-S_J))
else L=append(L,map(S^{n-j+2}/i,S^{n-j+1}/i,S_I-S_J));
);
D=(chainComplex L)[n];
);
D)

--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.
--these extend Macaulay2's ability to take tensor products and induced maps.
Line 156: Line 293:
D)
D)


inducedchainMap = (C,D,f) -> (
inducedchainMap = (C,D) -> (
map(
map(
C,D,i->inducedMap(C_i,D_i)
C,D,i->( inducedMap(C_i,D_i)) --print "found another induced map";
)
)
)
)


chainhomology = (FB,GB) -> (
--This has input a chain complex C and output a list of the complexes
CB:=source FB;
--Tor^i(C,coker M), provided M is a regular sequence.
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) -> (
Torify = (C,M) -> (
J:=rank source M;
J:=rank source M;
KD:=apply(J+2,I->(print ("took tensor product " | toString I); C**koszul(I,M)));
L:=(0..J);
Lt=apply(L,I->(
Lt=apply(J+1,I->(
F:=koszul(I,M);
F:=KD_I;
G:=koszul(I+1,M);
G:=KD_(I+1);
E:=inducedchainMap(ker F,image G);
FB=C**F;
print ("found E " | toString I);
GB=C**G;
CB=source FB;
H:=coker E;
print ("found K-homology " | toString I);
--error CB==target GB;
H));
H=inducedchainMap(ker FB,image GB,id_CB);
Lt)
--error H;
E=coker H;
E));
Lt)


--input, a link. output, KR homology (as modules). this is less useful than you think, just because of the difficulty of reading the output.
--This has input a braid, output the K-homology of KR double complex (i.e. the complexes of Tor's)
KRHom = K -> (
KRHom = (K,v) -> (
L:=Torify(KR(K,v));
if K#?KRHom then N:=K#KRHom else (
L:=KR(K);
M:=apply(L,homology);
M:=apply(L,homology);
N:=apply(M,prune);
N:=apply(M,prune);
K#KRHom=N;
K#KRHom=N;
);
N)
stack(apply(N,net)))


--This sends a chain complex to the list of degrees for which Macaulay2 remembers a module in it.
spots = C -> select(keys C, i -> class i === ZZ)
spots = C -> select(keys C, i -> class i === ZZ)


Line 198: Line 335:
--input, a knot K. output ((1-t)/(1+q*t))*(the graded Hilbert
--input, a knot K. output ((1-t)/(1+q*t))*(the graded Hilbert
--polynomial of K). THIS CURRENTLY ONLY WORKS FOR KNOTS, NOT LINKS.
--polynomial of K). THIS CURRENTLY ONLY WORKS FOR KNOTS, NOT LINKS.
KRpoly = K -> (
KRpoly = (K,v) -> (
L:=KRHom(K,v);
if K#?KRpoly then return K#KRpoly;
if not K#?KRHom then KRHom(K);
L:=K#KRHom;
R:=ring L_0;
R:=ring L_0;
print "hello";
Rn:=#generators R;
Rn:=#generators R;
S:=QQ[t];
S:=QQ[t];
Line 219: Line 355:
));
));
K#KRpoly=P;
K#KRpoly=P;
--I'm commenting this line out, as it causes the program to fail on everything but K01... Scott
-- if not isSubset(ideal(q*t+1),ideal(P)) then error (ideal(q*t+1),ideal(P));
P//(q*t+1))
P//(q*t+1))

--Basically the same as KRHom with more readable output.
KRdisp =K -> (
KRdisp =(K,v) -> (
if not K#?KRdeg then KRpoly K;
N=K#KRdeg;
L:=KRHom (K,v);
N:=stack(between(" ", apply(#L,i->net i | " " | net L_i)));
spoM=spots K#KRHom_0;
N)
net P || " " || ( " " || stack apply(spoM, net)) | " " | horizontalJoin between(" ", apply(
toList (0..#M-1),i-> net i || stack(
apply(
spoM,j->net(flatten(N_i j))
)
)
)
)
)
</pre>
</pre>

Latest revision as of 16:40, 24 April 2007

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.

Look for example at pages like 3_1 and Data:3_1/Khovanov_Rozansky_Polynomial.

Macaulay2 program

WARNING: This program is obsolete... and the newer version is probably broken. Complain to Ben?

Save this as a file (called KR.m2), open Macaulay2 (in command line or emacs), and type load "KR.m2". KRpoly is probably 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.

The program posted on Jan. 15 had a bug in it, and shouldn't be used. That bug is now fixed.


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));
     if W then (
	  C=stmod(H,I,J,W,S)**S^{-n+1};
     	  L=singleton(C.dd_1);
     	  for j from 2 to n do (
	       if mod(j,2)==0 then L=prepend(map(S^{-n+j}/i,S^{-n+j-1}/i,S_H-S_J),L)
	       else L=prepend(map(S^{-n+j}/i,S^{-n+j-1}/i,S_I-S_J),L);
	       );
	  D=chainComplex L;
	  )
     else (
	  C=stmod(H,I,J,W,S)**S^{n-1};
     	  L=singleton(C.dd_0);
     	  for j from 2 to n do (
	       if mod(j,2)==0 then L=append(L,map(S^{n-j+2}/i,S^{n-j+1}/i,S_H-S_J))
	       else L=append(L,map(S^{n-j+2}/i,S^{n-j+1}/i,S_I-S_J));
	       );
	  D=(chainComplex L)[n];
	  );
     D)

--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)
Retrieved from "https://katlas.org/index.php?title=User:Ben/KRhomology&oldid=120910"