(* ::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\\People\\LiuJ"];
<<KnotTheory`


(* ::Input::Initialization:: *)
Kas[X[i_,j_,k_,l_]]:=If[PositiveQ@X[i,j,k,l],
Kas[Perm[{-i,j,k,-l}],PQ[Subspace[{Subscript[y, -i],Subscript[y, j],Subscript[y, k],Subscript[y, -l]},{Subscript[y, -i],Subscript[y, j],Subscript[y, k],Subscript[y, -l]}],
1/2 (\!\(
\*SubsuperscriptBox[\(\[Eta]\), \(-i\), \(2\)] + \(2\ u\ 
\*SubscriptBox[\(\[Eta]\), \(-i\)]\ 
\*SubscriptBox[\(\[Eta]\), \(j\)]\) + \(v\ 
\*SubsuperscriptBox[\(\[Eta]\), \(j\), \(2\)]\) + \(2\ 
\*SubscriptBox[\(\[Eta]\), \(-i\)]\ 
\*SubscriptBox[\(\[Eta]\), \(k\)]\) + \(2\ u\ 
\*SubscriptBox[\(\[Eta]\), \(j\)]\ 
\*SubscriptBox[\(\[Eta]\), \(k\)]\) + 
\*SubsuperscriptBox[\(\[Eta]\), \(k\), \(2\)] + \(2\ u\ 
\*SubscriptBox[\(\[Eta]\), \(-i\)]\ 
\*SubscriptBox[\(\[Eta]\), \(-l\)]\) + \(2\ 
\*SubscriptBox[\(\[Eta]\), \(j\)]\ 
\*SubscriptBox[\(\[Eta]\), \(-l\)]\) + \(2\ u\ 
\*SubscriptBox[\(\[Eta]\), \(k\)]\ 
\*SubscriptBox[\(\[Eta]\), \(-l\)]\) + \(v\ 
\*SubsuperscriptBox[\(\[Eta]\), \(-l\), \(2\)]\)\))]],
Kas[Perm[{-i,-j,k,l}],PQ[Subspace[{Subscript[y, -j],Subscript[y, k],Subscript[y, l],Subscript[y, -i]},{Subscript[y, -j],Subscript[y, k],Subscript[y, l],Subscript[y, -i]}],
1/2 (-v \!\(\*SubsuperscriptBox[\(\[Eta]\), \(-i\), \(2\)]\)-2 u Subscript[\[Eta], -i] Subscript[\[Eta], -j]-\!\(\*SubsuperscriptBox[\(\[Eta]\), \(-j\), \(2\)]\)-2 Subscript[\[Eta], -i] Subscript[\[Eta], k]-2 u Subscript[\[Eta], -j] Subscript[\[Eta], k]-v \!\(\*SubsuperscriptBox[\(\[Eta]\), \(k\), \(2\)]\)-2 u Subscript[\[Eta], -i] Subscript[\[Eta], l]-2 Subscript[\[Eta], -j] Subscript[\[Eta], l]-2 u Subscript[\[Eta], k] Subscript[\[Eta], l]-\!\(\*SubsuperscriptBox[\(\[Eta]\), \(l\), \(2\)]\))]]
]


(* ::Input::Initialization:: *)
CF[Subspace[{},{0...}]]:=Subspace[{},{}];
CF[Subspace[vs_,{}]]:=Subspace[Sort[vs],{}];
CF[Subspace[vs_,gens_]]:=Module[{cvs=Sort[vs]},
Subspace[cvs,
DeleteCases[RowReduce[Table[Coefficient[g,v],{g,gens},{v,cvs}]] . cvs,0]
]]


(* ::Input::Initialization:: *)
Eval[Q_,v_,w_]:=Expand[Q v w]//. {Subscript[\[Eta], i_] Subscript[y, i_]:>1,\!\(
\*SubsuperscriptBox[\(\[Eta]\), \(i_\), \(2\)] 
\*SubsuperscriptBox[\(y\), \(i_\), \(2\)]\):>2}/.Subscript[(\[Eta]|y), _]->0;
Eval[\[Phi]_,v_]:=Expand[\[Phi] v]/.{Subscript[\[Eta], i_] Subscript[y, i_]:>1, \!\(
\*SubsuperscriptBox[\(\[Eta]\), \(i_\), \(2\)] 
\*SubscriptBox[\(y\), \(i_\)]\):>2Subscript[\[Eta], i]}/.Subscript[y, _]->0;


(* ::Input::Initialization:: *)
Pivot[v_Plus]:=v[[1]]; Pivot[v_]:=v;
\!\(
\*SubsuperscriptBox[\(y\), \(i_\), \(*\)] := 
\*SubscriptBox[\(\[Eta]\), \(i\)]\); \!\(
\*SubsuperscriptBox[\(\[Eta]\), \(i_\), \(*\)] := 
\*SubscriptBox[\(y\), \(i\)]\); SuperStar[(vs_List)]:=Table[SuperStar[v],{v,vs}];


(* ::Input::Initialization:: *)
CF[PQ[sub_Subspace,Q_]]:=Module[{csub,cvs,cgens},
{cvs,cgens}=List@@(csub=CF[sub]);
PQ[csub,Sum[Eval[Q,v,w]SuperStar[Pivot[v]] SuperStar[Pivot[w]]/2,{v,cgens},{w,cgens}]]
]


(* ::Input::Initialization:: *)
Perp[Subsp_]:=Module[{pp, cvs, cgens},
{cvs, cgens}=List@@CF@Subsp;
pp=SuperStar[Complement[cvs,Pivot/@cgens]];
CF@Subspace[SuperStar[cvs],
Table[p-Sum[Coefficient[g,SuperStar[p]]SuperStar[Pivot[g]],{g,cgens}],{p,pp}]
]
]


(* ::Input::Initialization:: *)
Id[vs_]:=LT[vs,vs,Table[v->v,{v,vs}]]


(* ::Input::Initialization:: *)
SuperStar[LT[dom_,ran_,rs_]][Subspace[ran_,gens_]]:= Perp@CF@Subspace[SuperStar[dom],Table[
Sum[Eval[p,v/.rs]SuperStar[v],{v,dom}],
{p,Perp[Subspace[ran,gens]][[2]]}
]]


(* ::Input::Initialization:: *)
SubStar[LT[dom_,ran_,rs_]][Subspace[dom_,gens_]]:= CF@Subspace[ran,gens/.rs]


(* ::Input::Initialization:: *)
SuperStar[LT[dom_,ran_,rs_]][PQ[sub_,Q_]]:= CF@PQ[
SuperStar[LT[dom,ran,rs]][sub],
Sum[Eval[Q,v1/.rs,v2/.rs]SuperStar[v1] SuperStar[v2]/2,{v1,dom},{v2,dom}]
]


(* ::Input::Initialization:: *)
Subspace/:Subspace[vs_,gen1s_]+Subspace[vs_,gen2s_]:=CF@Subspace[vs,gen1s \[Union]gen2s]
Subspace/:sub1_Subspace\[Intersection]sub2_Subspace:=Perp[Perp[sub1]+Perp[sub2]]


(* ::Input::Initialization:: *)
Subspace/:v_\[Element]Subspace[vs_, gens_]:=(Subspace[vs, gens]\[Intersection]Subspace[vs, {v}])[[2]]=!={}


(* ::Input::Initialization:: *)
Subscript[Ann, PQ[\[ScriptCapitalD]_Subspace,Q_]][Subspace[vs_,gens_]]:=\[ScriptCapitalD]\[Intersection]Perp@Subspace[SuperStar[vs],Table[Eval[Q,g],{g,gens}]]


(* ::Input::Initialization:: *)
Ker[LT[{},_,_]]:=Subspace[{},{}];
Ker[LT[dom_,{},_]]:=Subspace[dom,dom];
Ker[LT[dom_,ran_,rs_]]:=Module[{ns},
ns=NullSpace[Table[Coefficient[d/.rs,r],{r,ran},{d,dom}]];
If[Length@ns>0,CF@Subspace[dom,ns . dom],Subspace[dom,{}]]
]



