(* ::Package:: *)

BeginPackage["vKh`"]; Print["Loading vKh`..."]

CD; X; GausstoCD1; GausstoCD; Polyarray; Polyplot; R1; R2; R; V; vp; vm; KhBracket; v; d1; sgn; d2; d; np; nm; Deg; CC; Betti; qBetti; vKh

GausstoCD1[s_String]:=ToExpression[FlattenAt[{Flatten[StringReplace[StringSplit[s,{"+","-"}],{"O" :> "+", "U" :> "-"}]],StringReverse[Flatten[DeleteDuplicates[StringSplit[s,{"O","U"}]]]]},1]]

GausstoCD[s_String]:=CD[Table[{i},{i,StringLength[s]/6}]] /. {{i_} :> X[Mod[First[Position[GausstoCD1[s],i]][[1]],StringLength[s]/3],Mod[First[Position[GausstoCD1[s],-i]][[1]],StringLength[s]/3],Mod[First[Position[GausstoCD1[s],i]][[1]]+1,StringLength[s]/3],Mod[First[Position[GausstoCD1[s],-i]][[1]]+1,StringLength[s]/3]] /; (GausstoCD1[s][[-1]])[[i]]<0,{i_} :> X[Mod[First[Position[GausstoCD1[s],i]][[1]],StringLength[s]/3],Mod[First[Position[GausstoCD1[s],-i]][[1]]+1,StringLength[s]/3],Mod[First[Position[GausstoCD1[s],i]][[1]]+1,StringLength[s]/3],Mod[First[Position[GausstoCD1[s],-i]][[1]],StringLength[s]/3]] /; (GausstoCD1[s][[-1]])[[i]]>0} /. 0:> StringLength[s]/3/. CD[{a_,b__}]:> CD[a,b] /. X[i_,j_,k_,l_] :> X[i,l,k,j]

(*GausstoCD takes a string of sign. Gausscode (O=over, U=under, +=positive crossing, -=negative crossing) as Input and returns the corresponding CD representation. Important: The Gausscode has to start at the first undercrossing (U). Example: In:GausstoCD["U1+O2+O1+U2+"] Out:CD[X[1,4,2,3],X[4,3,1,2]]*)

Polyarray[s_String]:= (u1:=ToExpression[StringSplit[s,"+"]]; u2:= u1 /. {_*t^(y_):> y, _*t:> 1,t^(y_):> y,t:> 1} /. {_*q^_:>0,q^_:>0,_*q:>0,q:> 0}; u3:= u1 /. {_*q^(y_):> y,_*q:> 1,q^(y_):> y,q:> 1} /. {_*t^_:>0,t^_:>0,_*t:>0,t:> 0}; u4:= Partition[Riffle[u2,u3],2]; Table[If[Position[u4,{j,i}]!= {},u1[[Max[Position[u4,{j,i}]]]] /.{t:> 1,q:> 1},0],{i,Max[u3],Min[u3],-1},{j,Min[u2],Max[u2]}])

Polyplot[s_String]:= ArrayPlot[Polyarray[s],Mesh->All, ColorFunction->Hue, ColorRules->{0->White}]

(*Polyplot can be used to plot the Khovanov ploynom as a matrix. Input is the polynom as a string*)

np[L_CD] := Count[L, X[i_,j_,k_,l_] /; j-l==1 || l-j>1];
nm[L_CD] := Count[L, X[i_,j_,k_,l_] /; l-j==1 || j-l>1]; 

(*np and nm take a link in CD as input and repeats the number of positive/negative crossings. Example: test:=CD[X[1,4,2,3],X[4,3,1,2]]; np[test]=2; nm[test=0]*) 

R1[L_CD, s_String] := R1[L, Characters[s] /. {"0" -> 0, "1" -> 1}]
R1[L_CD, a_List] := Times @@ (Thread[{Thread[{List @@ L, a}],Range[Count[L, X[i_,j_,k_,l_]]]}] /. {
  {{X[i_,j_,k_,l_], 0},o_} :> g[{o,1,0,j,i,Min[i,j],-1,Min[i,j],-1}]g[{o,0,0,l,k,Min[k,l],1,Min[k,l],-1}],
  {{X[i_,j_,k_,l_], 1},o_} :> g[{o,1,1,j,k,Min[j,k],-1,Min[j,k],-1}]g[{o,0,1,l,i,Min[i,l],1,Min[i,l],-1}],
  {x_X, "*"} :> x
}) 

