(* ::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:: *)
CF[\[ScriptCapitalE]_] := ExpandDenominator@ExpandNumerator@Together[Expand[\[ScriptCapitalE]] //. E^x_ E^y_:>E^(x+y) /. E^x_:>E^CF[x]];
K\[Delta]/:Subscript[K\[Delta], i_,j_]:=If[i===j,1,0];


(* ::Input::Initialization:: *)
\[DoubleStruckCapitalE]/:\[DoubleStruckCapitalE][L1_,Q1_,P1_]\[Congruent]\[DoubleStruckCapitalE][L2_,Q2_,P2_]:=CF[L1==L2]\[And]CF[Q1==Q2]\[And]CF[Normal[P1-P2]==0];
\[DoubleStruckCapitalE]/:\[DoubleStruckCapitalE][L1_,Q1_,P1_]\[DoubleStruckCapitalE][L2_,Q2_,P2_]:=\[DoubleStruckCapitalE][L1+L2,Q1+Q2,P1*P2];


(* ::Input::Initialization:: *)
{SuperStar[b],SuperStar[y],SuperStar[a],SuperStar[x],SuperStar[z]}={\[Beta],\[Eta],\[Alpha],\[Xi],\[Zeta]}; {SuperStar[\[Beta]],SuperStar[\[Eta]],SuperStar[\[Alpha]],SuperStar[\[Xi]],SuperStar[\[Zeta]]}={b,y,a,x,z}; SuperStar[(Subscript[u_, i_])]:=Subscript[(SuperStar[u]), i];


(* ::Input::Initialization:: *)
\!\(\*SubscriptBox[\(Zip\), \({}\)]\)[P_]:=P; \!\(\*SubscriptBox[\(Zip\), \({\[Zeta]_, \[Zeta]s___}\)]\)[P_] := (Expand[P//\!\(\*SubscriptBox[\(Zip\), \({\[Zeta]s}\)]\)] /. f_. \[Zeta]^d_.:>\!\(
\*SubscriptBox[\(\[PartialD]\), \({
\*SuperscriptBox[\(\[Zeta]\), \(*\)], d}\)]f\)) /. SuperStar[\[Zeta]]->0


(* ::Input::Initialization:: *)
Subscript[QZip, \[Zeta]s_List,simp_]@\[DoubleStruckCapitalE][L_,Q_,P_] := Module[{\[Zeta],z,zs,c,ys,\[Eta]s,qt,zrule,Q1,Q2},
zs=Table[SuperStar[\[Zeta]],{\[Zeta],\[Zeta]s}];
c=Q/.Alternatives@@(\[Zeta]s\[Union]zs)->0;
ys=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(\[Zeta]\)]\((Q /. Alternatives @@ zs -> 0)\)\),{\[Zeta],\[Zeta]s}];
\[Eta]s=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(z\)]\((Q /. Alternatives @@ \[Zeta]s -> 0)\)\),{z,zs}];
qt=Inverse@Table[Subscript[K\[Delta], z,SuperStar[\[Zeta]]]-\!\(
\*SubscriptBox[\(\[PartialD]\), \(z, \[Zeta]\)]Q\),{\[Zeta],\[Zeta]s},{z,zs}];
zrule=Thread[zs->qt.(zs+ys)];
Q2=(Q1=c+\[Eta]s.zs/.zrule)/.Alternatives@@zs->0;
simp /@ \[DoubleStruckCapitalE][L,Q2,Det[qt]E^-Q2 Subscript[Zip, \[Zeta]s][E^Q1 (P/.zrule)]] ];
Subscript[QZip, \[Zeta]s_List]:=Subscript[QZip, \[Zeta]s,CF];


