(* ::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:: *)
Subscript[Xp, a_,b_]:= Xp[a,b]; Subscript[Xm, a_,b_]:=Xm[a,b];


(* ::Input::Initialization:: *)
SXForm[L_] := SXForm[
Skeleton[L],
Times@@PD[L] /. X[i_,j_,k_,l_] :> If[PositiveQ[X[i,j,k,l]],Xp[l,i], Xm[j,i]]
];
Z[L_] := Z[Identity, L];
Z[\[Chi]_, L_] := Module[{s, z},
{s, z} = List @@ SXForm[L];
z=\[Chi][z];
Do[z = z // dm[s[[c,1]],s[[c,k]] ,s[[c,1]]], {c, Length[s]},{k, 2, Length[s[[c]]]}];
z
];


(* ::Input::Initialization:: *)
dA[a_,rest__][\[Alpha]_] := \[Alpha] // dA[a] // dA[rest];
dA[l_List] := dA @@ l;
dA[All][\[Alpha]_] := \[Alpha]//dA[dL[\[Alpha]]];
dS[a_,rest__][\[Alpha]_] := \[Alpha] // dS[a] // dS[rest];
dS[l_List] := dS @@ l;
dS[All][\[Alpha]_] := \[Alpha]//dS[dL[\[Alpha]]];


(* ::Input::Initialization:: *)
\[CapitalGamma]Simp=Factor; SetAttributes[\[CapitalGamma]Collect, Listable];
\[CapitalGamma]Collect[\[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_]] := \[CapitalGamma]Collect[\[CapitalGamma]Simp][\[CapitalGamma][\[Omega],\[Sigma],\[Lambda]]];
\[CapitalGamma]Collect[simp_][\[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_]] := \[CapitalGamma][simp[\[Omega]], simp[\[Sigma]],
Collect[\[Lambda], Subscript[h, _], Collect[#,Subscript[t, _], simp]&]];
dL[\[CapitalGamma][_,_,\[Lambda]_]] := Union[Cases[\[Lambda], Subscript[(h|t), a_] :> a, Infinity]];
\[CapitalGamma][\[Omega]1_,_, _][\[Omega]] := \[Omega]1;
\[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_][\[CapitalSigma]] := (\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(h\), \(#\)]]\[Sigma]\))& /@ dL[\[CapitalGamma][\[Omega],\[Sigma],\[Lambda]]];
\[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_][A] := Module[{S=dL[\[CapitalGamma][\[Omega],\[Sigma],\[Lambda]]]}, Outer[\[CapitalGamma]Simp[(\!\(
\*SubscriptBox[\(\[PartialD]\), \(
\*SubscriptBox[\(t\), \(#1\)]\[InvisibleComma]
\*SubscriptBox[\(h\), \(#2\)]\)]\[Lambda]\))]&, S, S]];
\[CapitalGamma]Form[\[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_]] := Module[{S, M},
S = dL[\[CapitalGamma][\[Omega],\[Sigma],\[Lambda]]];
M = \[CapitalGamma][\[Omega],\[Sigma],\[Lambda]][A] // Transpose;
PrependTo[M, Subscript[s, #]& /@ S];
M = Join[
{Prepend[Subscript[s, #]& /@ S, \[Omega]]},
Transpose[M],
{Prepend[\[CapitalGamma][\[Omega],\[Sigma],\[Lambda]][\[CapitalSigma]], "\[CapitalGamma]"]}
];
MatrixForm[M]
];
\[CapitalGamma]Form[else_] := else /. \[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_] :> \[CapitalGamma]Form[\[CapitalGamma][\[Omega],\[Sigma],\[Lambda]]];
Format[\[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_], StandardForm] := \[CapitalGamma]Form[\[CapitalGamma][\[Omega],\[Sigma],\[Lambda]]];


(* ::Input::Initialization:: *)
\[CapitalGamma] /: \[CapitalGamma][\[Omega]1_,\[Sigma]1_, \[Mu]1_] == \[CapitalGamma][\[Omega]2_,\[Sigma]2_, \[Mu]2_] := Module[
{S},
S=dL[\[CapitalGamma][\[Omega]1,\[Sigma]1, \[Mu]1]]\[Union]dL[\[CapitalGamma][\[Omega]2,\[Sigma]2, \[Mu]2]];
(\[Omega]1 == \[Omega]2) && (And @@ ((\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(h\), \(#\)]]\[Sigma]1\) == \!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(h\), \(#\)]]\[Sigma]2\))& /@ S)) && (
And @@ Flatten[Outer[
(\!\(
\*SubscriptBox[\(\[PartialD]\), \(
\*SubscriptBox[\(t\), \(#1\)], 
\*SubscriptBox[\(h\), \(#2\)]\)]\[Mu]1\)== \!\(
\*SubscriptBox[\(\[PartialD]\), \(
\*SubscriptBox[\(t\), \(#1\)], 
\*SubscriptBox[\(h\), \(#2\)]\)]\[Mu]2\))&,
S,S
]]
)
]


(* ::Input::Initialization:: *)
\[CapitalGamma] /: \[CapitalGamma][\[Omega]1_,\[Sigma]1_,\[Lambda]1_]\[CapitalGamma][\[Omega]2_,\[Sigma]2_,\[Lambda]2_] := \[CapitalGamma][\[Omega]1*\[Omega]2, \[Sigma]1+\[Sigma]2, \[Lambda]1+\[Lambda]2];
Subscript[dm, i_\[InvisibleComma]j_->k_][\[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_]] := Module[{\[Alpha],\[Beta],\[Gamma],\[Delta],\[Theta],\[Epsilon],\[Phi],\[Psi],\[CapitalXi],\[Mu]},
({
 {\[Alpha], \[Beta], \[Theta]},
 {\[Gamma], \[Delta], \[Epsilon]},
 {\[Phi], \[Psi], \[CapitalXi]}
})=({
 {\!\(
  \*SubscriptBox[\(\[PartialD]\), \(
   \*SubscriptBox[\(t\), \(i\)], 
   \*SubscriptBox[\(h\), \(i\)]\)]\[Lambda]\), \!\(
  \*SubscriptBox[\(\[PartialD]\), \(
   \*SubscriptBox[\(t\), \(i\)], 
   \*SubscriptBox[\(h\), \(j\)]\)]\[Lambda]\), \!\(
  \*SubscriptBox[\(\[PartialD]\), 
   SubscriptBox[\(t\), \(i\)]]\[Lambda]\)},
 {\!\(
  \*SubscriptBox[\(\[PartialD]\), \(
   \*SubscriptBox[\(t\), \(j\)], 
   \*SubscriptBox[\(h\), \(i\)]\)]\[Lambda]\), \!\(
  \*SubscriptBox[\(\[PartialD]\), \(
   \*SubscriptBox[\(t\), \(j\)], 
   \*SubscriptBox[\(h\), \(j\)]\)]\[Lambda]\), \!\(
  \*SubscriptBox[\(\[PartialD]\), 
   SubscriptBox[\(t\), \(j\)]]\[Lambda]\)},
 {\!\(
  \*SubscriptBox[\(\[PartialD]\), 
   SubscriptBox[\(h\), \(i\)]]\[Lambda]\), \!\(
  \*SubscriptBox[\(\[PartialD]\), 
   SubscriptBox[\(h\), \(j\)]]\[Lambda]\), \[Lambda]}
})/.Subscript[(t|h), i|j]->0;
\[CapitalGamma]Collect[\[CapitalGamma][(\[Mu]=1-\[Beta])\[Omega],
Subscript[h, k](\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(h\), \(i\)]]\[Sigma]\))(\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(h\), \(j\)]]\[Sigma]\))+(\[Sigma] /. Subscript[h, i|j]->0),
{Subscript[t, k],1} . \!\(\*
TagBox[
RowBox[{"(", "", GridBox[{
{
RowBox[{"\[Gamma]", "+", 
RowBox[{"\[Alpha]", " ", 
RowBox[{"\[Delta]", "/", "\[Mu]"}]}]}], 
RowBox[{"\[Epsilon]", "+", 
RowBox[{"\[Delta]", " ", 
RowBox[{"\[Theta]", "/", "\[Mu]"}]}]}]},
{
RowBox[{"\[Phi]", "+", 
RowBox[{"\[Alpha]", " ", 
RowBox[{"\[Psi]", "/", "\[Mu]"}]}]}], 
RowBox[{"\[CapitalXi]", "+", 
RowBox[{"\[Theta]", " ", 
RowBox[{"\[Psi]", "/", "\[Mu]"}]}]}]}
},
GridBoxAlignment->{"Columns" -> {{Center}}, "ColumnsIndexed" -> {}, "Rows" -> {{Baseline}}, "RowsIndexed" -> {}},
GridBoxSpacings->{"Columns" -> {Offset[0.27999999999999997`], {Offset[0.7]}, Offset[0.27999999999999997`]}, "ColumnsIndexed" -> {}, "Rows" -> {Offset[0.2], {Offset[0.4]}, Offset[0.2]}, "RowsIndexed" -> {}}], "", ")"}],
Function[BoxForm`e$, MatrixForm[BoxForm`e$]]]\) . {Subscript[h, k],1}
]] /. {Subscript[T, i]->Subscript[T, k], Subscript[T, j]->Subscript[T, k],Subscript[b, i]->Subscript[b, k], Subscript[b, j]->Subscript[b, k]} // \[CapitalGamma]Collect
];
dm[a_,b_,c_][\[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_]]  := Subscript[dm, a\[InvisibleComma]b->c][\[CapitalGamma][\[Omega],\[Sigma],\[Lambda]]];
d\[Eta][a_][\[Gamma]_\[CapitalGamma]] := \[Gamma] /. {Subscript[(h|t), a] -> 0, Subscript[T, a]->1};


(* ::Input::Initialization:: *)
tr[a_][\[CapitalGamma][\[Omega]_,\[Sigma]_, \[Lambda]_]] := Module[{\[Alpha],\[Theta],\[Psi],\[CapitalXi]},
({
 {\[Alpha], \[Theta]},
 {\[Psi], \[CapitalXi]}
})=({
 {\!\(
  \*SubscriptBox[\(\[PartialD]\), \(
   \*SubscriptBox[\(t\), \(a\)], 
   \*SubscriptBox[\(h\), \(a\)]\)]\[Lambda]\), \!\(
  \*SubscriptBox[\(\[PartialD]\), 
   SubscriptBox[\(t\), \(a\)]]\[Lambda]\)},
 {\!\(
  \*SubscriptBox[\(\[PartialD]\), 
   SubscriptBox[\(h\), \(a\)]]\[Lambda]\), \[Lambda]}
})/.Subscript[(t|h), a]->0;
\[CapitalGamma][\[Omega](1-\[Alpha]),\[Sigma] /. Subscript[h, a]->0,\[CapitalXi]+\[Psi]*\[Theta]/(1-\[Alpha])]// \[CapitalGamma]Collect];


(* ::Input::Initialization:: *)
FullStitch[\[Gamma]1_\[CapitalGamma],\[Gamma]2_\[CapitalGamma]] := Module[{S1,S2,S, \[Gamma],\[Tau]},
S=(S1=dL[\[Gamma]1])\[Union](S2=dL[\[Gamma]2]);
\[Gamma]=\[Gamma]1(Times@@(\[CapitalGamma]/@\[Epsilon]/@Complement[S,S1]));
\[Gamma]*=(\[Gamma]2 /. {Subscript[h, a_]:>Subscript[h, \[Tau][a]], Subscript[t, a_]:>Subscript[t, \[Tau][a]], Subscript[T, a_]:>Subscript[T, \[Tau][a]]})(Times@@(\[CapitalGamma]/@\[Epsilon]/@\[Tau]/@Complement[S,S2]));
Do[
\[Gamma]=\[Gamma]//dm[s,\[Tau][s],s],
{s,S}
];
\[Gamma]
];
\[CapitalGamma] /: \[Gamma]1_\[CapitalGamma]**\[Gamma]2_\[CapitalGamma] := Module[{S1,S2,S, \[Gamma]1p,\[Gamma]2p},
S=(S1=dL[\[Gamma]1])\[Union](S2=dL[\[Gamma]2]);
\[Gamma]1p=\[Gamma]1(Times@@(\[CapitalGamma]/@\[Epsilon]/@Complement[S,S1]));
\[Gamma]2p=\[Gamma]2(Times@@(\[CapitalGamma]/@\[Epsilon]/@Complement[S,S2]));
\[CapitalGamma][
\[Gamma]1p[\[Omega]]*\[Gamma]2p[\[Omega]],
(\[Gamma]1p[\[CapitalSigma]]\[Gamma]2p[\[CapitalSigma]]) . (Subscript[h, #]& /@ S),
(Subscript[t, #]& /@ S) . (\[Gamma]2p[A] . \[Gamma]1p[A]) . (Subscript[h, #]& /@ S)
]
];


(* ::Input::Initialization:: *)
\[CapitalGamma] /: \[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_]^-1 := Module[{S=dL[\[CapitalGamma][\[Omega],\[Sigma],\[Lambda]]]},
\[CapitalGamma][
\[Omega]^-1, Collect[\[Sigma], Subscript[h, _], (1/#)&],
(Subscript[t, #]& /@ S) . Inverse[ Outer[\[CapitalGamma]Simp[(\!\(
\*SubscriptBox[\(\[PartialD]\), \(
\*SubscriptBox[\(t\), \(#1\)]\[InvisibleComma]
\*SubscriptBox[\(h\), \(#2\)]\)]\[Lambda]\))]&, S, S]] . (Subscript[h, #]& /@ S)
]
]; 


(* ::Input::Initialization:: *)
dA[a_][\[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_]] := Module[
{\[Alpha], \[Theta], \[Phi], \[CapitalXi], \[Sigma]a},
({
 {\[Alpha], \[Theta]},
 {\[Phi], \[CapitalXi]}
})=({
 {\!\(
  \*SubscriptBox[\(\[PartialD]\), \(
   \*SubscriptBox[\(t\), \(a\)], 
   \*SubscriptBox[\(h\), \(a\)]\)]\[Lambda]\), \!\(
  \*SubscriptBox[\(\[PartialD]\), 
   SubscriptBox[\(t\), \(a\)]]\[Lambda]\)},
 {\!\(
  \*SubscriptBox[\(\[PartialD]\), 
   SubscriptBox[\(h\), \(a\)]]\[Lambda]\), \[Lambda]}
}) /. Subscript[(h|t), a]->0;
\[Sigma]a=\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(h\), \(a\)]]\[Sigma]\);
\[CapitalGamma]Collect[\[CapitalGamma][
\[Alpha] \[Omega]/\[Sigma]a,
((\[Sigma]/.Subscript[h, a]->0)+Subscript[h, a]/\[Sigma]a),
{Subscript[t, a], 1} . ({
 {1, \[Theta]},
 {-\[Phi], \[Alpha] \[CapitalXi]-\[Phi] \[Theta]}
}) . {Subscript[h, a],1}/\[Alpha]
]]
];
dS[a_][\[Gamma]_\[CapitalGamma]] := \[CapitalGamma]Collect[dA[a][\[Gamma]] /. {Subscript[T, a]->1/Subscript[T, a], Subscript[b, a]->-Subscript[b, a]}];


(* ::Input::Initialization:: *)
Mirror[\[Gamma]_\[CapitalGamma]] := Module[{\[Gamma]1},
\[Gamma]1 = \[Gamma] // (dS@@dL[\[Gamma]]);
\[Gamma]1[[3]] = \[Gamma]1[[3]] /. {Subscript[t, a_]:>Subscript[h, a], Subscript[h, a_]:>Subscript[t, a]};
\[Gamma]1];


(* ::Input::Initialization:: *)
t\[Sigma][rules___Rule][\[Gamma]_\[CapitalGamma]] := \[CapitalGamma]Collect[
\[Gamma] /. {Subscript[t, u_] :> Subscript[t, u /. {rules}], Subscript[T, u_] :> Subscript[T, u /. {rules}], Subscript[b, u_] :> Subscript[b, u /. {rules}]}
];
h\[Sigma][rules___Rule][\[Gamma]_\[CapitalGamma]] := \[CapitalGamma]Collect[\[Gamma] /. Subscript[h, x_] :> Subscript[h, x /. {rules}]];


(* ::Input::Initialization:: *)
SetAttributes[\[CapitalGamma], Listable];
\[CapitalGamma][p_Times|p_NonCommutativeMultiply]:= \[CapitalGamma] /@ p;
\[CapitalGamma][\[Epsilon][a_]] := \[CapitalGamma][1,Subscript[h, a], Subscript[h, a] Subscript[t, a]];
\[CapitalGamma][Xp[a_,b_]] :=\[CapitalGamma][1, Subscript[h, a]+Subscript[h, b] Subscript[T, a], {Subscript[t, a],Subscript[t, b]} . ({
 {1, 1-Subscript[T, a]},
 {0, Subscript[T, a]}
}) . {Subscript[h, a],Subscript[h, b]}];
\[CapitalGamma][Xm[a_,b_]] := \[CapitalGamma][Xp[a,b]] /. Subscript[T, a]->1/Subscript[T, a];


(* ::Input::Initialization:: *)
MVA[\[CapitalGamma], L_Link] := Module[{Hs,\[Omega],\[Sigma],\[Mu],A},
{\[Omega],\[Sigma],\[Mu]} = List @@ Z[\[CapitalGamma], L];
Hs = Rest[Subscript[h, #]& /@ (First /@ Skeleton[L])];
A=Outer[Coefficient[\[Mu], #1*#2]&,Hs, Hs /. Subscript[h, a_] :> Subscript[t, a]];
Factor[(\[Omega] Det[A-IdentityMatrix@Length@Hs])/(1-Subscript[T, Skeleton[L][[1,1]]])]
]


(* ::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}];
Which[
(i==0)\[And](j==0), w,
(i==0)\[Or](j==0), 0,
True,(-1)^(i+j+If[i>j,1,0]) Delete[w,{{i},{j}}]
]];
Subscript[c, x_,y_][\[ScriptCapitalE]_]:=\[ScriptCapitalE]/.w_Wedge:>Subscript[c, x,y][w]


(* ::Input::Initialization:: *)
\[ScriptCapitalA][\[CapitalGamma][\[Omega]_,_,\[Lambda]_]]:=Expand[\[Omega] WExp[Expand[\[Lambda]]/.Subscript[t, a_] Subscript[h, b_]:>Subscript[\[Xi], a]\[Wedge]Subscript[x, b]]]


(* ::Input::Initialization:: *)
\[ScriptCapitalA][Subscript[X, i_,j_,k_,l_]]:=\[ScriptCapitalA][{i,l},{j,k},(Subscript[T, i]==Subscript[T, k])(Subscript[T, l]==Subscript[T, j]),WExp[Subscript[T, l] Subscript[\[Xi], i]\[Wedge]Subscript[x, k]+Subscript[\[Xi], l]\[Wedge]Subscript[x, j]+Subscript[\[Xi], l]\[Wedge]Subscript[x, k]-Subscript[T, l] Subscript[\[Xi], l]\[Wedge]Subscript[x, k]]];
\[ScriptCapitalA][Subscript[\!\(\*OverscriptBox[\(X\), \(_\)]\), i_,j_,k_,l_]]:=\[ScriptCapitalA][{i,j},{k,l},(Subscript[T, i]==Subscript[T, k])(Subscript[T, j]==Subscript[T, l]),WExp[\!\(
\*SubsuperscriptBox[\(T\), \(j\), \(-1\)] \(
\*SubscriptBox[\(\[Xi]\), \(i\)]\[Wedge]
\*SubscriptBox[\(x\), \(k\)]\)\)+Subscript[\[Xi], j]\[Wedge]Subscript[x, k]-\!\(
\*SubsuperscriptBox[\(T\), \(j\), \(-1\)] \(
\*SubscriptBox[\(\[Xi]\), \(j\)]\[Wedge]
\*SubscriptBox[\(x\), \(k\)]\)\)+Subscript[\[Xi], j]\[Wedge]Subscript[x, l]]]


(* ::Input::Initialization:: *)
RR[Times[]] = {};
RR[Equal[a_, b__]] := (#->a)&/@{b}; 
RR[eqs_Times] := Join @@ (RR /@ List@@eqs)


(* ::Input::Initialization:: *)
\[ScriptCapitalA]/:\[ScriptCapitalA][is1_,os1_,e1_,w1_]\[ScriptCapitalA][is2_,os2_,e2_,w2_]:=\[ScriptCapitalA][is1\[Union]is2,os1\[Union]os2,e1 e2,WP[w1,w2]]



