(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



(* ::Input::Initialization:: *)
SetDirectory["C:\\drorbn\\AcademicPensieve\\Classes\\23-FastComputations"];
Once[<<KnotTheory`]


(* ::Input::Initialization:: *)
Sign[X[i_,j_,k_,l_]]/;j-l==1\[Or]l-j>1 ^:= 1;
Sign[X[i_,j_,k_,l_]]/;l-j==1\[Or]j-l>1 ^:= -1;
w[pd_]:=Plus@@(Sign/@pd);


(* ::Input::Initialization:: *)
SetAttributes[p,Orderless]


(* ::Input::Initialization:: *)
m_\[Diamond]n_:=Min[m,n];
S[pd_PD,a_List]:=Times@@({List@@pd,a}\[Transpose]/.{
{x:X[i_,j_,k_,l_],0}:>q^(3/2 Sign[x]-1/2) t^(1/2 Sign[x]-1/2) Subscript[p[i,j], i\[Diamond]j] Subscript[p[k,l], k\[Diamond]l],
{x:X[i_,j_,k_,l_],1}:>q^(3/2 Sign[x]+1/2) t^(1/2 Sign[x]+1/2) Subscript[p[i,l], i\[Diamond]l] Subscript[p[j,k], j\[Diamond]k],
{x_X,\[FivePointedStar]}:>x
})//.Subscript[p[i_,j_], m_] Subscript[p[j_,k_], n_]:>Subscript[p[i,k], m\[Diamond]n]//.{X[i_,j_,k_,l_] Subscript[p[i_,j_], m_] Subscript[p[k_,l_], n_]:>(Subscript[c, m] Subscript[c, n]->Subscript[c, m\[Diamond]n]),X[i_,j_,k_,l_] Subscript[p[i_,l_], m_] Subscript[p[j_,k_], n_]:>(Subscript[c, m\[Diamond]n]->Subscript[c, m] Subscript[c, n])}//.\!\(
\*SubsuperscriptBox[\(p[__]\), \(m_\), \(_.\)] :> 
\*SubscriptBox[\(c\), \(m\)]\)


(* ::Input::Initialization:: *)
V[pd_PD,a_]:=List@@Expand[S[pd,a]/.Subscript[c, x_]:>(q Subscript[vp, x]+q^-1 Subscript[vm, x])]
V[pd_PD,a_,deg_]:=Select[V[pd,a],Exponent[#,q]==deg&]


(* ::Input::Initialization:: *)
d[pd_PD,a_]:=S[pd,a]/.{
(Subscript[c, x_] Subscript[c, y_]->Subscript[c, z_])*_.:>{Subscript[vp, x] Subscript[vp, y]->t Subscript[vp, z],Subscript[vp, x] Subscript[vm, y]->t Subscript[vm, z],Subscript[vm, x] Subscript[vp, y]->t Subscript[vm, z],Subscript[vm, x] Subscript[vm, y]->0},(Subscript[c, z_]->Subscript[c, x_] Subscript[c, y_])*_.:>{Subscript[vp, z]->t Subscript[vp, x] Subscript[vm, y]+t Subscript[vm, x] Subscript[vp, y],Subscript[vm, z]->t Subscript[vm, x] Subscript[vm, y]}}


(* ::Input::Initialization:: *)
CC[pd_PD,r_,deg_]:=Select[Union@@((v@@#) V[pd,#,deg]&/@Tuples[{0,1},Length@pd]), Exponent[#,t]==r&]


(* ::Input::Initialization:: *)
d[pd_PD][expr_]:=Expand[expr]/.s_*a_v:>Expand[sign=1;Sum[
If[a[[i]]==0,sign*ReplacePart[a,1,i]*s/.d[pd,List@@ReplacePart[a,\[FivePointedStar],i]],sign*=-1;0],{i,Length[a]}
]]


(* ::Input::Initialization:: *)
Rank[pd_PD,r_,deg_]:=(*Rank[pd,r,deg]=*)Module[{b0,b1,db0,ds0,s1},
b0=CC[pd,r,deg]; b1=CC[pd,r+1,deg];
If[b0=={}\[Or]b1=={}, 0,
db0=d[pd][b0];
MatrixRank[Table[Coefficient[ds0,s1],{ds0,db0},{s1,b1}]]
]
];


(* ::Input::Initialization:: *)
Betti[pd_PD,r_,deg_]:=Length[CC[pd,r,deg]]-Rank[pd,r,deg]-Rank[pd,r-1,deg]


(* ::Input::Initialization:: *)
Kh1[pd_PD]:=Sum[t^r q^deg Betti[pd,r,deg],
{r,-Length@pd,Length@pd},
{deg,Exponent[Plus@@V[pd,Table[0,Length@pd]],q,Min], Exponent[Plus@@V[pd,Table[1,Length@pd]],q,Max],2}
]


(* ::Input::Initialization:: *)
Kh1[pd_PD]:=Sum[t^r q^deg Betti[pd,r,deg],
{r,-Length@pd,Length@pd},
{deg,-3Length@pd,3Length@pd,1}
]



