(* ::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]


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


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


(* ::Input::Initialization:: *)
Subscript[\[CapitalTheta], F1_,F2_][K_]:=Module[{X,\[CurlyPhi],n,A,\[CapitalDelta],G,ev,\[Theta],k,k1,k2},
{X,\[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]]-Total[X[[All,1]]])/2) Det[A];
G=Inverse[A];
ev[\[ScriptCapitalE]_]:=Factor[\[ScriptCapitalE]/.SuperPlus[k_]:>k+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[{s,i,j}->X[[k]]], {k,n}];
\[Theta]+=ev@Sum[F2//.Thread[{s0,i0,j0}->X[[k1]]]//.Thread[{s1,i1,j1}->X[[k2]]], {k1,n}, {k2,n}];
\[Theta]+=ev@Sum[Subscript[F, 3][\[CurlyPhi][[k]],k], {k,Length@\[CurlyPhi]}];
Factor@{\[CapitalDelta],(\[CapitalDelta]/.T->Subscript[T, 1])(\[CapitalDelta]/.T->Subscript[T, 2])(\[CapitalDelta]/.T->Subscript[T, 3])\[Theta]}
];


(* ::Input::Initialization:: *)
FO=CF[Subscript[\[Chi], i0==i1]Subscript[F, 1][{s0,i0,j0}]+Subscript[F, 2][{s0,i0,j0},{s1,i1,j1}]]


(* ::Input::Initialization:: *)
Subscript[\[Delta], i_,j_]:=Subscript[\[Chi], i==j];
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[
CF[
((\[ScriptCapitalE]/.#->SuperPlus[i])+(\[ScriptCapitalE]/.#->SuperPlus[j])-(\[ScriptCapitalE]/.#->i)-(\[ScriptCapitalE]/.#->j))/.{Subscript[g, \[Nu]_,\[Alpha]_,\[Beta]:SuperPlus[(i|j)]]:>Subscript[g, \[Nu],\[Alpha],\[Beta]]-Subscript[\[Delta], \[Alpha],\[Beta]]}/.bRules[{s,i,j}]
] /. Subscript[\[Chi], j1==i0]|Subscript[\[Chi], i1==j0]->0/.Subscript[\[Chi], j1==j0]|Subscript[\[Chi], i1==i0]->Subscript[\[Chi], i0==i1]/.\!\(
\*SubsuperscriptBox[\(\[Chi]\), \(eq_Equal\), \(2\)] -> 
\*SubscriptBox[\(\[Chi]\), \(eq\)]\)//.{Subscript[\[Chi], i0==i1] Subscript[g, \[Nu]_,i1,\[Beta]_]:>Subscript[\[Chi], i0==i1] Subscript[g, \[Nu],i0,\[Beta]],Subscript[\[Chi], i0==i1] Subscript[g, \[Nu]_,j1,\[Beta]_]:>Subscript[\[Chi], i0==i1] Subscript[g, \[Nu],j0,\[Beta]],Subscript[\[Chi], i0==i1] Subscript[g, \[Nu]_,\[Alpha]_,i1]:>Subscript[\[Chi], i0==i1] Subscript[g, \[Nu],\[Alpha],i0],Subscript[\[Chi], i0==i1] Subscript[g, \[Nu]_,\[Alpha]_,j1]:>Subscript[\[Chi], i0==i1] Subscript[g, \[Nu],\[Alpha],j0]}
]


(* ::Input::Initialization:: *)
\!\(\*SubscriptBox[\(D\), \({s_, i_, j_}\)]\)[\[ScriptCapitalE]_]:=CF[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}]
];
Subscript[B, L_][\[ScriptCapitalE]_]:=CF[
(\[ScriptCapitalE]/.{Subscript[g, \[Nu]_,#,\[Beta]_]:>Subscript[g, \[Nu],L,\[Beta]],Subscript[g, \[Nu]_,\[Alpha]_,#]:>Subscript[g, \[Nu],\[Alpha],L]})-(\[ScriptCapitalE]/.{Subscript[g, \[Nu]_,#,\[Beta]_]:>Subscript[g, \[Nu],1,\[Beta]],Subscript[g, \[Nu]_,\[Alpha]_,#]:>Subscript[g, \[Nu],\[Alpha],1]})/.{
Subscript[g, _,L,\[Beta]_]->Subscript[\[Chi], L==\[Beta]],Subscript[g, _,_,L]->1,Subscript[g, _,\[Alpha]_,1]->Subscript[\[Chi], \[Alpha]==1]}
];