(* ::Input::Initialization:: *)
Subscript[LZip, \[Zeta]s_List,simp_]@\[DoubleStruckCapitalE][L_,Q_,P_] := Module[{\[Zeta],z,zs,c,ys,\[Eta]s,\[Eta]srule,lt,zrule,L1,L2,Q1,Q2},
(*Print["LZipping"];*)
(*\[Zeta]s//Echo;*)
zs=Table[SuperStar[\[Zeta]],{\[Zeta],\[Zeta]s}];
c=L/.Alternatives@@(\[Zeta]s\[Union]zs)->0;
ys=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(\[Zeta]\)]\((L /. Alternatives @@ zs -> 0)\)\),{\[Zeta],\[Zeta]s}];
\[Eta]s=Table[\!\(
\*SubscriptBox[\(\[PartialD]\), \(z\)]\((L /. Alternatives @@ \[Zeta]s -> 0)\)\),{z,zs}];
\[Eta]srule= Table[SuperStar[z]->\!\(
\*SubscriptBox[\(\[PartialD]\), \(z\)]\((L /. Alternatives @@ \[Zeta]s -> 0)\)\),{z,zs}];(*NEW*)
lt=Inverse@Table[Subscript[K\[Delta], z,SuperStar[\[Zeta]]]-\!\(
\*SubscriptBox[\(\[PartialD]\), \(z, \[Zeta]\)]L\),{\[Zeta],\[Zeta]s},{z,zs}];
zrule=Thread[zs->lt.(zs+ys)];
L1=c+\[Eta]s.zs/.zrule;
L2=L1/.Alternatives@@zs->0;
Q1=Q/.Join[zrule,\[Eta]srule];
Q2=Q1/.Join[{Alternatives@@zs->0},\[Eta]srule];
(*{Det[lt]\[ExponentialE]^(-L2-Q2),Subscript[Zip, \[Zeta]s][\[ExponentialE]^(L1+Q1)(P/.zrule)]}//Echo;*)
simp /@ \[DoubleStruckCapitalE][L2,Q2,Det[lt]E^(-L2-Q2) Subscript[Zip, \[Zeta]s][E^(L1+Q1) (P/.zrule)]] ];
Subscript[LZip, \[Zeta]s_List]:=Subscript[LZip, \[Zeta]s,CF];


