(* ::Package:: *)

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

(* ::Input::Initialization:: *)
SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\Theta"];
Once[<<KnotTheory`]


(* ::Input::Initialization:: *)
Subscript[\[Chi], False]=0; Subscript[\[Chi], True]=1;


(* ::Input::Initialization:: *)
CF[\[ScriptCapitalE]_] := Expand@Collect[\[ScriptCapitalE],Subscript[g, __],F]/.F->Factor;


(* ::Input::Initialization:: *)
Subscript[T, 3]=Subscript[T, 1] Subscript[T, 2];


(* ::Input::Initialization:: *)
Subscript[F, 1][{s_,i_,j_}]:=CF[
s(1/2-Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]+\!\(
\*SubsuperscriptBox[\(T\), \(2\), \(s\)] 
\*SubscriptBox[\(g\), \(1\[InvisibleComma]i\[InvisibleComma]i\)] 
\*SubscriptBox[\(g\), \(2\[InvisibleComma]j\[InvisibleComma]i\)]\)-Subscript[g, 1\[InvisibleComma]i\[InvisibleComma]i] Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]j]-(\!\(
\*SubsuperscriptBox[\(T\), \(2\), \(s\)] - 1\))Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]+2Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]j] Subscript[g, 3\[InvisibleComma]i\[InvisibleComma]i]-(1-\!\(\*SubsuperscriptBox[\(T\), \(3\), \(s\)]\))Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i]-Subscript[g, 2\[InvisibleComma]i\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]j]-\!\(
\*SubsuperscriptBox[\(T\), \(2\), \(s\)] 
\*SubscriptBox[\(g\), \(2\[InvisibleComma]j\[InvisibleComma]i\)] 
\*SubscriptBox[\(g\), \(3\[InvisibleComma]j\[InvisibleComma]j\)]\)+Subscript[g, 1\[InvisibleComma]i\[InvisibleComma]i] Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]j]+((\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(s\)] - 1\))Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]i](\!\(
\*SubsuperscriptBox[\(T\), \(2\), \(2  s\)] 
\*SubscriptBox[\(g\), \(2\[InvisibleComma]j\[InvisibleComma]i\)]\)-\!\(
\*SubsuperscriptBox[\(T\), \(2\), \(s\)] 
\*SubscriptBox[\(g\), \(2\[InvisibleComma]j\[InvisibleComma]j\)]\)+\!\(
\*SubsuperscriptBox[\(T\), \(2\), \(s\)] 
\*SubscriptBox[\(g\), \(3\[InvisibleComma]j\[InvisibleComma]j\)]\))+(\!\(
\*SubsuperscriptBox[\(T\), \(3\), \(s\)] - 1\))Subscript[g, 3\[InvisibleComma]j\[InvisibleComma]i](1-\!\(
\*SubsuperscriptBox[\(T\), \(2\), \(s\)] 
\*SubscriptBox[\(g\), \(1\[InvisibleComma]i\[InvisibleComma]i\)]\)+Subscript[g, 2\[InvisibleComma]i\[InvisibleComma]j]+(\!\(
\*SubsuperscriptBox[\(T\), \(2\), \(s\)] - 2\))Subscript[g, 2\[InvisibleComma]j\[InvisibleComma]j]-(\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(s\)] - 1\))(\!\(
\*SubsuperscriptBox[\(T\), \(2\), \(s\)] + 1\)) Subscript[g, 1\[InvisibleComma]j\[InvisibleComma]i]))/(\!\(
\*SubsuperscriptBox[\(T\), \(2\), \(s\)] - 1\)))]


(* ::Input::Initialization:: *)
Subscript[F, 2][{s0_,i0_,j0_},{s1_,i1_,j1_}]:=CF[s1(\!\(
\*SubsuperscriptBox[\(T\), \(1\), \(s0\)] - 1\))(\!\(
\*SubsuperscriptBox[\(T\), \(2\), \(s1\)] - 1\))^-1 (\!\(
\*SubsuperscriptBox[\(T\), \(3\), \(s1\)] - 1\))Subscript[g, 1,j1,i0] Subscript[g, 3,j0,i1]( (\!\(
\*SubsuperscriptBox[\(T\), \(2\), \(s0\)] 
\*SubscriptBox[\(g\), \(2, i1, i0\)]\)-Subscript[g, 2,i1,j0])- (\!\(
\*SubsuperscriptBox[\(T\), \(2\), \(s0\)] 
\*SubscriptBox[\(g\), \(2, j1, i0\)]\)-Subscript[g, 2,j1,j0]))]


(* ::Input::Initialization:: *)
Rot[X_List]:=X;
Rot[K_]:=Cases[PD[K],x_X:>\[Piecewise]{
 {{1,x[[4]],x[[1]]}, PositiveQ@x},
 {{-1,x[[2]],x[[1]]}, True}
}]


(* ::Input::Initialization:: *)
Res[K_]:=Module[{X,n,A,G,ev,r,k,k1,k2},
(* 1 *) X=Rot[K]; n=Length[X]; A=IdentityMatrix[2n+1];
(* 2 *) Cases[X,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=({
 {-T^s, T^s-1},
 {0, -1}
}))];
(* 3 *) G=Inverse[A];
(* 4 *) ev[\[ScriptCapitalE]_]:=Factor[\[ScriptCapitalE] /. SuperPlus[i_]:> i+1 /.Subscript[g, \[Alpha]_,\[Beta]_]:>G[[\[Alpha],\[Beta]]]];
(* 5 *) r=ev[Sum[F1[X[[k]]], {k,n}]];
(* 6 *) r+=ev[Sum[F2[X[[k1]],X[[k2]]], {k1,n}, {k2,n}]];
(* 7 *) Factor[r]
];


(* ::Input::Initialization:: *)
RandomVK[n_]:=Prepend[#,2RandomInteger[1]-1]&/@Partition[PermutationList[RandomPermutation[2n],2n],2];


(* ::Input::Initialization:: *)
nRules[{s_,i_,j_}]:={
Subscript[g, j,\[Beta]_]:>Subscript[g, SuperPlus[j],\[Beta]],Subscript[g, i,\[Beta]_]:>T^s Subscript[g, SuperPlus[i],\[Beta]]+(1-T^s)Subscript[g, SuperPlus[j],\[Beta]],Subscript[g, \[Alpha]_,SuperPlus[i]]:>T^s Subscript[g, \[Alpha],i],Subscript[g, \[Alpha]_,SuperPlus[j]]:>Subscript[g, \[Alpha],j]+(1-T^s)Subscript[g, \[Alpha],i],
Subscript[\[Chi], j<=\[Beta]_]:>Subscript[\[Chi], SuperPlus[j]<=\[Beta]],Subscript[\[Chi], i<=\[Beta]_]:>Subscript[\[Chi], SuperPlus[i]<=\[Beta]],Subscript[\[Chi], \[Alpha]_<=SuperPlus[i]]:>Subscript[\[Chi], \[Alpha]<=i],Subscript[\[Chi], \[Alpha]_<=SuperPlus[j]]:>Subscript[\[Chi], \[Alpha]<=j]
};
nRules[X___List]:=Union@@Table[nRules[c],{c,{X}}]


(* ::Input::Initialization:: *)
\!\(\*SubscriptBox[\(D\), \({s_, i_, j_}\)]\)[\[ScriptCapitalE]_]:=CF[((\[ScriptCapitalE]/.#->SuperPlus[i])+(\[ScriptCapitalE]/.#->SuperPlus[j])-(\[ScriptCapitalE]/.#->i)-(\[ScriptCapitalE]/.#->j))/.nRules[{s,i,j}]]



