(* ::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:: *)
WP[Wedge[u___],Wedge[v___]]:=Signature[{u,v}]*Wedge@@Sort[{u,v}];
WP[0,_]=WP[_,0]=0;
WP[A_,B_]:=Expand[Distribute[A ** 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]


(* ::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[T^(-1/2) WExp[Expand[{Subscript[\[Xi], l],Subscript[\[Xi], i]} . ({
 {1, 1-T},
 {0, T}
}) . {Subscript[x, j],Subscript[x, k]}]/.Subscript[\[Xi], a_] Subscript[x, b_]:>Subscript[\[Xi], a]\[Wedge]Subscript[x, b]]]];


(* ::Input::Initialization:: *)
\[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[T^(1/2) WExp[Expand[{Subscript[\[Xi], i],Subscript[\[Xi], j]} . ({
 {T^-1, 0},
 {1-T^-1, 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]