(*R1 takes a CD link + list of 0,1 as input. Here 0=0-resolution 1=1-resolution at the corresponding position. The output is a product of g[{variable}] with variable=(crossing number, 0= left or lower 1=rigth or upper string in the resolution, 0 or 1 resolution, two entries for calculations of the connections, string number, 1=marker -1=no marker, again string number, orientation -1=no choice yet, 0= standard 1=reversed Example: In:R1[test,{0,0}] Out:g[{1,0,0,3,2,2,1,2,-1}] g[{1,1,0,4,1,1,-1,1,-1}] g[{2,0,0,2,1,1,1,1,-1}] g[{2,1,0,3,4,3,-1,3,-1}]).*)

R2[L_CD, s_String] := R2[L, Characters[s] /. {"0" -> 0, "1" -> 1}]
R2[L_CD, a_List] := Flatten[R1[L,a] //. {g[{v1_,v2_,v3_,i_,j_,x1_,y1_,w1_,v5_}]g[{v6_,v8_,v9_,j_,k_,x2_,y2_,w2_,v10_}] :> g[{v1,v2,v3,i,k,Min[x1,x2],y1,w1,v5}],
g[{v1_,v2_,v3_,i_,j_,x1_,y1_,w1_,v5_}]g[{v6_,v8_,v9_,k_,j_,x2_,y2_,w2_,v10_}] :> g[{v1,v2,v3,i,k,Min[x1,x2],y1,w1,v5}]} //. g[{v1_,v2_,v3_,i_,j_,x1_,y1_,v4_,v5_}] :> c[x1]/. c[x1_]^_ :> c[x1] //. c[x_]g_:> {x,g} /. c[x_]:> {x}]

(*R2 has the same in as R1. Out is the number of circles in the resolution together with the number of the circles. Example: R2[test,{1,1}] Out:{1,2}*)

R[L_CD, s_String] := R[L, Characters[s] /. {"0" -> 0, "1" -> 1}]
R[L_CD,a_List] := Product[ReplacePart[R1[L,a] ,{{Min[Position[R1[L,a],g[{x__,R2[L,a][[i1]],-1}]]],_,-1} -> 0,{Min[Position[R1[L,a],g[{x__,R2[L,a][[i1]],-1}]]],_,-4} -> i1}],{i1,1, Length[R2[L,a]]}]//. g[x_]^_:> g[x] //. g[{x__,t1_,x1_,x2_,-1}]g[{x__,t2_,x1_,x2_,0}] :>  g[{x,t2,x1,x2,0}]//. {g[{v1_,v2_,v3_,i_,j_,x1_,y1_,t1_,v5_}]g[{v6_,v8_,v9_,j_,k_,x2_,y2_,t2_,-1}] :> g[{v1,v2,v3,i,j,Min[x1,x2],y1,Min[t1,t2],v5}]g[{v6,v8,v9,j,k,Min[x1,x2],y2,Min[t1,t2],0}] /; v5 == 0,
g[{v1_,v2_,v3_,i_,j_,x1_,y1_,t1_,v5_}]g[{v6_,v8_,v9_,j_,k_,x2_,y2_,t2_,-1}] :> g[{v1,v2,v3,i,j,Min[x1,x2],y1,Min[t1,t2],v5}]g[{v6,v8,v9,j,k,Min[x1,x2],y2,Min[t1,t2],1}] /; v5 == 1,
g[{v1_,v2_,v3_,i_,j_,x1_,y1_,t1_,v5_}]g[{v6_,v8_,v9_,k_,j_,x2_,y2_,t2_,-1}] :> g[{v1,v2,v3,i,j,Min[x1,x2],y1,Min[t1,t2],v5}]g[{v6,v8,v9,k,j,Min[x1,x2],y2,Min[t1,t2],1}] /; v5 == 0,g[{v1_,v2_,v3_,i_,j_,x1_,y1_,t1_,v5_}]g[{v6_,v8_,v9_,k_,j_,x2_,y2_,t2_,-1}] :> g[{v1,v2,v3,i,j,Min[x1,x2],y1,Min[t1,t2],v5}]g[{v6,v8,v9,k,j,Min[x1,x2],y2,Min[t1,t2],0}] /; v5 == 1,g[{v1_,v2_,v3_,j_,i_,x1_,y1_,t1_,v5_}]g[{v6_,v8_,v9_,j_,k_,x2_,y2_,t2_,-1}] :> g[{v1,v2,v3,j,i,Min[x1,x2],y1,Min[t1,t2],v5}]g[{v6,v8,v9,j,k,Min[x1,x2],y2,Min[t1,t2],0}] /; v5 == 1,
g[{v1_,v2_,v3_,j_,i_,x1_,y1_,t1_,v5_}]g[{v6_,v8_,v9_,j_,k_,x2_,y2_,t2_,-1}] :> g[{v1,v2,v3,j,i,Min[x1,x2],y1,Min[t1,t2],v5}]g[{v6,v8,v9,j,k,Min[x1,x2],y2,Min[t1,t2],1}] /; v5 == 0,
g[{v1_,v2_,v3_,j_,i_,x1_,y1_,t1_,v5_}]g[{v6_,v8_,v9_,k_,j_,x2_,y2_,t2_,-1}] :> g[{v1,v2,v3,j,i,Min[x1,x2],y1,Min[t1,t2],v5}]g[{v6,v8,v9,k,j,Min[x1,x2],y2,Min[t1,t2],1}] /; v5 == 1,g[{v1_,v2_,v3_,j_,i_,x1_,y1_,t1_,v5_}]g[{v6_,v8_,v9_,k_,j_,x2_,y2_,t2_,-1}] :> g[{v1,v2,v3,i,j,Min[x1,x2],y1,Min[t1,t2],v5}]g[{v6,v8,v9,k,j,Min[x1,x2],y2,Min[t1,t2],0}] /; v5 == 0}
(*R has the same in as R1. Out is a string of the resolution with all essiatial information, i.e. it sets the circle numbers and orientations (last two entries). Example: R[test,{1,1}] Out:g[{1,0,1,3,1,1,1,1,0}] g[{1,1,1,4,2,2,-1,2,0}] g[{2,0,1,2,4,2,1,2,0}] g[{2,1,1,3,1,1,-1,1,1}]. Here the only non standard orientation is the second string of the second crossing, i.e the 1 at the last position*)

