(* ::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[<<Theta.m]
SetOptions[PolyPlot,ImageSize->Tiny];
Clear[\[CapitalTheta]]


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


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


(* ::Input::Initialization:: *)
Short[Options[\[CapitalTheta]]={F1->(F1i=Subscript[F, 1][{s0,i0,j0}]), F2->(F2i=Subscript[F, 2][{s0,i0,j0},{s1,i1,j1}]), F3->(F3i=Subscript[F, 3][\[CurlyPhi],k])}]


(* ::Input::Initialization:: *)
\[CapitalTheta][K_,opts___Rule]:=Module[{X,\[CurlyPhi]\[CurlyPhi],n,A,\[CapitalDelta],G,ev,\[Theta],kk,k0,k1,f1,f2,f3},
f1=F1/.{opts}/.Options[\[CapitalTheta]];
f2=F2/.{opts}/.Options[\[CapitalTheta]];
f3=F3/.{opts}/.Options[\[CapitalTheta]];
{X,\[CurlyPhi]\[CurlyPhi]}=Rot[K]; n=Length[X]; A=IdentityMatrix[2n+1];
Cases[X,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=({
 {-T^s, T^s-1},
 {0, -1}
}))];
\[CapitalDelta]=T^((-Total[\[CurlyPhi]\[CurlyPhi]]-Total[X[[All,1]]])/2) Det[A];
G=Inverse[A];
ev[\[ScriptCapitalE]_]:=Factor[\[ScriptCapitalE]/.{SuperPlus[k_]:>k+1,$->2n+1}/.{Subscript[g, \[Nu]_,\[Alpha]_,\[Beta]_]:>(G[[\[Alpha],\[Beta]]]/.T->Subscript[T, \[Nu]]),Subscript[\[Chi], True]->1,Subscript[\[Chi], False]->0}];
\[Theta]=ev@Sum[f1/.Thread[{s0,i0,j0}->X[[kk]]], {kk,n}];
\[Theta]+=ev@Sum[f2/.Thread[{s0,i0,j0}->X[[k0]]]//.Thread[{s1,i1,j1}->X[[k1]]], {k0,n}, {k1,n}];
\[Theta]+=ev@Sum[f3/.{\[CurlyPhi]->\[CurlyPhi]\[CurlyPhi][[kk]],k->kk}, {kk,Length@\[CurlyPhi]\[CurlyPhi]}];
Factor@{\[CapitalDelta],(\[CapitalDelta]/.T->Subscript[T, 1])(\[CapitalDelta]/.T->Subscript[T, 2])(\[CapitalDelta]/.T->Subscript[T, 3])\[Theta]}
];


(* ::Input::Initialization:: *)
Subscript[\[Delta], i_,j_]:=Subscript[\[Chi], i==j]; \!\(
\*SubsuperscriptBox[\(\[Chi]\), \(ph_\), \(p_\)] /; \(p > 1\)\)^:=Subscript[\[Chi], ph];
bRules[{s_,i_,j_}]:={ (* b for "push indices backwards" *)
Subscript[g, \[Nu]_,SuperPlus[j],\[Beta]_]:>Subscript[g, \[Nu],j,\[Beta]]-Subscript[\[Delta], j,\[Beta]],Subscript[g, \[Nu]_,SuperPlus[i],\[Beta]_]:>\!\(
\*SubsuperscriptBox[\(T\), \(\[Nu]\), \(-s\)] 
\*SubscriptBox[\(g\), \(\[Nu], i, \[Beta]\)]\)+(1-\!\(\*SubsuperscriptBox[\(T\), \(\[Nu]\), \(-s\)]\))Subscript[g, \[Nu],j,\[Beta]]-\!\(
\*SubsuperscriptBox[\(T\), \(\[Nu]\), \(-s\)]\ 
\*SubscriptBox[\(\[Delta]\), \(i, \[Beta]\)]\)-(1-\!\(\*SubsuperscriptBox[\(T\), \(\[Nu]\), \(-s\)]\)) Subscript[\[Delta], j,\[Beta]],
Subscript[g, \[Nu]_,\[Alpha]_,SuperPlus[i]]:>\!\(
\*SubsuperscriptBox[\(T\), \(\[Nu]\), \(s\)] 
\*SubscriptBox[\(g\), \(\[Nu], \[Alpha], i\)]\)+Subscript[\[Delta], \[Alpha],SuperPlus[i]],Subscript[g, \[Nu]_,\[Alpha]_,SuperPlus[j]]:>Subscript[g, \[Nu],\[Alpha],j]+(1-\!\(\*SubsuperscriptBox[\(T\), \(\[Nu]\), \(s\)]\))Subscript[g, \[Nu],\[Alpha],i]+Subscript[\[Delta], \[Alpha],SuperPlus[j]]
};
bRules[X___List]:=Union@@Table[bRules[c],{c,{X}}]


(* ::Input::Initialization:: *)
\!\(\*SubscriptBox[\(D\), \({s_, i_, j_}\)]\)[\[ScriptCapitalE]_]:=CF[Expand[Plus[
\[ScriptCapitalE]/.{Subscript[g, \[Nu]_,#,\[Beta]_]:>Subscript[g, \[Nu],SuperPlus[i],\[Beta]],Subscript[g, \[Nu]_,\[Alpha]_,#]:>Subscript[g, \[Nu],\[Alpha],SuperPlus[i]]},
\[ScriptCapitalE]/.{Subscript[g, \[Nu]_,#,\[Beta]_]:>Subscript[g, \[Nu],SuperPlus[j],\[Beta]],Subscript[g, \[Nu]_,\[Alpha]_,#]:>Subscript[g, \[Nu],\[Alpha],SuperPlus[j]]},
-\[ScriptCapitalE]/.{Subscript[g, \[Nu]_,#,\[Beta]_]:>Subscript[g, \[Nu],i,\[Beta]],Subscript[g, \[Nu]_,\[Alpha]_,#]:>Subscript[g, \[Nu],\[Alpha],i]},
-\[ScriptCapitalE]/.{Subscript[g, \[Nu]_,#,\[Beta]_]:>Subscript[g, \[Nu],j,\[Beta]],Subscript[g, \[Nu]_,\[Alpha]_,#]:>Subscript[g, \[Nu],\[Alpha],j]}
]/.bRules[{s,i,j}] /.bRules[{s0,i0,j0}]]/. Subscript[\[Chi], eq_Equal]:>Subscript[\[Chi], Sort@eq]//.{
Subscript[\[Chi], j0==j1]->Subscript[\[Chi], i0==i1],Subscript[\[Chi], SuperPlus[j0]==SuperPlus[j1]]->Subscript[\[Chi], j0==j1],
Subscript[\[Chi], i0==j1]->0,Subscript[\[Chi], i1==j0]->0,Subscript[\[Chi], SuperPlus[i0]==SuperPlus[j1]]->0,Subscript[\[Chi], SuperPlus[i0]==SuperPlus[i1]]->Subscript[\[Chi], i0==i1],Subscript[\[Chi], SuperPlus[i1]==SuperPlus[j0]]->0,Subscript[\[Chi], SuperPlus[i0]==SuperPlus[j0]]->0,
Subscript[\[Chi], i0==i1]A_:>Subscript[\[Chi], i0==i1](A/.{s1->s0,i1->i0,j1->j0})
}/.{Subscript[\[Chi], i0==j0]->0,Subscript[\[Chi], SuperPlus[i0]==SuperPlus[j0]]->0,Subscript[\[Chi], True]->1}
];
B[\[ScriptCapitalE]_]:=CF[
(\[ScriptCapitalE]/.{Subscript[g, \[Nu]_,#,\[Beta]_]:>Subscript[g, \[Nu],$,\[Beta]],Subscript[g, \[Nu]_,\[Alpha]_,#]:>Subscript[g, \[Nu],\[Alpha],$]})-(\[ScriptCapitalE]/.{Subscript[g, \[Nu]_,#,\[Beta]_]:>Subscript[g, \[Nu],1,\[Beta]],Subscript[g, \[Nu]_,\[Alpha]_,#]:>Subscript[g, \[Nu],\[Alpha],1]})/.{
Subscript[g, _,$,\[Beta]_]->Subscript[\[Chi], $==\[Beta]],Subscript[g, _,_,$]->1,Subscript[g, _,\[Alpha]_,1]->Subscript[\[Chi], \[Alpha]==1]} /. {Subscript[\[Chi], $==i0]->0, Subscript[\[Chi], SuperPlus[i0]==1]->0, Subscript[\[Chi], $==j0]->0,Subscript[\[Chi], SuperPlus[j0]==1]->0}
];


(* ::Input::Initialization:: *)
tw=((1-\!\(\*SubsuperscriptBox[\(T\), \(1\), \(s0\)]\)) Subscript[g, 1,#1,i0] Subscript[g, 2,#1,i0] Subscript[g, 3,SuperPlus[j0],#1]+(-1+\!\(\*SubsuperscriptBox[\(T\), \(1\), \(s0\)]\)) Subscript[g, 1,#1,j0] Subscript[g, 2,#1,i0] Subscript[g, 3,SuperPlus[j0],#1])/(Subscript[T, 2]-1)
{\!\(\*SubscriptBox[\(D\), \({s1, i1, j1}\)]\)[tw],B[Tw]}
\[CapitalTheta][Knot[7,6], F1->-B[tw], F2->\!\(\*SubscriptBox[\(D\), \({s1, i1, j1}\)]\)[tw], F3->0]//Echo//PolyPlot
\[CapitalTheta][Knot[7,6], F1->F1i-B[tw], F2->F2i+\!\(\*SubscriptBox[\(D\), \({s1, i1, j1}\)]\)[tw]]//Echo//PolyPlot



