(* ::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, __]|Subscript[\[Chi], __],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, \[Alpha]_,\[Beta]_]:>G[[\[Alpha],\[Beta]]],Subscript[g, \[Nu]_,\[Alpha]_,\[Beta]_]:>(G[[\[Alpha],\[Beta]]]/.T->Subscript[T, \[Nu]])}];
\[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[\[Chi], True]=1; Subscript[\[Chi], False]=0;
Subscript[\[Chi], \[Alpha]_<=\[Alpha]_]=1;\!\(
\*SubsuperscriptBox[\(\[Chi]\), \(ph_\), \(p_\)] /; \(p > 1\)\)^:=Subscript[\[Chi], ph]; Subscript[\[Chi], \[Alpha]_==\[Beta]_]/;OrderedQ[{\[Beta],\[Alpha]}]:=Subscript[\[Chi], \[Beta]==\[Alpha]];
Subscript[\[Chi], SuperPlus[\[Alpha]_]==SuperPlus[\[Beta]_]]:=Subscript[\[Chi], \[Alpha]==\[Beta]];
Subscript[\[Delta], i_,j_]:=Subscript[\[Chi], i==j]; 


(* ::Input::Initialization:: *)
gRules[{s_,i_,j_}]:={Subscript[g, \[Nu]_\[InvisibleComma]j\[InvisibleComma]\[Beta]_]:>Subscript[g, \[Nu]\[InvisibleComma]SuperPlus[j]\[InvisibleComma]\[Beta]]+Subscript[\[Delta], j\[InvisibleComma]\[Beta]],Subscript[g, \[Nu]_\[InvisibleComma]i\[InvisibleComma]\[Beta]_]:>\!\(
\*SubsuperscriptBox[\(T\), \(\[Nu]\), \(s\)] 
\*SubscriptBox[\(g\), \(\[Nu]\[InvisibleComma]
\*SuperscriptBox[\(i\), \(+\)]\[InvisibleComma]\[Beta]\)]\)+(1-\!\(\*SubsuperscriptBox[\(T\), \(\[Nu]\), \(s\)]\))Subscript[g, \[Nu]\[InvisibleComma]SuperPlus[j]\[InvisibleComma]\[Beta]]+Subscript[\[Delta], i\[InvisibleComma]\[Beta]],
Subscript[g, \[Nu]_\[InvisibleComma]\[Alpha]_\[InvisibleComma]SuperPlus[i]]:>\!\(
\*SubsuperscriptBox[\(T\), \(\[Nu]\), \(s\)] 
\*SubscriptBox[\(g\), \(\[Nu]\[InvisibleComma]\[Alpha]\[InvisibleComma]i\)]\)+Subscript[\[Delta], \[Alpha]\[InvisibleComma]SuperPlus[i]],Subscript[g, \[Nu]_\[InvisibleComma]\[Alpha]_\[InvisibleComma]SuperPlus[j]]:>Subscript[g, \[Nu]\[InvisibleComma]\[Alpha]\[InvisibleComma]j]+(1-\!\(\*SubsuperscriptBox[\(T\), \(\[Nu]\), \(s\)]\))Subscript[g, \[Nu]\[InvisibleComma]\[Alpha]\[InvisibleComma]i]+Subscript[\[Delta], \[Alpha]\[InvisibleComma]SuperPlus[j]],
Subscript[g, j\[InvisibleComma]\[Beta]_]:>Subscript[g, SuperPlus[j]\[InvisibleComma]\[Beta]]+Subscript[\[Delta], j\[InvisibleComma]\[Beta]],Subscript[g, i\[InvisibleComma]\[Beta]_]:>T^s Subscript[g, SuperPlus[i]\[InvisibleComma]\[Beta]]+(1-T^s)Subscript[g, SuperPlus[j]\[InvisibleComma]\[Beta]]+Subscript[\[Delta], i\[InvisibleComma]\[Beta]],
Subscript[g, \[Alpha]_\[InvisibleComma]SuperPlus[i]]:>T^s Subscript[g, \[Alpha]\[InvisibleComma]i]+Subscript[\[Delta], \[Alpha]\[InvisibleComma]SuperPlus[i]],Subscript[g, \[Alpha]_\[InvisibleComma]SuperPlus[j]]:>Subscript[g, \[Alpha]\[InvisibleComma]j]+(1-T^s)Subscript[g, \[Alpha]\[InvisibleComma]i]+Subscript[\[Delta], \[Alpha]\[InvisibleComma]SuperPlus[j]]
};
bRules[{s_,i_,j_}]:={ (* b for "push indices backwards" *)
Subscript[g, SuperPlus[j],\[Beta]_]:>Subscript[g, j,\[Beta]]-Subscript[\[Delta], j,\[Beta]],Subscript[g, SuperPlus[i],\[Beta]_]:>T^-s Subscript[g, i,\[Beta]]+(1-T^-s)Subscript[g, j,\[Beta]]-T^-s Subscript[\[Delta], i,\[Beta]]-(1-T^-s) Subscript[\[Delta], j,\[Beta]],
Subscript[g, \[Alpha]_,SuperPlus[i]]:>T^s Subscript[g, \[Alpha],i]+Subscript[\[Delta], \[Alpha],SuperPlus[i]],Subscript[g, \[Alpha]_,SuperPlus[j]]:>Subscript[g, \[Alpha],j]+(1-T^s)Subscript[g, \[Alpha],i]+Subscript[\[Delta], \[Alpha],SuperPlus[j]],
Subscript[\[Chi], SuperPlus[i]<=\[Beta]_]:>Subscript[\[Chi], i<=\[Beta]]-Subscript[\[Chi], i==\[Beta]],Subscript[\[Chi], SuperPlus[j]<=\[Beta]_]:>Subscript[\[Chi], j<=\[Beta]]-Subscript[\[Chi], j==\[Beta]]
};


(* ::Input::Initialization:: *)
R1=CF[Residue[Subscript[F, 1][{s0,i0,j0}], {Subscript[T, 2],1}] //.{Subscript[T, 1]->T, Subscript[g, 2,\[Alpha]_,\[Beta]_]:>Subscript[\[Chi], \[Alpha]<=\[Beta]], Subscript[g, 1|3,\[Alpha]_,\[Beta]_]:>Subscript[g, \[Alpha],\[Beta]],Subscript[\[Chi], j0<=i0]->1-Subscript[\[Chi], i0<=j0]}]


(* ::Input::Initialization:: *)
R2=CF[Residue[Subscript[F, 2][{s0,i0,j0},{s1,i1,j1}], {Subscript[T, 2],1}] //.{Subscript[T, 1]->T, Subscript[g, 2,\[Alpha]_,\[Beta]_]:>Subscript[\[Chi], \[Alpha]<=\[Beta]], Subscript[g, 1|3,\[Alpha]_,\[Beta]_]:>Subscript[g, \[Alpha],\[Beta]]}]


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


(* ::Input::Initialization:: *)
bas=List@@Expand[(Subscript[\[Chi], #<=i0]+Subscript[\[Chi], #<=j0])(Subscript[g, SuperPlus[i0],#]+Subscript[g, SuperPlus[j0],#])(Subscript[g, #,i0]+Subscript[g, #,j0])]