Deg[expr_] := Count[expr, _vp, {0,1}] - Count[expr, _vm, {0,1}]

V[L_CD, s_String, deg___] := V[L, Characters[s] /. {"0" -> 0, "1" -> 1}, deg]
V[L_CD, a_List] := List @@ Expand[Times @@ (R2[L,a] /. x_Integer :> vp[x] + vm[x])]
V[L_CD, a_List, deg___] :=
  Select[V[L, a], (deg == Deg[#] + (Plus @@ a))&]

(*Deg, V have the same in as R1. Out is the quatum degree of an expression or the module ate the corresponding resolution. Here vp=1, vm=X with grad=1 or -1. vp[i],vm[i]=module of the i-th circle. Example: V[test,{1,1}] Out:{vm[1] vm[2],vm[2] vp[1],vm[1] vp[2],vp[1] vp[2]}. There are two circles, hence the module is a tensorpr of A\otimes A with the four basis elements X\otimes X, 1\otimes X, X\otimes 1 and 1\otimes 1*)

KhBracket[L_CD, r_Integer, deg___] := If[r<0 || r>Length[L], {},
  Join @@ ( ((v @@ #) V[L, #, deg])& /@
    Permutations[Join[Table[0, {Length[L] - r}], Table[1, {r}]]])]

CC[L_CD, r_Integer, deg_Integer] := KhBracket[L, r+nm[L], deg-np[L]+2nm[L]]

(*KhBracket and CC take L in CD + number +optimal number as input. Here number = position in the homology grade opt= degree. They just taking the direct sums of the corresponding modules. CC with grade shifts. Example: KhBracket[test,1] Out: {v[0,1] vm[1],v[0,1] vp[1],v[1,0] vm[1],v[1,0] vp[1]}; KhBracket[test,1,0] Out: {v[0,1] vm[1],v[1,0] vm[1]}*)

d1[L_CD, s_String] := d1[L, Characters[s] /. {"0" -> 0, "1" -> 1}]
d1[L_CD, a_List] := {R[L,a /. "*" -> 0]//.{g[{v1_,v2_,v3_,i_,j_,x1_,y1_,w1_,v5_}] :> 1 /; v1 != Extract[Flatten[Position[a,"*"]],{1}]} //. g[{v1_,v2_,v3_,i_,j_,x1_,y1_,w1_,v5_}] :> g[v2,w1,x1,v3,v5],R[L, a/. "*" -> 1]
//.{g[{v1_,v2_,v3_,i_,j_,x1_,y1_,w1_,v5_}] :> 1/; v1!= Extract[Flatten[Position[a,"*"]],{1}]} //. g[{v1_,v2_,v3_,i_,j_,x1_,y1_,w1_,v5_}] :> g[v2,w1,x1,v3,v5]}

(*d1 takes L in CD and a list of 0,1,* as input. The * means the position of the change from 0->1 for the saddle. Out is all info needed for the saddle, i.e. a list with two entries, one for the source and one for the target, with 0=left,down or 1=up, rigth info, two circle numbers, position of the marker and orientation. Example: d1[test,{0,"*"}] Out: {g[0,1,1,1,1] g[1,1,1,-1,0],g[0,1,1,1,0] g[1,1,1,-1,1]}. The orientations are 1,0 in the source and 0,1 in the target, hence it is a projective plane saddle*)

sgn[L_CD, s_String] := sgn[L, Characters[s] /. {"0" -> 0, "1" -> 1}]
sgn[L_CD, a_List] :=Times @@(Total[d1[L,a]/. g[0,x__]g[1,x__]:> 0] /. g[0,x1_,w1_,y1_,v2_]g[1,x2_,w2_,y2_,v6_] :> {Mod[Length[R2[L,a /. "*"-> y1]]-Max[w1,w2],2] /. {0:>1, 1:> -1},Sign[w2-w1]}) /. 0:> 1

(*sgn has the same in as d1. Out is the sign of the saddle. Here sign(unorientable):=1. Example: {sgn[test,{0,"*"}],sgn[test,{"*",0}],sgn[test,{1,"*"}],sgn[test,{"*",1}]} Out={1,1,-1,1}*)

d2[L_CD, s_String] := d2[L, Characters[s] /. {"0" -> 0, "1" -> 1}]
d2[L_CD, a_List] := Times @@ {d1[L,a] /. g[v1_,x1_,w1_,y1_,v2_] :> g[v1,x1,y1,v2]//. {g[0,c1_,t1_,or1_] g[1,c2_,t2_,or2_],g[0,c3_,t3_,or3_] g[1,c4_,t4_,or4_]} :> {vp[c1]->0,vm[c1]->0} /; c1 == c2 && c3 == c4 //.{{g[0,c1_,t1_,0] g[1,c2_,t2_,0],g[0,c3_,t3_,0] g[1,c4_,t4_,0]} :> {vp[Min[c1,c2]] vp[Max[c1,c2]]->vp[c3], vp[Min[c1,c2]] vm[Max[c1,c2]]->vm[c3], vm[Min[c1,c2]] vp[Max[c1,c2]]->vm[c3], vm[Min[c1,c2]] vm[Max[c1,c2]]->0} /; (c1<c2 || c1>c2) && c3 == c4,
{g[0,c1_,t1_,0] g[1,c2_,t2_,1],g[0,c3_,t3_,0] g[1,c4_,t4_,0]} :> {vp[Min[c1,c2]] vp[Max[c1,c2]]->vp[c3], vp[Min[c1,c2]] vm[Max[c1,c2]]->-vm[c3], vm[Min[c1,c2]] vp[Max[c1,c2]]->vm[c3], vm[Min[c1,c2]] vm[Max[c1,c2]]->0} /; c1<c2 && c3 == c4,
{g[0,c1_,t1_,0] g[1,c2_,t2_,1],g[0,c3_,t3_,0] g[1,c4_,t4_,0]} :> {vp[Min[c1,c2]] vp[Max[c1,c2]]->vp[c3], vp[Min[c1,c2]] vm[Max[c1,c2]]->vm[c3], vm[Min[c1,c2]] vp[Max[c1,c2]]->-vm[c3], vm[Min[c1,c2]] vm[Max[c1,c2]]->0} /; c1>c2 && c3 == c4,
{g[0,c1_,t1_,1] g[1,c2_,t2_,0],g[0,c3_,t3_,0] g[1,c4_,t4_,0]} :> {vp[Min[c1,c2]] vp[Max[c1,c2]]->vp[c3], vp[Min[c1,c2]] vm[Max[c1,c2]]->vm[c3], vm[Min[c1,c2]] vp[Max[c1,c2]]->-vm[c3], vm[Min[c1,c2]] vm[Max[c1,c2]]->0} /; c1<c2 && c3 == c4,
{g[0,c1_,t1_,1] g[1,c2_,t2_,0],g[0,c3_,t3_,0] g[1,c4_,t4_,0]} :> {vp[Min[c1,c2]] vp[Max[c1,c2]]->vp[c3], vp[Min[c1,c2]] vm[Max[c1,c2]]->-vm[c3], vm[Min[c1,c2]] vp[Max[c1,c2]]->vm[c3], vm[Min[c1,c2]] vm[Max[c1,c2]]->0} /; c1>c2 && c3 == c4,
{g[0,c1_,t1_,1] g[1,c2_,t2_,1],g[0,c3_,t3_,0] g[1,c4_,t4_,0]} :> {vp[Min[c1,c2]] vp[Max[c1,c2]]->vp[c3], vp[Min[c1,c2]] vm[Max[c1,c2]]->-vm[c3], vm[Min[c1,c2]] vp[Max[c1,c2]]->-vm[c3], vm[Min[c1,c2]] vm[Max[c1,c2]]->0} /; (c1<c2 || c1>c2) && c3==c4,{g[0,c1_,t1_,0] g[1,c2_,t2_,0],g[0,c3_,t3_,1] g[1,c4_,t4_,1]} :> {vp[Min[c1,c2]] vp[Max[c1,c2]]->vp[c3], vp[Min[c1,c2]] vm[Max[c1,c2]]->-vm[c3], vm[Min[c1,c2]] vp[Max[c1,c2]]->-vm[c3], vm[Min[c1,c2]] vm[Max[c1,c2]]->0} /; (c1<c2 || c1>c2) && c3 == c4,
{g[0,c1_,t1_,0] g[1,c2_,t2_,1],g[0,c3_,t3_,1] g[1,c4_,t4_,1]} :> {vp[Min[c1,c2]] vp[Max[c1,c2]]->vp[c3], vp[Min[c1,c2]] vm[Max[c1,c2]]->vm[c3], vm[Min[c1,c2]] vp[Max[c1,c2]]->-vm[c3], vm[Min[c1,c2]] vm[Max[c1,c2]]->0} /; c1<c2 && c3 == c4,
{g[0,c1_,t1_,0] g[1,c2_,t2_,1],g[0,c3_,t3_,1] g[1,c4_,t4_,1]} :> {vp[Min[c1,c2]] vp[Max[c1,c2]]->vp[c3], vp[Min[c1,c2]] vm[Max[c1,c2]]->-vm[c3], vm[Min[c1,c2]] vp[Max[c1,c2]]->vm[c3], vm[Min[c1,c2]] vm[Max[c1,c2]]->0} /; c1>c2 && c3 == c4,
{g[0,c1_,t1_,1] g[1,c2_,t2_,0],g[0,c3_,t3_,1] g[1,c4_,t4_,1]} :> {vp[Min[c1,c2]] vp[Max[c1,c2]]->vp[c3], vp[Min[c1,c2]] vm[Max[c1,c2]]->-vm[c3], vm[Min[c1,c2]] vp[Max[c1,c2]]->vm[c3], vm[Min[c1,c2]] vm[Max[c1,c2]]->0} /; c1<c2 && c3 == c4,
{g[0,c1_,t1_,1] g[1,c2_,t2_,0],g[0,c3_,t3_,1] g[1,c4_,t4_,1]} :> {vp[Min[c1,c2]] vp[Max[c1,c2]]->vp[c3], vp[Min[c1,c2]] vm[Max[c1,c2]]->vm[c3], vm[Min[c1,c2]] vp[Max[c1,c2]]->-vm[c3], vm[Min[c1,c2]] vm[Max[c1,c2]]->0} /; c1>c2 && c3 == c4,
{g[0,c1_,t1_,1] g[1,c2_,t2_,1],g[0,c3_,t3_,1] g[1,c4_,t4_,1]} :> {vp[Min[c1,c2]] vp[Max[c1,c2]]->vp[c3], vp[Min[c1,c2]] vm[Max[c1,c2]]->vm[c3], vm[Min[c1,c2]] vp[Max[c1,c2]]->vm[c3], vm[Min[c1,c2]] vm[Max[c1,c2]]->0} /; (c1<c2 || c1>c2) && c3==c4} //. {{g[0,c1_,t1_,0] g[1,c2_,t2_,0],g[0,c3_,t3_,0] g[1,c4_,t4_,0]} :> {vp[c1]->vp[Min[c3,c4]]vm[Max[c3,c4]] + vm[Min[c3,c4]] vp[Max[c3,c4]], vm[c1]->vm[Min[c3,c4]] vm[Max[c3,c4]]} /; c1 == c2 && (c3<c4 || c3>c4),
{g[0,c1_,t1_,0] g[1,c2_,t2_,0],g[0,c3_,t3_,0] g[1,c4_,t4_,1]} :> {vp[c1]->-vp[Min[c3,c4]]vm[Max[c3,c4]] + vm[Min[c3,c4]] vp[Max[c3,c4]], vm[c1]->-vm[Min[c3,c4]] vm[Max[c3,c4]]} /; c1 == c2 && c3<c4,
{g[0,c1_,t1_,0] g[1,c2_,t2_,0],g[0,c3_,t3_,0] g[1,c4_,t4_,1]} :> {vp[c1]->vp[Min[c3,c4]]vm[Max[c3,c4]] - vm[Min[c3,c4]] vp[Max[c3,c4]], vm[c1]->-vm[Min[c3,c4]] vm[Max[c3,c4]]} /; c1 == c2 && c3>c4,
{g[0,c1_,t1_,0] g[1,c2_,t2_,0],g[0,c3_,t3_,1] g[1,c4_,t4_,0]} :> {vp[c1]->vp[Min[c3,c4]]vm[Max[c3,c4]] - vm[Min[c3,c4]] vp[Max[c3,c4]], vm[c1]->-vm[Min[c3,c4]] vm[Max[c3,c4]]} /; c1 == c2 && c3<c4,
{g[0,c1_,t1_,0] g[1,c2_,t2_,0],g[0,c3_,t3_,1] g[1,c4_,t4_,0]} :> {vp[c1]->-vp[Min[c3,c4]]vm[Max[c3,c4]] + vm[Min[c3,c4]] vp[Max[c3,c4]], vm[c1]->-vm[Min[c3,c4]] vm[Max[c3,c4]]} /; c1 == c2 && c3>c4,
{g[0,c1_,t1_,0] g[1,c2_,t2_,0],g[0,c3_,t3_,1] g[1,c4_,t4_,1]} :> {vp[c1]->-vp[Min[c3,c4]]vm[Max[c3,c4]] - vm[Min[c3,c4]] vp[Max[c3,c4]], vm[c1]->vm[Min[c3,c4]] vm[Max[c3,c4]]} /; c1 == c2 && (c3<c4 || c3>c4),{g[0,c1_,t1_,1] g[1,c2_,t2_,1],g[0,c3_,t3_,0] g[1,c4_,t4_,0]} :> {vp[c1]->vp[Min[c3,c4]]vm[Max[c3,c4]] + vm[Min[c3,c4]] vp[Max[c3,c4]], vm[c1]->-vm[Min[c3,c4]] vm[Max[c3,c4]]} /; c1 == c2 && (c3<c4 || c3>c4),
{g[0,c1_,t1_,1] g[1,c2_,t2_,1],g[0,c3_,t3_,0] g[1,c4_,t4_,1]} :> {vp[c1]->-vp[Min[c3,c4]]vm[Max[c3,c4]] + vm[Min[c3,c4]] vp[Max[c3,c4]], vm[c1]->vm[Min[c3,c4]] vm[Max[c3,c4]]} /; c1 == c2 && c3<c4,
{g[0,c1_,t1_,1] g[1,c2_,t2_,1],g[0,c3_,t3_,0] g[1,c4_,t4_,1]} :> {vp[c1]->vp[Min[c3,c4]]vm[Max[c3,c4]] - vm[Min[c3,c4]] vp[Max[c3,c4]], vm[c1]->vm[Min[c3,c4]] vm[Max[c3,c4]]} /; c1 == c2 && c3>c4,
{g[0,c1_,t1_,1] g[1,c2_,t2_,1],g[0,c3_,t3_,1] g[1,c4_,t4_,0]} :> {vp[c1]->vp[Min[c3,c4]]vm[Max[c3,c4]] - vm[Min[c3,c4]] vp[Max[c3,c4]], vm[c1]->vm[Min[c3,c4]] vm[Max[c3,c4]]} /; c1 == c2 && c3<c4,
{g[0,c1_,t1_,1] g[1,c2_,t2_,1],g[0,c3_,t3_,1] g[1,c4_,t4_,0]} :> {vp[c1]->-vp[Min[c3,c4]]vm[Max[c3,c4]] + vm[Min[c3,c4]] vp[Max[c3,c4]], vm[c1]->vm[Min[c3,c4]] vm[Max[c3,c4]]} /; c1 == c2 && c3>c4,
{g[0,c1_,t1_,1] g[1,c2_,t2_,1],g[0,c3_,t3_,1] g[1,c4_,t4_,1]} :> {vp[c1]->-vp[Min[c3,c4]]vm[Max[c3,c4]] - vm[Min[c3,c4]] vp[Max[c3,c4]], vm[c1]->-vm[Min[c3,c4]] vm[Max[c3,c4]]} /; c1 == c2 && (c3<c4 || c3>c4)} ,sgn[L,a]} /. {-(x_ -> y_) :> (x -> -y)}

(*d2 has the same in as d1. It calculates the saddle itself (without the sign) based on the table of different possibilities. Out is the replacement rule for the saddle. Example: d2[test,{1,"*"}] Out={vp[1]->-vm[2] vp[1]+vm[1] vp[2],vm[1]->-vm[1] vm[2]}, hence 1 -> -1\otimes X + X\otimes 1 and X -> -X\otimes X*)

d[L_CD][expr_] := Expand[expr] /. s_*a_v :> Expand[Sum[ If[ a[[i]]==0,
    ReplacePart[a, 1, i] * s /.  d2[L, List @@ ReplacePart[a, "*", i]], 0
  ], {i, Length[a]} ]]

(*d itself takes L in CD + expression. Here expression is the corresponding module and d calc. the image of the whole differential. Example: d[test][KhBracket[test,0]] Out={0,0}, because of two 0-maps, and d[test][KhBracket[test,1]] Out:{v[1,1] vm[1] vm[2],v[1,1] vm[2] vp[1]+v[1,1] vm[1] vp[2],-v[1,1] vm[1] vm[2],-v[1,1] vm[2] vp[1]+v[1,1] vm[1] vp[2]}*)

Rank[L_CD, r_Integer, deg_Integer, opts_: Infinity] := Rank[L,r,deg,opts] = (
  modulus = opts;
  l0=Length[b0 = CC[L, r, deg]]; l1 = Length[b1 = CC[L, r+1, deg]];
  eqs = If[b0 == {} || l1 == 0,{{0}},Transpose[d[L][b0] /.MapThread[Rule, {b1, Array[ba, l1]}]/. {ba[i_]:> SparseArray[{i}-> 1,{l1}], 0:> Array[0&,{l1}]}]];
  rk = Which[b0 == {} || l1 == 0,0,
   modulus === Infinity, MatrixRank[eqs],
    True, MatrixRank[eqs,Modulus->opts]];
  rk
)

(*rank L in CD + homology grade + q-degree + optional modulus as input and calculates the rank of the differential. Example: Rank[test,1,2] Out=1, hence one lin. idependent element in the image of the second diff. of degree 2*)

Betti[L_CD, r_Integer, deg_Integer, opts_: Infinity] := Betti[L,r,deg,opts] = Which[opts==Infinity,(
  b = Length[CC[L,r,deg]]-Rank[L,r,deg,opts]-Rank[L,r-1,deg,opts];
  Print[StringForm["Betti[``,``] = ``", r, deg, b]]; b
),True,(
  b = -Rank[L,r-1,deg,opts]+Rank[L,r-1,deg,Infinity];
  Print[StringForm["Tor[``,``] = ``", r, deg, b]]; b
)]

qBetti[L_CD, r_Integer, opts_: Infinity] := (
  degs = Union[Deg /@ KhBracket[L, r+nm[L]]] + np[L] - nm[L] + r;
  (Betti[L, r, #, opts]& /@ degs) . q^degs
)

vKh[L_CD, opts_: Infinity] := vKh[L, opts] =
  Expand[Sum[t^r * qBetti[L, r, opts], {r, -nm[L], Length[L]-nm[L]}]]

vJones[L_CD, opts_: Infinity] := vJones[L, opts] = Expand[(vKh[L, opts] /. t->-1)]

(*the rest just uses all info from before to calculate the corresponding homology degree based on the Rank theorem*)
EndPackage[]