(* ::Input::Initialization:: *)
\!\(\*SubscriptBox[\(Bind\), \({}\)]\)[L_,R_]:=L R;
\!\(\*SubscriptBox[\(Bind\), \({is__}\)]\)[L_\[DoubleStruckCapitalE],R_\[DoubleStruckCapitalE]] := Module[{n},
Flatten@Table[{Subscript[\[Tau], n@i],Subscript[a, n@i]},{i,{is}}];
Flatten@Table[{Subscript[\[Xi], n@i],Subscript[y, n@i]},{i,{is}}];
Times[
L/.Table[Subscript[(v:b|a|x|y), i]->Subscript[v, n@i],{i,{is}}],
R/.Table[Subscript[(v:\[Beta]|\[Alpha]|\[Xi]|\[Eta]), i]->Subscript[v, n@i],{i,{is}}]
] // Subscript[LZip, Flatten@Table[{Subscript[\[Beta], n@i],Subscript[a, n@i]},{i,{is}}]] // Subscript[QZip, Flatten@Table[{Subscript[\[Xi], n@i],Subscript[y, n@i]},{i,{is}}]] ];
Subscript[B, l_List]:=Subscript[Bind, l]; Subscript[B, is___]:=\!\(\*SubscriptBox[\(Bind\), \({is}\)]\);


(* ::Input::Initialization:: *)
(*Hopf algebra on the a,x side*)
Subscript[tam, i_,j_->k_]:=\[DoubleStruckCapitalE][(Subscript[\[Alpha], i]+Subscript[\[Alpha], j])Subscript[a, k],(\[DoubleStruckE]^-Subscript[\[Alpha], j] Subscript[\[Xi], i]+Subscript[\[Xi], j])Subscript[x, k],1]
Subscript[ta\[CapitalDelta], i_->j_,k_]:=\[DoubleStruckCapitalE][Subscript[\[Alpha], i](Subscript[a, j]+Subscript[a, k]),Subscript[\[Xi], i](Subscript[x, j]+Subscript[x, k]),1]
Subscript[taS, i_]:=\[DoubleStruckCapitalE][-Subscript[\[Alpha], i] Subscript[a, i],-\[DoubleStruckE]^ Subscript[\[Alpha], i] Subscript[\[Xi], i] Subscript[x, i],1]
Subscript[taSi, i_]:=\[DoubleStruckCapitalE][-Subscript[\[Alpha], i] Subscript[a, i],-\[DoubleStruckE]^ Subscript[\[Alpha], i] Subscript[\[Xi], i] Subscript[x, i],1]
(*Hopf algebra on the y,b side*)
Subscript[tbm, i_,j_->k_]:=\[DoubleStruckCapitalE][(Subscript[\[Beta], i]+Subscript[\[Beta], j])Subscript[b, k],(Subscript[\[Eta], i]+Subscript[\[Eta], j])Subscript[y, k],1]
Subscript[tb\[CapitalDelta], i_->j_,k_]:=\[DoubleStruckCapitalE][Subscript[\[Beta], i](Subscript[b, j]+Subscript[b, k]),Subscript[\[Eta], i](\[DoubleStruckE]^- Subscript[b, k] Subscript[y, j]+Subscript[y, k]),1]
Subscript[tbS, i_]:=\[DoubleStruckCapitalE][-Subscript[\[Beta], i] Subscript[b, i],-\[DoubleStruckE]^ Subscript[b, i] Subscript[\[Eta], i] Subscript[y, i],1]
Subscript[tbSi, i_]:=\[DoubleStruckCapitalE][-Subscript[\[Beta], i] Subscript[b, i],-\[DoubleStruckE]^Subscript[b, i] Subscript[\[Eta], i] Subscript[y, i],1]


(* ::Input::Initialization:: *)
Subscript[tP, i_,j_]:=\[DoubleStruckCapitalE][Subscript[\[Beta], i] Subscript[\[Alpha], j],Subscript[\[Eta], i] Subscript[\[Xi], j],1]


(* ::Input::Initialization:: *)
Subscript[tdm, i_,j_->k_]:=\[DoubleStruckCapitalE][Subscript[a, k] (Subscript[\[Alpha], i]+Subscript[\[Alpha], j])+Subscript[b, k] (Subscript[\[Beta], i]+Subscript[\[Beta], j]),Subscript[y, k] (Subscript[\[Eta], i]+\[DoubleStruckE]^-Subscript[\[Alpha], i] Subscript[\[Eta], j])+Subscript[x, k] (\[DoubleStruckE]^-Subscript[\[Alpha], j] Subscript[\[Xi], i]+Subscript[\[Xi], j])+(1-\[DoubleStruckE]^-Subscript[b, k]) Subscript[\[Eta], j] Subscript[\[Xi], i],1]
Subscript[td\[CapitalDelta], i_->j_,k_]:=\[DoubleStruckCapitalE][Subscript[\[Alpha], i](Subscript[a, j] +Subscript[a, k] )+Subscript[\[Beta], i](Subscript[b, j]+Subscript[b, k]),( Subscript[y, j]+\[DoubleStruckE]^-Subscript[b, j] Subscript[y, k]) Subscript[\[Eta], i]+ (Subscript[x, j]+Subscript[x, k] )Subscript[\[Xi], i],1]
Subscript[tdS, i_]:=\[DoubleStruckCapitalE][-Subscript[a, i] Subscript[\[Alpha], i]-Subscript[b, i] Subscript[\[Beta], i],-\[DoubleStruckE]^(Subscript[b, i]+Subscript[\[Alpha], i]) Subscript[y, i] Subscript[\[Eta], i]-\[DoubleStruckE]^Subscript[\[Alpha], i] Subscript[x, i] Subscript[\[Xi], i]-\[DoubleStruckE]^Subscript[\[Alpha], i] Subscript[\[Eta], i] Subscript[\[Xi], i]+\[DoubleStruckE]^(Subscript[b, i]+Subscript[\[Alpha], i]) Subscript[\[Eta], i] Subscript[\[Xi], i],1]


(* ::Input::Initialization:: *)
Subscript[tR, i_,j_]:=\[DoubleStruckCapitalE][Subscript[b, i] Subscript[a, j],Subscript[y, i] Subscript[x, j],1]
Subscript[\!\(\*OverscriptBox[\(tR\), \(_\)]\), i_,j_]:=\[DoubleStruckCapitalE][-Subscript[a, j] Subscript[b, i],-\[DoubleStruckE]^Subscript[b, i] Subscript[x, j] Subscript[y, i],1](*derived from tdS!*)
Subscript[tC, i_]:=\[DoubleStruckCapitalE][0,0,\[DoubleStruckE]^( -1/2 Subscript[b, i])]
Subscript[\!\(\*OverscriptBox[\(tC\), \(_\)]\), i_]:=\[DoubleStruckCapitalE][0,0,\[DoubleStruckE]^( 1/2 Subscript[b, i])]
Subscript[tKink, i_]:=\[DoubleStruckCapitalE][Subscript[a, i] Subscript[b, i],Subscript[x, i] Subscript[y, i],\[DoubleStruckE]^(Subscript[b, i]/2)]
Subscript[\!\(\*OverscriptBox[\(tKink\), \(_\)]\), i_]:=\[DoubleStruckCapitalE][-Subscript[a, i] Subscript[b, i],-\[DoubleStruckE]^Subscript[b, i] Subscript[x, i] Subscript[y, i],\[DoubleStruckE]^(-Subscript[b, i]/2)]


(* ::Input::Initialization:: *)
Subscript[u, i_]:=Subscript[tR, 1,2]~Subscript[B, 1]~Subscript[tdS, 1]~Subscript[B, 1,2]~Subscript[tdm, 2,1->i]
Subscript[ui, i_]:=Subscript[tR, 1,2]~Subscript[B, 2]~Subscript[tdS, 2]~Subscript[B, 2]~Subscript[tdS, 2]~Subscript[B, 1,2]~Subscript[tdm, 2,1->i]



