(* ::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:: *)
Print["MetaCalculi` loading..."]


(* ::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:: *)
\[Alpha]Simplify[expr_]:=expr // Together // ExpandDenominator // ExpandNumerator;
SetAttributes[\[Alpha]Collect, Listable];
\[Alpha]Collect[A[\[Omega]_, \[Sigma]_, \[Mu]_]] := A[
\[Alpha]Simplify[\[Omega]],\[Alpha]Simplify[\[Sigma]],
Collect[\[Mu], _h, Collect[#, _t, \[Alpha]Simplify]&]
];
\[Alpha]Collect[simp_][A[\[Omega]_, \[Sigma]_, \[Mu]_]] := A[
simp[\[Omega]],simp[\[Sigma]],
Collect[\[Mu], _h, Collect[#, _t, simp]&]
];
hL[\[Beta]_] := Union[Cases[\[Beta], h[s_] :> s, \[Infinity]]];
tL[\[Beta]_] := Union[Cases[\[Beta], t[s_]|Subscript[c, s_] :> s, \[Infinity]]];
dL[\[Beta]_] := Union[hL[\[Beta]], tL[\[Beta]]];
A[\[Omega]_,\[Sigma]_,\[Mu]_][\[CapitalSigma]] := (\!\(
\*SubscriptBox[\(\[PartialD]\), \(h[#]\)]\[Sigma]\))& /@ hL[A[\[Omega],\[Sigma],\[Mu]]];
\[Alpha]Form[A[\[Omega]_, \[Sigma]_, \[Mu]_]] := Module[
{tails, heads, M},
tails = tL[A[\[Omega], \[Sigma], \[Mu]]]; heads = hL[A[\[Omega], \[Sigma], \[Mu]]];
M = Outer[\[Alpha]Simplify[Coefficient[\[Mu], h[#1] t[#2]]]&, heads, tails];
PrependTo[M, t /@ tails];
M = Prepend[Transpose[M], Prepend[h /@ heads, \[Omega]]];
AppendTo[M, Prepend[A[\[Omega],\[Sigma],\[Mu]][\[CapitalSigma]], "A"]];
MatrixForm[M]
];
\[Alpha]Form[else_] := else /. \[Beta]_A :> \[Alpha]Form[\[Beta]];
Format[A[\[Omega]_, \[Sigma]_, \[Mu]_], StandardForm] := \[Alpha]Form[A[\[Omega], \[Sigma], \[Mu]]];
A /: A[\[Omega]1_, \[Sigma]1_, \[Mu]1_] == A[\[Omega]2_, \[Sigma]2_, \[Mu]2_] := Module[
{heads, tails},
tails = tL[{A[\[Omega]1, \[Sigma]1, \[Mu]1], A[\[Omega]2, \[Sigma]2, \[Mu]2]}];
heads = hL[{A[\[Omega]1, \[Sigma]1, \[Mu]1], A[\[Omega]2, \[Sigma]2, \[Mu]2]}];
(\[Omega]1 == \[Omega]2) \[And] (\[Sigma]1==\[Sigma]2) \[And] (
And @@ Flatten[Outer[
(Coefficient[\[Mu]1, t[#1]h[#2]] == Coefficient[\[Mu]2, t[#1]h[#2]])&,
tails, heads
]]
)
]


(* ::Input::Initialization:: *)
tm[x_, y_, z_][\[Beta]_A] := \[Alpha]Collect[\[Beta] /. {t[x]->t[z], t[y]->t[z], Subscript[c, x]->Subscript[c, z], Subscript[c, y]->Subscript[c, z]}];
t\[CapitalDelta][z_, x_, y_][\[Beta]_A] := \[Alpha]Collect[\[Beta] /. {t[z] -> t[x]+t[y], Subscript[c, z] -> Subscript[c, x]+Subscript[c, y]}];
t\[Eta][x_][\[Beta]_A] := \[Alpha]Collect[(\[Beta] /. t[x] -> 0) /. Subscript[c, x]->0];
tS[x_][\[Beta]_A] := \[Alpha]Collect[\[Beta] /. {t[x] -> -t[x], Subscript[c, x] -> -Subscript[c, x]}];
tA[_][\[Beta]_A] := \[Alpha]Collect[\[Beta]];
t\[Sigma][rules___Rule][\[Beta]_A] := \[Alpha]Collect[
\[Beta] /. {t[x_] :> t[x /. {rules}], Subscript[c, x_] :> Subscript[c, x /. {rules}]}
];


(* ::Input::Initialization:: *)
hm[x_, y_, z_][A[\[Omega]_, \[Sigma]_, \[Mu]_]] := Module[
{\[Alpha]= D[\[Mu], h[x]], \[Beta]=D[\[Mu], h[y]], \[CapitalXi]=\[Mu] /. h[x]|h[y] -> 0},
A[\[Omega],
h[z](\!\(
\*SubscriptBox[\(\[PartialD]\), \(h[x]\)]\[Sigma]\))(\!\(
\*SubscriptBox[\(\[PartialD]\), \(h[y]\)]\[Sigma]\))+(\[Sigma] /. h[x|y]->0),
\[CapitalXi]+h[z](\[Alpha]+(\!\(
\*SubscriptBox[\(\[PartialD]\), \(h[x]\)]\[Sigma]\))\[Beta])
] // \[Alpha]Collect
];
h\[CapitalDelta][z_, x_, y_][\[Beta]_A] := \[Alpha]Collect[\[Beta] /. h[z] -> h[x]+h[y]];
h\[Eta][x_][\[Beta]_A] := \[Alpha]Collect[\[Beta] /. h[x] -> 0];
h\[Sigma][rules___Rule][\[Beta]_A] := \[Alpha]Collect[\[Beta] /. h[x_] :> h[x /. {rules}]];


(* ::Input::Initialization:: *)
tha[u_,x_][A[\[Omega]_, \[Sigma]_, \[Mu]_]] := Module[
{\[Alpha], \[Theta], \[Phi], \[CapitalXi], \[Nu]},
\[Alpha] = Coefficient[\[Mu], h[x]t[u]];
\[Theta] = D[\[Mu], t[u]] /. h[x] -> 0;
\[Phi] = D[\[Mu], h[x]] /. t[u] -> 0;
\[CapitalXi] = \[Mu] /. h[x]|t[u] -> 0;
\[Nu] = 1+Subscript[c, u]\[Alpha];
A[\[Omega]*\[Nu], \[Sigma], Plus[
\[Alpha] (\!\(
\*SubscriptBox[\(\[PartialD]\), \(h[x]\)]\[Sigma]\))/\[Nu]*h[x]t[u],
\[Theta] (\!\(
\*SubscriptBox[\(\[PartialD]\), \(h[x]\)]\[Sigma]\))/\[Nu]*t[u],
\[Phi]/\[Nu]*h[x],
\[CapitalXi]-Subscript[c, u]\[Phi]*\[Theta]/\[Nu]
]] // \[Alpha]Collect
];


(* ::Input::Initialization:: *)
dm[x_,y_,z_][\[Beta]_A] := \[Beta] // tha[x,y] // hm[x,y,z] // tm[x,y,z];
d\[CapitalDelta][z_, x_, y_][\[Beta]_] := \[Beta] // t\[CapitalDelta][z,x,y] // h\[CapitalDelta][z,x,y];
d\[Eta][s_][\[Beta]_] := \[Beta] // h\[Eta][s] // t\[Eta][s];
d\[Sigma][rules___][\[Beta]_] := \[Beta] // h\[Sigma][rules] // t\[Sigma][rules];
d\[Sigma][pl_List][\[Beta]_] := Module[
{\[Sigma], len, \[Beta]1, k},
len=Length[pl];
\[Beta]1 = \[Beta] // (d\[Sigma] @@ Table[i-> \[Sigma][i], {i, len}]);
Do[
k=pl[[i,1]];
\[Beta]1=\[Beta]1 // d\[Sigma][\[Sigma][i] -> k];
Do[
\[Beta]1 = \[Beta]1 // d\[CapitalDelta][k, k, pl[[i,j]]],
{j,2, Length[pl[[i]]]}
],
{i, len}
];
\[Beta]1
];
d\[Sigma][pl___Integer] := d\[Sigma][IntegerDigits /@ {pl}];


(* ::Input::Initialization:: *)
tr[a_][A[\[Omega]_, \[Sigma]_, \[Mu]_]] := Module[
{\[Alpha], \[Theta], \[Phi], \[CapitalXi], \[Nu]},
\[Alpha] = Coefficient[\[Mu], h[a]t[a]];
\[Theta] = D[\[Mu], t[a]] /. h[a] -> 0;
\[Phi] = D[\[Mu], h[a]] /. t[a] -> 0;
\[CapitalXi] = \[Mu] /. h[a]|t[a] -> 0;
\[Nu] = (\!\(
\*SubscriptBox[\(\[PartialD]\), \(h[a]\)]\[Sigma]\))-1-Subscript[c, a]\[Alpha];
A[-\[Omega]*\[Nu], \[Sigma] /. h[a]->0, \[CapitalXi]+Subscript[c, a] (\[Phi] \[Theta])/\[Nu]] // \[Alpha]Collect
];


(* ::Input::Initialization:: *)
A /: A[\[Omega]1_, \[Sigma]1_, \[Mu]1_]A[\[Omega]2_, \[Sigma]2_, \[Mu]2_] := A[\[Omega]1*\[Omega]2, \[Sigma]1+\[Sigma]2, \[Mu]1+\[Mu]2];


(* ::Input::Initialization:: *)
A/: \[Alpha]1_A**\[Alpha]2_A := Module[{S,\[Alpha],\[Tau]},
S=dL[{\[Alpha]1,\[Alpha]2}];
\[Alpha]=\[Alpha]1(\[Alpha]2 // d\[Sigma]@@((#->\[Tau][#])& /@ S));
\[Alpha][[2]]+= Total[h/@Complement[S,hL[\[Alpha]1]]] + Total[h/@\[Tau]/@Complement[S,hL[\[Alpha]2]]];
Do[
\[Alpha]=\[Alpha]//dm[s,\[Tau][s],s],
{s,S}
];
\[Alpha]
]


(* ::Input::Initialization:: *)
SetAttributes[A, Listable];
A[p_Times]:= A /@ p;
A[Xp[a_,b_]] :=\[Alpha]Collect[A[1, h[a]+E^Subscript[c, a] h[b], (E^Subscript[c, a]-1)/Subscript[c, a]*t[a]h[b]]];
A[Xm[a_,b_]] := \[Alpha]Collect[A[1, h[a]+E^-Subscript[c, a] h[b], (E^-Subscript[c, a]-1)/Subscript[c, a]*t[a]h[b]]];


(* ::Input::Initialization:: *)
A[\[CapitalTheta][a_,b_,p_]] := (A[1, E^(p Subscript[c, a]/2) h[1], (E^(p Subscript[c, a]/2)-1)/Subscript[c, a]*t[a]h[a]] // d\[CapitalDelta][a,a,b])**(A[1, E^(-p Subscript[c, a]/2) h[a], (E^(-p Subscript[c, a]/2)-1)/Subscript[c, a]*t[a]h[a]]A[1, E^(-p Subscript[c, b]/2) h[b], (E^(-p Subscript[c, b]/2)-1)/Subscript[c, b]*t[b]h[b]]);
A[\[CapitalTheta][a_,b_]] := A[\[CapitalTheta][a,b,1]];
(*A[\[CapitalTheta]i[a_,b_]] := (A[1, (\[ExponentialE]^(-Subscript[c, a]/2)-1)/Subscript[c, a]*t[a]h[a]] // d\[CapitalDelta][a,a,b])**(A[1, (\[ExponentialE]^(Subscript[c, a]/2)-1)/Subscript[c, a]*t[a]h[a]]A[1, (\[ExponentialE]^(Subscript[c, b]/2)-1)/Subscript[c, b]*t[b]h[b]])*)


(* ::Input::Initialization:: *)
\[CapitalGamma][\[CapitalTheta][a_,b_]] := \[CapitalTheta][a,b] // A // \[CapitalGamma];
\[CapitalGamma][\[CapitalTheta][a_,b_,p_]] := \[CapitalTheta][a,b,p] // A // \[CapitalGamma];


(* ::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:: *)
d\[CapitalDelta][a_,x_,y_][\[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_]] := Module[
{\[Alpha], \[Theta], \[Phi], \[CapitalXi], \[Sigma]a, Ta, M},
({
 {\[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 /. Subscript[T, a]->Ta;
\[Sigma]a=\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(h\), \(a\)]]\[Sigma]\) /. Subscript[T, a]->Ta;
M=({
 {\[Alpha]+(Log[Subscript[T, y]] (-\[Alpha]+\[Sigma]a))/Log[Ta], (Log[Subscript[T, x]] (\[Alpha]-\[Sigma]a))/Log[Ta], (\[Theta] Log[Subscript[T, x]])/Log[Ta]},
 {(Log[Subscript[T, y]] (\[Alpha]-\[Sigma]a))/Log[Ta], \[Alpha]+(Log[Subscript[T, x]] (-\[Alpha]+\[Sigma]a))/Log[Ta], (\[Theta] Log[Subscript[T, y]])/Log[Ta]},
 {\[Phi], \[Phi], \[CapitalXi]}
});
\[CapitalGamma]Collect[\[CapitalGamma][
\[Omega] /. Subscript[T, a]->Subscript[T, x] Subscript[T, y],
((\[Sigma]/.Subscript[h, a]->0)+(Subscript[h, x]+Subscript[h, y])\[Sigma]a) /. Ta|Subscript[T, a]->Subscript[T, x] Subscript[T, y],
{Subscript[t, x], Subscript[t, y], 1}.M.{Subscript[h, x], Subscript[h, y], 1} /. Ta->Subscript[T, x] Subscript[T, y]
]]
];


(* ::Input::Initialization:: *)
q\[CapitalDelta][a_,x_,y_][\[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_]] := Module[
{\[Alpha], \[Theta], \[Phi], \[CapitalXi], \[Sigma]a, Ta, M},
({
 {\[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 /. Subscript[T, a]->Ta;
\[Sigma]a=\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(h\), \(a\)]]\[Sigma]\)/. Subscript[T, a]->Ta;
M=({
 {(-\[Sigma]a+\[Alpha] Ta+(-\[Alpha]+\[Sigma]a) Subscript[T, y])/(-1+Ta), ((-1+Subscript[T, x]) Subscript[T, y] (\[Alpha]-\[Sigma]a))/(-1+Ta), (\[Theta] (-1+Subscript[T, x]) Subscript[T, y])/(-1+Ta)},
 {((-1+Subscript[T, y]) (\[Alpha]-\[Sigma]a))/(-1+Ta), (-\[Alpha]+\[Sigma]a Ta+(\[Alpha]-\[Sigma]a) Subscript[T, y])/(-1+Ta), (\[Theta] (-1+Subscript[T, y]))/(-1+Ta)},
 {\[Phi], \[Phi], \[CapitalXi]}
});
\[CapitalGamma]Collect[\[CapitalGamma][
\[Omega] /. Subscript[T, a]->Subscript[T, x] Subscript[T, y],
((\[Sigma]/.Subscript[h, a]->0)+(Subscript[h, x]+Subscript[h, y])\[Sigma]a) /. Subscript[T, a]|Ta->Subscript[T, x] Subscript[T, y],
{Subscript[t, x], Subscript[t, y], 1}.M.{Subscript[h, x], Subscript[h, y], 1} /. Ta->Subscript[T, x] Subscript[T, y]
]]
];


(* ::Input::Initialization:: *)
\[CapitalGamma][V] = \[CapitalGamma][(((-1+Subscript[T, 1])/Log[Subscript[T, 1]])^(1/4) ((-1+Subscript[T, 2])/Log[Subscript[T, 2]])^(1/4))/((-1+Subscript[T, 1] Subscript[T, 2])/Log[Subscript[T, 1] Subscript[T, 2]])^(1/4), Subscript[h, 1]+Subscript[h, 2] Sqrt[Subscript[T, 1]],
{Subscript[t, 1],Subscript[t, 2]}.({
 {(Log[Subscript[T, 1]] (1+(Log[Subscript[T, 2]] Sqrt[((-1+Subscript[T, 1]) Subscript[T, 1])/Log[Subscript[T, 1]]] Sqrt[(-1+Subscript[T, 2])/Log[Subscript[T, 2]]])/((-1+Subscript[T, 1]) Sqrt[(-1+Subscript[T, 1] Subscript[T, 2])/Log[Subscript[T, 1] Subscript[T, 2]]])))/Log[Subscript[T, 1] Subscript[T, 2]], (Log[Subscript[T, 1]] (1-(Sqrt[((-1+Subscript[T, 1]) Subscript[T, 1])/Log[Subscript[T, 1]]] Subscript[T, 2])/(Sqrt[(-1+Subscript[T, 2])/Log[Subscript[T, 2]]] Sqrt[(-1+Subscript[T, 1] Subscript[T, 2])/Log[Subscript[T, 1] Subscript[T, 2]]])))/Log[Subscript[T, 1] Subscript[T, 2]]},
 {(Log[Subscript[T, 2]] (1-(Subscript[T, 1] Sqrt[(-1+Subscript[T, 2])/Log[Subscript[T, 2]]])/(Sqrt[((-1+Subscript[T, 1]) Subscript[T, 1])/Log[Subscript[T, 1]]] Sqrt[(-1+Subscript[T, 1] Subscript[T, 2])/Log[Subscript[T, 1] Subscript[T, 2]]])))/Log[Subscript[T, 1] Subscript[T, 2]], (Log[Subscript[T, 2]] (1+(Log[Subscript[T, 1]] Sqrt[((-1+Subscript[T, 1]) Subscript[T, 1])/Log[Subscript[T, 1]]] Subscript[T, 2])/(Log[Subscript[T, 2]] Sqrt[(-1+Subscript[T, 2])/Log[Subscript[T, 2]]] Sqrt[(-1+Subscript[T, 1] Subscript[T, 2])/Log[Subscript[T, 1] Subscript[T, 2]]])))/Log[Subscript[T, 1] Subscript[T, 2]]}
}).{Subscript[h, 1],Subscript[h, 2]}
];
\[CapitalGamma][Vi] = \[CapitalGamma][((-1+Subscript[T, 1] Subscript[T, 2])/Log[Subscript[T, 1] Subscript[T, 2]])^(1/4)/(((-1+Subscript[T, 1])/Log[Subscript[T, 1]])^(1/4) ((-1+Subscript[T, 2])/Log[Subscript[T, 2]])^(1/4)), Subscript[h, 1]+Subscript[h, 2]/Sqrt[Subscript[T, 1]],
{Subscript[t, 1],Subscript[t, 2]}.({
 {((-1+Subscript[T, 1]) Subscript[T, 2]+Log[Subscript[T, 2]] Sqrt[(-1+Subscript[T, 1])/(Log[Subscript[T, 1]] Subscript[T, 1])] Sqrt[(-1+Subscript[T, 2])/Log[Subscript[T, 2]]] Sqrt[(-1+Subscript[T, 1] Subscript[T, 2])/Log[Subscript[T, 1] Subscript[T, 2]]])/(-1+Subscript[T, 1] Subscript[T, 2]), ((-1+Subscript[T, 1]) Subscript[T, 2]-Log[Subscript[T, 1]] Sqrt[(-1+Subscript[T, 1])/(Log[Subscript[T, 1]] Subscript[T, 1])] Sqrt[(-1+Subscript[T, 2])/Log[Subscript[T, 2]]] Sqrt[(-1+Subscript[T, 1] Subscript[T, 2])/Log[Subscript[T, 1] Subscript[T, 2]]])/(-1+Subscript[T, 1] Subscript[T, 2])},
 {(-1+Subscript[T, 2]-Log[Subscript[T, 2]] Sqrt[(-1+Subscript[T, 1])/(Log[Subscript[T, 1]] Subscript[T, 1])] Sqrt[(-1+Subscript[T, 2])/Log[Subscript[T, 2]]] Sqrt[(-1+Subscript[T, 1] Subscript[T, 2])/Log[Subscript[T, 1] Subscript[T, 2]]])/(-1+Subscript[T, 1] Subscript[T, 2]), (-1+Subscript[T, 2]+Log[Subscript[T, 1]] Sqrt[(-1+Subscript[T, 1])/(Log[Subscript[T, 1]] Subscript[T, 1])] Sqrt[(-1+Subscript[T, 2])/Log[Subscript[T, 2]]] Sqrt[(-1+Subscript[T, 1] Subscript[T, 2])/Log[Subscript[T, 1] Subscript[T, 2]]])/(-1+Subscript[T, 1] Subscript[T, 2])}
}).{Subscript[h, 1],Subscript[h, 2]}
];


(* ::Input::Initialization:: *)
A[\[Omega]_, \[Sigma]_, \[Mu]_] // \[CapitalGamma] := Module[{S},
S=dL[{\[Omega], \[Mu]}];
\[CapitalGamma][\[Omega],
Total[Subscript[h, #]& /@ S]+\[Mu] /. {h[a_] :> Subscript[h, a], t[a_] :> Subscript[c, a]},
Total[(Subscript[t, #] Subscript[h, #])& /@ S]+(\[Mu] /. t[a_] :> Subscript[c, a] /. h[a_] :> Subscript[h, a] Subscript[t, a])-\[Mu] /. {h[a_] :> Subscript[h, a], t[a_] :> Subscript[c, a] Subscript[t, a]}
] /. Subscript[c, a_]:>Log[Subscript[T, a]]// \[CapitalGamma]Collect[FullSimplify[# /. Sinh[x_] :> (E^x-E^-x)/2]&]
];


(* ::Input::Initialization:: *)
\[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_] // A := Module[{S, \[Mu]},
S=dL[\[CapitalGamma][\[Omega],\[Sigma],\[Lambda]]];
\[Mu]=Total[((\!\(
\*SubscriptBox[\(\[PartialD]\), 
SubscriptBox[\(h\), \(#\)]]\[Sigma]\))Subscript[t, #] Subscript[h, #])& /@ S]-\[Lambda];
A[\[Omega],
\[Sigma] /. Subscript[h, a_]:>h[a],
\[Mu] /. {Subscript[h, a_]:>h[a], Subscript[t, a_] :> t[a]/Subscript[c, a]}
] /. Subscript[T, a_]:>E^Subscript[c, a]// \[Alpha]Collect
];


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


(* ::Input::Initialization:: *)
\[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_] // \[CapitalGamma]b := \[CapitalGamma]bCollect[\[CapitalGamma]b[\[Omega],\[Sigma],\[Omega]*\[Lambda]]];
\[CapitalGamma]b[\[Omega]_,\[Sigma]_,\[Lambda]_] // \[CapitalGamma] := \[CapitalGamma]Collect[\[CapitalGamma][\[Omega],\[Sigma],\[Lambda]/\[Omega]]];
\[Alpha]_A// \[CapitalGamma]b := \[Alpha] // \[CapitalGamma] // \[CapitalGamma]b


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


(* ::Input::Initialization:: *)
\[CapitalGamma][\[Omega]_,\[Sigma]_,\[Lambda]_] // \[CapitalGamma]1 := \[CapitalGamma]1Collect[\[CapitalGamma]1[\[Omega],\[Sigma],\[Lambda] /. {Subscript[h, s_]:>(1-Subscript[T, s])Subscript[h, s], Subscript[t, s_]:>Subscript[t, s]/(1-Subscript[T, s])}]];
\[CapitalGamma]1[\[Omega]_,\[Sigma]_,\[Lambda]_] // \[CapitalGamma] := \[CapitalGamma]Collect[\[CapitalGamma][\[Omega],\[Sigma],\[Lambda] /. {Subscript[h, s_]:>Subscript[h, s]/(1-Subscript[T, s]), Subscript[t, s_]:>(1-Subscript[T, s])Subscript[t, s]}]];
\[Alpha]_A// \[CapitalGamma]1 := \[Alpha] // \[CapitalGamma] // \[CapitalGamma]1


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


(* ::Input::Initialization:: *)
\[CapitalGamma]1 /: \[CapitalGamma]1[\[Omega]1_,\[Sigma]1_,\[Lambda]1_]\[CapitalGamma]1[\[Omega]2_,\[Sigma]2_,\[Lambda]2_] := \[CapitalGamma]1[\[Omega]1*\[Omega]2, \[Sigma]1+\[Sigma]2, \[Lambda]1+\[Lambda]2];\[Gamma]_\[CapitalGamma]1 // op_dm := \[Gamma] // \[CapitalGamma] // op // \[CapitalGamma]1;
\[Gamma]_\[CapitalGamma]1 // op_q\[CapitalDelta] := \[Gamma] // \[CapitalGamma] // op // \[CapitalGamma]1;
