(* ::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:: *)
CCF[\[ScriptCapitalE]_] := Factor[\[ScriptCapitalE]]; 
CF[\[ScriptCapitalE]_] := Module[{vs=Union@Cases[\[ScriptCapitalE],Subscript[(\[Xi]|x), _],\[Infinity]]},
Total[(CCF[#[[2]]](Times@@(vs^#[[1]])))& /@ CoefficientRules[\[ScriptCapitalE], vs]]];


(* ::Input::Initialization:: *)
\[CapitalGamma]/:\[CapitalGamma][is1_,os1_,cs1_,\[Omega]1_,\[Lambda]1_]\[CapitalGamma][is2_,os2_,cs2_,\[Omega]2_,\[Lambda]2_]:=\[CapitalGamma][is1\[Union]is2,os1\[Union]os2,Join[cs1,cs2],\[Omega]1 \[Omega]2,\[Lambda]1+\[Lambda]2]
\[CapitalGamma]/:\[CapitalGamma][is1_,os1_,_,\[Omega]1_,\[Lambda]1_]\[Congruent]\[CapitalGamma][is2_,os2_,_,\[Omega]2_,\[Lambda]2_]:=TrueQ[(Sort@is1===Sort@is2)\[And](Sort@os1===Sort@os2)\[And]Simplify[\[Omega]1==\[Omega]2]\[And]CF@\[Lambda]1==CF@\[Lambda]2]


(* ::Input::Initialization:: *)
Subscript[c, h_,t_]@\[CapitalGamma][is_,os_,cs_,\[Omega]_,\[Lambda]_]:=Module[{\[Alpha],\[Eta],y,\[Mu]},
\[Alpha]=\!\(
\*SubscriptBox[\(\[PartialD]\), \(
\*SubscriptBox[\(\[Xi]\), \(t\)], 
\*SubscriptBox[\(x\), \(h\)]\)]\[Lambda]\); \[Mu]=\[Lambda]/.Subscript[\[Xi], t]|Subscript[x, h]->0;
\[Eta]=\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(x\), \(h\)]]\[Lambda]\)/.Subscript[\[Xi], t]->0; y=\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(\[Xi]\), \(t\)]]\[Lambda]\)/.Subscript[x, h]->0;
 \[CapitalGamma][
DeleteCases[is,t],DeleteCases[os,h],KeyDrop[cs,{Subscript[x, h],Subscript[\[Xi], t]}],
CCF[(1-\[Alpha])\[Omega]],CF[\[Mu]+\[Eta] y/(1-\[Alpha])]
] /. If[MatchQ[cs[Subscript[\[Xi], t]],Subscript[\[Tau], _]], cs[Subscript[\[Xi], t]]->cs[Subscript[x, h]],cs[Subscript[x, h]]-> cs[Subscript[\[Xi], t]]]];
c@\[CapitalGamma][is_,os_,cs_,\[Omega]_,\[Lambda]_]:=Fold[Subscript[c, #2,#2][#1]&,\[CapitalGamma][is,os,cs,\[Omega],\[Lambda]],is\[Intersection]os]


(* ::Input::Initialization:: *)
\[CapitalGamma][Subscript[X, i_,j_,k_,l_][S_,T_]]:=\[CapitalGamma][{l,i},{j,k},<|Subscript[\[Xi], i]->S,Subscript[x, j]->T,Subscript[x, k]->S,Subscript[\[Xi], l]->T|>,S^(-1/2),CF[{Subscript[\[Xi], l],Subscript[\[Xi], i]} . ({
 {S, 1-S},
 {0, 1}
}) . {Subscript[x, j],Subscript[x, k]}]];
\[CapitalGamma][Subscript[\!\(\*OverscriptBox[\(X\), \(_\)]\), i_,j_,k_,l_][S_,T_]]:=\[CapitalGamma][{i,j},{k,l},<|Subscript[\[Xi], i]->S,Subscript[\[Xi], j]->T,Subscript[x, k]->S,Subscript[x, l]->T|>,S^(1/2),CF[{Subscript[\[Xi], i],Subscript[\[Xi], j]} . ({
 {1, 0},
 {1-S^-1, S^-1}
}) . {Subscript[x, k],Subscript[x, l]}]];
\[CapitalGamma][Subscript[X, i_,j_,k_,l_]]:=\[CapitalGamma][Subscript[X, i,j,k,l][Subscript[\[Tau], i],Subscript[\[Tau], l]]];
\[CapitalGamma][Subscript[\!\(\*OverscriptBox[\(X\), \(_\)]\), i_,j_,k_,l_]]:=\[CapitalGamma][Subscript[\!\(\*OverscriptBox[\(X\), \(_\)]\), i,j,k,l][Subscript[\[Tau], i],Subscript[\[Tau], j]]];


(* ::Input::Initialization:: *)
\[CapitalGamma][Subscript[P, i_,j_][T_]]:=\[CapitalGamma][{i},{j},<|Subscript[\[Xi], i]->T,Subscript[x, j]->T|>,1,Subscript[\[Xi], i] Subscript[x, j]];
\[CapitalGamma][Subscript[P, i_,j_]]:=\[CapitalGamma][Subscript[P, i,j][Subscript[\[Tau], i]]];


(* ::Input::Initialization:: *)
\[CapitalGamma][{\[Gamma]_\[CapitalGamma]}]:=c[\[Gamma]];
\[CapitalGamma][{\[Gamma]1_\[CapitalGamma],\[Gamma]s__\[CapitalGamma]}]:=Module[{\[Gamma]2},
\[Gamma]2=First@MaximalBy[{\[Gamma]s},Length[\[Gamma]1[[1]]\[Intersection]#[[2]]]+Length[\[Gamma]1[[2]]\[Intersection]#[[1]]]&];
\[CapitalGamma][Join[{c[\[Gamma]1 \[Gamma]2]}, DeleteCases[{\[Gamma]s},\[Gamma]2]]] ]
\[CapitalGamma][\[ScriptCapitalO]s_List]:=\[CapitalGamma][\[CapitalGamma]/@\[ScriptCapitalO]s]


(* ::Input::Initialization:: *)
WP[Wedge[u___],Wedge[v___]]:=Signature[{u,v}]*Wedge@@Sort[{u,v}];
WP[0,_]=WP[_,0]=0;
WP[A_,B_]:=Expand[Distribute[Expand[A] ** Expand[B]] /. (a_. * u_Wedge) ** (b_. * v_Wedge):>a b WP[u,v]];


(* ::Input::Initialization:: *)
WExp[A_]:=Module[{s=Wedge[],t=Wedge[],k=0},
While[t=!=0,s+=(t=Expand[WP[t,A]/(++k)])]; s];
WExpQ[B_]:=Module[{\[Omega],A},
\[Omega]=Coefficient[B,Wedge[]];
A=B/.w_Wedge/;Length[w]!=2:>0;
Expand[B==\[Omega] WExp[A/\[Omega]]]
]//Simplify


(* ::Input::Initialization:: *)
Subscript[c, x_,y_][w_Wedge]:=Module[{i,j},
{i}=FirstPosition[w,x,{0}]; {j}=FirstPosition[w,y,{0}];
\[Piecewise]{
 {w, (i==0)\[And](j==0)},
 {(-1)^(i+j+If[i>j,0,1]) Delete[w,{{i},{j}}], (i>0)\[And](j>0)}
}
];
Subscript[c, x_,y_][\[ScriptCapitalE]_]:=\[ScriptCapitalE]/.w_Wedge:>Subscript[c, x,y][w]


(* ::Input::Initialization:: *)
\[ScriptCapitalA][Subscript[X, i_,j_,k_,l_][S_,T_]]:=\[ScriptCapitalA][{l,i},{j,k},<|Subscript[\[Xi], i]->S,Subscript[x, j]->T,Subscript[x, k]->S,Subscript[\[Xi], l]->T|>,Expand[S^(-1/2) WExp[Expand[{Subscript[\[Xi], l],Subscript[\[Xi], i]} . ({
 {S, 1-S},
 {0, 1}
}) . {Subscript[x, j],Subscript[x, k]}]/.Subscript[\[Xi], a_] Subscript[x, b_]:>Subscript[\[Xi], a]\[Wedge]Subscript[x, b]]]];
\[ScriptCapitalA][Subscript[X, i_,j_,k_,l_]]:=\[ScriptCapitalA][Subscript[X, i,j,k,l][Subscript[\[Tau], i],Subscript[\[Tau], l]]];


(* ::Input::Initialization:: *)
\[ScriptCapitalA][Subscript[\!\(\*OverscriptBox[\(X\), \(_\)]\), i_,j_,k_,l_][S_,T_]]:=\[ScriptCapitalA][{i,j},{k,l},<|Subscript[\[Xi], i]->S,Subscript[\[Xi], j]->T,Subscript[x, k]->S,Subscript[x, l]->T|>,Expand[S^(1/2) WExp[Expand[{Subscript[\[Xi], i],Subscript[\[Xi], j]} . ({
 {1, 0},
 {1-S^-1, S^-1}
}) . {Subscript[x, k],Subscript[x, l]}]/.Subscript[\[Xi], a_] Subscript[x, b_]:>Subscript[\[Xi], a]\[Wedge]Subscript[x, b]]]];
\[ScriptCapitalA][Subscript[\!\(\*OverscriptBox[\(X\), \(_\)]\), i_,j_,k_,l_]]:=\[ScriptCapitalA][Subscript[\!\(\*OverscriptBox[\(X\), \(_\)]\), i,j,k,l][Subscript[\[Tau], i],Subscript[\[Tau], j]]];


(* ::Input::Initialization:: *)
\[ScriptCapitalA][Subscript[P, i_,j_][T_]]:=\[ScriptCapitalA][{i},{j},<|Subscript[\[Xi], i]->T,Subscript[x, j]->T|>,WExp[Subscript[\[Xi], i]\[Wedge]Subscript[x, j]]];
\[ScriptCapitalA][Subscript[P, i_,j_]]:=\[ScriptCapitalA][Subscript[P, i,j][Subscript[\[Tau], i]]]


(* ::Input::Initialization:: *)
\[ScriptCapitalA]/:\[Alpha]_*\[ScriptCapitalA][is_,os_,cs_,w_]:=\[ScriptCapitalA][is,os,cs,Expand[\[Alpha] w]]
\[ScriptCapitalA]/:\[ScriptCapitalA][is1_,os1_,cs1_,w1_]+\[ScriptCapitalA][is2_,os2_,cs2_,w2_]/;(Sort@is1==Sort@is2)\[And](Sort@os1==Sort@os2)\[And](Sort@Normal@cs1==Sort@Normal@cs2):=\[ScriptCapitalA][is1,os1,cs1,w1+w2]


(* ::Input::Initialization:: *)
\[ScriptCapitalA]/:\[ScriptCapitalA][is1_,os1_,_,w1_]\[Congruent]\[ScriptCapitalA][is2_,os2_,_,w2_]:=TrueQ[(Sort@is1===Sort@is2)\[And](Sort@os1===Sort@os2)\[And]PowerExpand[w1==w2]]


(* ::Input::Initialization:: *)
\[ScriptCapitalA]/:\[ScriptCapitalA][is1_,os1_,cs1_,w1_]\[ScriptCapitalA][is2_,os2_,cs2_,w2_]:=\[ScriptCapitalA][is1\[Union]is2,os1\[Union]os2,Join[cs1,cs2],WP[w1,w2]]


(* ::Input::Initialization:: *)
Subscript[c, h_,t_]@\[ScriptCapitalA][is_,os_,cs_,w_]:=\[ScriptCapitalA][
DeleteCases[is,t],DeleteCases[os,h],KeyDrop[cs,{Subscript[x, h],Subscript[\[Xi], t]}],Subscript[c, Subscript[x, h],Subscript[\[Xi], t]][w]
] /. If[MatchQ[cs[Subscript[\[Xi], t]],Subscript[\[Tau], _]], cs[Subscript[\[Xi], t]]->cs[Subscript[x, h]],cs[Subscript[x, h]]-> cs[Subscript[\[Xi], t]]];


(* ::Input::Initialization:: *)
c@\[ScriptCapitalA][is_,os_,cs_,w_]:=Fold[Subscript[c, #2,#2][#1]&,\[ScriptCapitalA][is,os,cs,w],is\[Intersection]os]
\[ScriptCapitalA][{A_\[ScriptCapitalA]}]:=c[A];
\[ScriptCapitalA][{A1_\[ScriptCapitalA],As__\[ScriptCapitalA]}]:=Module[{A2},
A2=First@MaximalBy[{As},Length[A1[[1]]\[Intersection]#[[2]]]+Length[A1[[2]]\[Intersection]#[[1]]]&];
\[ScriptCapitalA][Join[{c[A1 A2]}, DeleteCases[{As},A2]]] ]
\[ScriptCapitalA][\[ScriptCapitalO]s_List]:=\[ScriptCapitalA][\[ScriptCapitalA]/@\[ScriptCapitalO]s]


(* ::Input::Initialization:: *)
\[CapitalGamma]@\[ScriptCapitalA][is_,os_,cs_,w_]:=Module[{i,j,\[Omega]=Coefficient[w,Wedge[]]},
\[CapitalGamma][is,os,cs,\[Omega],Sum[Cancel[-Coefficient[w,Subscript[x, j]\[Wedge]Subscript[\[Xi], i]] Subscript[\[Xi], i]Subscript[x, j]/\[Omega]], {i,is},{j,os}]]
];
\[ScriptCapitalA]@\[CapitalGamma][is_,os_,cs_,\[Omega]_,\[Lambda]_]:=\[ScriptCapitalA][is,os,cs,Expand[\[Omega] WExp[Expand[\[Lambda]]/.Subscript[\[Xi], a_] Subscript[x, b_]:>Subscript[\[Xi], a]\[Wedge]Subscript[x, b]]]];


(* ::Input::Initialization:: *)
Unprotect[Conjugate];
(T^p_.)\[Conjugate]:=T^-p;
Protect[Conjugate];


(* ::Input::Initialization:: *)
ep[a_,b_]:=If[a===b,1,0];


(* ::Input::Initialization:: *)
Subscript[Slant, p_][u_Wedge,v_Wedge]:=Module[{n=Length@u,k=Length@v,u1=Sort[u],s=Signature[u]},
If[n<k,0,
Sum[s*Signature[\[Sigma]]*Times@@MapThread[p,{List@@u1[[\[Sigma]]],List@@v}]*Delete[u1,List/@\[Sigma]],
{\[Sigma],Permutations[Range@n,{k}]}]
]
];
Subscript[Slant, _][0,_]=Subscript[Slant, _][_,0]=0;
Subscript[Slant, p_][A_,B_]:=Expand[Distribute[A ** B] /. (a_. * u_Wedge) ** (b_. * v_Wedge):>a b\[Conjugate] Subscript[Slant, p][u,v]];


(* ::Input::Initialization:: *)
Subscript[p, \[FinalSigma]_][c_,d_]:=Expand@Cancel[T^(1/2) (T-1)^-1 Module[{e,f},
Expand[c(d/.{T->T\[Conjugate],Subscript[\[Xi], i_]:>Subscript[\[Xi], i]\[Conjugate],Subscript[x, i_]:>Subscript[x, i]\[Conjugate]})]/.{Subscript[t, i_]\[Conjugate] Subscript[t, i_]->\[Alpha]2(T\[Conjugate]-T), Subscript[x, i_]\[Conjugate] Subscript[x, i_]->\[Alpha]1(T-T\[Conjugate]),Subscript[(f:\[Xi]|x), j_]\[Conjugate] Subscript[(e:\[Xi]|x), i_]:>If[Position[\[FinalSigma],Subscript[e, i]][[1,1]]<Position[\[FinalSigma],Subscript[f, j]][[1,1]],
\[Alpha]1(T-1)+\[Alpha]2(T\[Conjugate]-1),
\[Alpha]1 (1-T)\[Conjugate]+\[Alpha]2(1-T)
]}
]];



