Pensieve header: A common program for all w-meta-calculi. Continued pensieve://2014-06/MetaCalculi/.

General

(Subscript[Xp, a_,b_]):= Xp[a,b]; (Subscript[Xm, a_,b_]):=Xm[a,b];

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[χ_, L_] := Module[{s, z},
{s, z} = List @@ SXForm[L];
z=χ[z];
Do[z = z // dm[s[[c,1]],s[[c,k]] ,s[[c,1]]], {c, Length[s]},{k, 2, Length[s[[c]]]}];
z
];

α-Calculus

α-calculus is really the “exact” β-calculus of pensieve://2012-05/beta5.1

Utilities

αSimplify[expr_]:=expr // Together // ExpandDenominator // ExpandNumerator;
SetAttributes[αCollect, Listable];
αCollect[A[ω_, μ_]] := A[
αSimplify[ω],
Collect[μ, _h, Collect[#, _t, αSimplify]&]
];
αCollect[simp_][A[ω_, μ_]] := A[
simp[ω],
Collect[μ, _h, Collect[#, _t, simp]&]
];
hL[β_] := Union[Cases[β, h[s_] :> s, Infinity]];
tL[β_] := Union[Cases[β, t[s_]|(Subscript[c, s_]) :> s, Infinity]];
dL[β_] := Union[hL[β], tL[β]];
αForm[A[ω_, μ_]] := Module[
{tails, heads, mat},
tails = tL[A[ω, μ]]; heads = hL[A[ω, μ]];
mat = Outer[αSimplify[Coefficient[μ, h[#1] t[#2]]]&, heads, tails];
PrependTo[mat, t /@ tails];
mat = Prepend[Transpose[mat], Prepend[h /@ heads, ω]];
MatrixForm[mat]
];
αForm[else_] := else /. β_A :> αForm[β];
Format[A[ω_, μ_], StandardForm] := αForm[A[ω, μ]];
A /: A[ω1_, μ1_] == A[ω2_, μ2_] := Module[
{heads, tails},
tails = tL[{A[ω1, μ1], A[ω2, μ2]}];
heads = hL[{A[ω1, μ1], A[ω2, μ2]}];
(ω1 == ω2) && (
And @@ Flatten[Outer[
(Coefficient[μ1, t[#1]h[#2]] == Coefficient[μ2, t[#1]h[#2]])&,
tails, heads
]]
)
]

The Meta-Cross-Product

The “Tails” meta-group

tm[x_, y_, z_][β_A] := αCollect[β /. {t[x]->t[z], t[y]->t[z], (Subscript[c, x])->(Subscript[c, z]), (Subscript[c, y])->(Subscript[c, z])}];
tΔ[z_, x_, y_][β_A] := αCollect[β /. {t[z] -> t[x]+t[y], (Subscript[c, z]) -> (Subscript[c, x])+(Subscript[c, y])}];
tη[x_][β_A] := αCollect[(β /. t[x] -> 0) /. (Subscript[c, x])->0];
tS[x_][β_A] := αCollect[β /. {t[x] -> -t[x], (Subscript[c, x]) -> -(Subscript[c, x])}];
tA[_][β_A] := αCollect[β];
tσ[rules___Rule][β_A] := αCollect[
β /. {t[x_] :> t[x /. {rules}], (Subscript[c, x_]) :> (Subscript[c, x /. {rules}])}
];

The “Heads” meta-group

hm[x_, y_, z_][A[ω_, μ_]] := Module[
{γx= D[μ, h[x]], γy=D[μ, h[y]], M=μ /. h[x]|h[y] -> 0},
A[ω, M+h[z](γx+γy+(γx /. t[i_] :> (Subscript[c, i]))γy)] // αCollect
];
hΔ[z_, x_, y_][β_A] := αCollect[β /. h[z] -> h[x]+h[y]];
hη[x_][β_A] := αCollect[β /. h[x] -> 0];
hS[x_][A[ω_, μ_]] := Module[{γ},
γ = 1 + D[μ, h[x]] /. t[s_]:>(Subscript[c, s]);
αCollect[A[ω, μ /. h[x] -> -h[x]/γ]]
];
hA[x_][β_A] := hS[x][β];
hσ[rules___Rule][β_A] := αCollect[β /. h[x_] :> h[x /. {rules}]];

The TH -> HT  and HT -> TH Swaps

tha[x_,y_][A[ω_, μ_]] := Module[
{α, β, γ, δ, ϵ},
α = Coefficient[μ, h[y]t[x]];
β = D[μ, t[x]] /. h[y] -> 0;
γ = D[μ, h[y]] /. t[x] -> 0;
δ = μ /. h[y]|t[x] -> 0;
ϵ = 1+(Subscript[c, x])α;
A[ω*ϵ, Plus[
α(1+(γ /. t[i_] :> (Subscript[c, i]))/ϵ)h[y]t[x],
β(1+(γ /. t[i_] :> (Subscript[c, i]))/ϵ)t[x],
γ/ϵ h[y],
δ-(Subscript[c, x])/ϵ γ*β
]] // αCollect
];
hta[x_, y_][β_A] := β // hS[x] // tha[y,x] // hS[x];

The “double” meta-group

dm[x_,y_,z_][β_] := β // tha[x,y] // hm[x,y,z] // tm[x,y,z];
dΔ[z_, x_, y_][β_] := β // tΔ[z,x,y] // hΔ[z,x,y];
dS[s_][β_] := β // hta[s,s] // hS[s] // tS[s];
dA[s_][β_] := β // hta[s,s] // hA[s] // tA[s];
dη[s_][β_] := β // hη[s] // tη[s];
dcap[s_][β_] := β // hta[s,s] // hη[s];
dσ[rules___][β_] := β // hσ[rules] // tσ[rules];
dσ[pl_List][β_] := Module[
{σ, len, β1, k},
len=Length[pl];
β1 = β // (dσ @@ Table[i-> σ[i], {i, len}]);
Do[
k=pl[[i,1]];
β1=β1 // dσ[σ[i] -> k];
Do[
β1 = β1 // dΔ[k, k, pl[[i,j]]],
{j,2, Length[pl[[i]]]}
],
{i, len}
];
β1
];
dσ[pl___Integer] := dσ[IntegerDigits /@ {pl}];

The “external” product

A /: A[ω1_, μ1_]A[ω2_, μ2_] := A[ω1*ω2, μ1+μ2];

Tangle Concatenation

A/: α1_A**α2_A := Module[{S,α,τ},
S=dL[α1];
α=α1(α2 // dσ@@((#->τ[#])& /@ S));
Do[
α=α//dm[s,τ[s],s],
{s,S}
];
α
]

The R-Matrix

SetAttributes[A, Listable];
A[p_Times]:= A /@ p;
A[Xp[a_,b_]] :=αCollect[A[1, ((E^(Subscript[c, a]))-1)/(Subscript[c, a])*t[a]h[b]]];
A[Xm[a_,b_]] := αCollect[A[1, ((E^(-(Subscript[c, a])))-1)/(Subscript[c, a])*t[a]h[b]]];
A[Θ[a_,b_]] := (A[1, ((E^((Subscript[c, a])/2))-1)/(Subscript[c, a])*t[a]h[a]] // dΔ[a,a,b])**(A[1, ((E^(-(Subscript[c, a])/2))-1)/(Subscript[c, a])*t[a]h[a]]A[1, ((E^(-(Subscript[c, b])/2))-1)/(Subscript[c, b])*t[b]h[b]]);
A[Θi[a_,b_]] := (A[1, ((E^(-(Subscript[c, a])/2))-1)/(Subscript[c, a])*t[a]h[a]] // dΔ[a,a,b])**(A[1, ((E^((Subscript[c, a])/2))-1)/(Subscript[c, a])*t[a]h[a]]A[1, ((E^((Subscript[c, b])/2))-1)/(Subscript[c, b])*t[b]h[b]])

The Exact KV Solution in α

Module[{ν,κ,ω,α,β,γ,δ},
ν[x_]:=(Sqrt[((Sinh[(x/2)])/(x/2))]); κ[x_]:=((ν[x])^(-1/2)); ω=((κ[(Subscript[c, 1])+(Subscript[c, 2])])/(κ[(Subscript[c, 1])]κ[(Subscript[c, 2])]));
γ=((ν[(Subscript[c, 2])]-ν[(Subscript[c, 1])] ν[(Subscript[c, 1])+(Subscript[c, 2])])/(((Subscript[c, 1])+(Subscript[c, 2]))ν[(Subscript[c, 1])] ν[(Subscript[c, 1])+(Subscript[c, 2])])); δ=((E^((Subscript[c, 1])/2))/(Subscript[c, 2]))-((ν[(Subscript[c, 1])+(Subscript[c, 2])](E^((Subscript[c, 1])+(Subscript[c, 2]))) ν[(Subscript[c, 1])] (Subscript[c, 1]) )/((-1+(E^((Subscript[c, 1])+(Subscript[c, 2])))) ν[(Subscript[c, 2])] (Subscript[c, 2])))-(1/((Subscript[c, 1])+(Subscript[c, 2])));
α=((-(Subscript[c, 2]))/(Subscript[c, 1]))γ; β=(1/(Subscript[c, 1]))((E^((Subscript[c, 1])/2))-(Subscript[c, 2])δ-1);
{A[C]=αCollect[A[κ[(Subscript[c, 1])],0]],
A[V]= αCollect[A[ω,{t@1,t@2}.(({{α, β}, {γ, δ}})).{h@1,h@2}]],
A[Vi] = A[V] // dA[1] // dA[2]
}
]

qΔ (“renormalized cabling”)

qΔ[a_,x_,y_][A[ω_, μ_]] := Module[
{α, θ, ϕ, Ξ, M},
(({{α, θ}, {ϕ, Ξ}}))=(({{(∂_(h[a],t[a]))μ, (∂_(t[a]))μ}, {(∂_(h[a]))μ, μ}})) /. (h|t)[a]->0;
M=(({{((((E^(Subscript[c, a]))-(E^(Subscript[c, y]))) α (Subscript[c, a]))/((-1+(E^(Subscript[c, a]))) (Subscript[c, x]))), ((((E^(Subscript[c, a]))-(E^(Subscript[c, y]))) α (Subscript[c, a]))/((-1+(E^(Subscript[c, a]))) (Subscript[c, x]))), ((((E^(Subscript[c, a]))-(E^(Subscript[c, y]))) θ (Subscript[c, a]))/((-1+(E^(Subscript[c, a]))) (Subscript[c, x])))}, {(((-1+(E^(Subscript[c, y]))) α (Subscript[c, a]))/((-1+(E^(Subscript[c, a]))) (Subscript[c, y]))), (((-1+(E^(Subscript[c, y]))) α (Subscript[c, a]))/((-1+(E^(Subscript[c, a]))) (Subscript[c, y]))), (((-1+(E^(Subscript[c, y]))) θ (Subscript[c, a]))/((-1+(E^(Subscript[c, a]))) (Subscript[c, y])))}, {ϕ, ϕ, Ξ}}));
αCollect[A[ω, {t[x], t[y], 1}.M.{h[x], h[y], 1}] /. (Subscript[c, a])->(Subscript[c, x])+(Subscript[c, y])]
];

Γ-Calculus

ΓSimp=Factor; SetAttributes[ΓCollect, Listable];
ΓCollect[Γ[ω_,σ_,λ_]] := ΓCollect[ΓSimp][Γ[ω,σ,λ]];
ΓCollect[simp_][Γ[ω_,σ_,λ_]] := Γ[simp[ω], simp[σ],
Collect[λ, (Subscript[h, _]), Collect[#,(Subscript[t, _]), simp]&]];
dL[Γ[_,_,λ_]] := Union[Cases[λ, (Subscript[(h|t), a_]) :> a, Infinity]];
Γ[ω1_,_, _][ω] := ω1;
Γ[ω_,σ_,λ_][Σ] := ((∂_(Subscript[h, #]))σ)& /@ dL[Γ[ω,σ,λ]];
Γ[ω_,σ_,λ_][A] := Module[{S=dL[Γ[ω,σ,λ]]}, Outer[ΓSimp[((∂_((Subscript[t, #1]),(Subscript[h, #2])))λ)]&, S, S]];
ΓForm[Γ[ω_,σ_,λ_]] := Module[{S, M},
S = dL[Γ[ω,σ,λ]];
M = Γ[ω,σ,λ][A] // Transpose;
PrependTo[M, (Subscript[s, #])& /@ S];
M = Join[
{Prepend[(Subscript[s, #])& /@ S, ω]},
Transpose[M],
{Prepend[Γ[ω,σ,λ][Σ], "Σ"]}
];
MatrixForm[M]
];
ΓForm[else_] := else /. Γ[ω_,σ_,λ_] :> ΓForm[Γ[ω,σ,λ]];
Format[Γ[ω_,σ_,λ_], StandardForm] := ΓForm[Γ[ω,σ,λ]];

Γ /: Γ[ω1_,σ1_, μ1_] == Γ[ω2_,σ2_, μ2_] := Module[
{S},
S=dL[Γ[ω1,σ1, μ1]]⋃dL[Γ[ω2,σ2, μ2]];
(ω1 == ω2) && (And @@ (((∂_(Subscript[h, #]))σ1 == (∂_(Subscript[h, #]))σ2)& /@ S)) && (
And @@ Flatten[Outer[
((∂_((Subscript[t, #1]),(Subscript[h, #2])))μ1== (∂_((Subscript[t, #1]),(Subscript[h, #2])))μ2)&,
S,S
]]
)
]

Γ /: Γ[ω1_,σ1_,λ1_]Γ[ω2_,σ2_,λ2_] := Γ[ω1*ω2, σ1+σ2, λ1+λ2];
(Subscript[dm, a_,b_->c_])[Γ[ω_,σ_,λ_]] := Module[{α,β,γ,δ,θ,ϵ,ϕ,ψ,Ξ,μ},
(({{α, β, θ}, {γ, δ, ϵ}, {ϕ, ψ, Ξ}}))=(({{(∂_((Subscript[t, a]),(Subscript[h, a])))λ, (∂_((Subscript[t, a]),(Subscript[h, b])))λ, (∂_(Subscript[t, a]))λ}, {(∂_((Subscript[t, b]),(Subscript[h, a])))λ, (∂_((Subscript[t, b]),(Subscript[h, b])))λ, (∂_(Subscript[t, b]))λ}, {(∂_(Subscript[h, a]))λ, (∂_(Subscript[h, b]))λ, λ}}))/.(Subscript[(t|h), a|b])->0;
ΓCollect[Γ[(μ=1-β)ω,
(Subscript[h, c])((∂_(Subscript[h, a]))σ)((∂_(Subscript[h, b]))σ)+(σ /. (Subscript[h, a|b])->0),
{(Subscript[t, c]),1}.(({{γ+α δ/μ, ϵ+δ θ/μ}, {ϕ+α ψ/μ, Ξ+θ ψ/μ}})).{(Subscript[h, c]),1}
]] /. {(Subscript[T, a])->(Subscript[T, c]), (Subscript[T, b])->(Subscript[T, c])} // ΓCollect
];
dm[a_,b_,c_][Γ[ω_,σ_,λ_]]  := (Subscript[dm, a,b->c])[Γ[ω,σ,λ]];
dη[a_][γ_Γ] := γ /. {(Subscript[(h|t), a]) -> 0, (Subscript[T, a])->1};

FullStitch[γ1_Γ,γ2_Γ] := Module[{S1,S2,S, γ,τ},
S=(S1=dL[γ1])⋃(S2=dL[γ2]);
γ=γ1(Times@@(Γ/@ϵ/@Complement[S,S1]));
γ*=(γ2 /. {(Subscript[h, a_]):>(Subscript[h, τ[a]]), (Subscript[t, a_]):>(Subscript[t, τ[a]]), (Subscript[T, a_]):>(Subscript[T, τ[a]])})(Times@@(Γ/@ϵ/@τ/@Complement[S,S2]));
Do[
γ=γ//dm[s,τ[s],s],
{s,S}
];
γ
];
Γ /: γ1_Γ**γ2_Γ := Module[{S1,S2,S, γ1p,γ2p},
S=(S1=dL[γ1])⋃(S2=dL[γ2]);
γ1p=γ1(Times@@(Γ/@ϵ/@Complement[S,S1]));
γ2p=γ2(Times@@(Γ/@ϵ/@Complement[S,S2]));
Γ[
γ1p[ω]*γ2p[ω],
(γ1p[Σ]γ2p[Σ]).((Subscript[h, #])& /@ S),
((Subscript[t, #])& /@ S).(γ2p[A].γ1p[A]).((Subscript[h, #])& /@ S)
]
];

Γ /: ((Γ[ω_,σ_,λ_])^(-1)) := Module[{S=dL[Γ[ω,σ,λ]]},
Γ[
(ω^(-1)), Collect[σ, (Subscript[h, _]), (1/#)&],
((Subscript[t, #])& /@ S).Inverse[ Outer[ΓSimp[((∂_((Subscript[t, #1]),(Subscript[h, #2])))λ)]&, S, S]].((Subscript[h, #])& /@ S)
]
];

dA[a_][Γ[ω_,σ_,λ_]] := Module[
{α, θ, ϕ, Ξ, σa},
(({{α, θ}, {ϕ, Ξ}}))=(({{(∂_((Subscript[t, a]),(Subscript[h, a])))λ, (∂_(Subscript[t, a]))λ}, {(∂_(Subscript[h, a]))λ, λ}})) /. (Subscript[(h|t), a])->0;
σa=(∂_(Subscript[h, a]))σ;
ΓCollect[Γ[
α ω/σa,
((σ/.(Subscript[h, a])->0)+(Subscript[h, a])/σa),
{(Subscript[t, a]), 1}.(({{1, θ}, {-ϕ, α Ξ-ϕ θ}})).{(Subscript[h, a]),1}/α
]]
];
dS[a_][γ_Γ] := ΓCollect[dA[a][γ] /. (Subscript[T, a])->1/(Subscript[T, a])];

tσ[rules___Rule][γ_Γ] := ΓCollect[
γ /. {(Subscript[t, u_]) :> (Subscript[t, u /. {rules}]), (Subscript[T, u_]) :> (Subscript[T, u /. {rules}])}
];
hσ[rules___Rule][γ_Γ] := ΓCollect[γ /. (Subscript[h, x_]) :> (Subscript[h, x /. {rules}])];

SetAttributes[Γ, Listable];
Γ[p_Times|p_NonCommutativeMultiply]:= Γ /@ p;
Γ[ϵ[a_]] := Γ[1,(Subscript[h, a]), (Subscript[h, a])(Subscript[t, a])];
Γ[Xp[a_,b_]] :=Γ[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])}];
Γ[Xm[a_,b_]] := Γ[Xp[a,b]] /. (Subscript[T, a])->1/(Subscript[T, a]);

MVA[Γ, L_Link] := Module[{Hs,ω,σ,μ,A},
{ω,σ,μ} = List @@ Z[Γ, L];
Hs = Rest[(Subscript[h, #])& /@ (First /@ Skeleton[L])];
A=Outer[Coefficient[μ, #1*#2]&,Hs, Hs /. (Subscript[h, a_]) :> (Subscript[t, a])];
Factor[((ω Det[A-IdentityMatrix@Length@Hs])/(1-(Subscript[T, Skeleton[L][[1,1]]])))]
]

qΔ (“renormalized cabling”)

qΔ[a_,x_,y_][Γ[ω_,σ_,λ_]] := Module[
{α, θ, ϕ, Ξ, σa, Ta, M},
(({{α, θ}, {ϕ, Ξ}}))=(({{(∂_((Subscript[t, a]),(Subscript[h, a])))λ, (∂_(Subscript[t, a]))λ}, {(∂_(Subscript[h, a]))λ, λ}})) /. (Subscript[(h|t), a])->0 /. (Subscript[T, a])->Ta;
σa=(∂_(Subscript[h, a]))σ;
M=(({{((-σa+α Ta+(-α+σa) (Subscript[T, y]))/(-1+Ta)), (((-1+(Subscript[T, x])) (Subscript[T, y]) (α-σa))/(-1+Ta)), ((θ (-1+(Subscript[T, x])) (Subscript[T, y]))/(-1+Ta))}, {(((-1+(Subscript[T, y])) (α-σa))/(-1+Ta)), ((-α+σa Ta+(α-σa) (Subscript[T, y]))/(-1+Ta)), ((θ (-1+(Subscript[T, y])))/(-1+Ta))}, {ϕ, ϕ, Ξ}}));
ΓCollect[Γ[
ω /. (Subscript[T, a])->(Subscript[T, x])(Subscript[T, y]),
((σ/.(Subscript[h, a])->0)+((Subscript[h, x])+(Subscript[h, y]))σa) /. (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])
]]
];

The Exact KV Solution in Γ

Γ[V] = Γ[(((((((-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])}
];
Γ[Vi] = Γ[((((((-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])}
];

α↔Γ Convertions

A[ω_, μ_] // Γ := Module[{S},
S=dL[{ω, μ}];
Γ[ω,
Total[(Subscript[h, #])& /@ S]+μ /. {h[a_] :> (Subscript[h, a]), t[a_] :> (Subscript[c, a])},
Total[((Subscript[t, #])(Subscript[h, #]))& /@ S]+(μ /. t[a_] :> (Subscript[c, a]) /. h[a_] :> (Subscript[h, a])(Subscript[t, a]))-μ /. {h[a_] :> (Subscript[h, a]), t[a_] :> (Subscript[c, a])(Subscript[t, a])}
] /. (Subscript[c, a_]):>Log[(Subscript[T, a])]// ΓCollect
];

Γ[ω_,σ_,λ_] // A := Module[{S, μ},
S=dL[Γ[ω,σ,λ]];
μ=Total[(((∂_(Subscript[h, #]))σ)(Subscript[t, #])(Subscript[h, #]))& /@ S]-λ;
A[ω,
μ /. {(Subscript[h, a_]):>h[a], (Subscript[t, a_]) :> t[a]/(Subscript[c, a])}
] /. (Subscript[T, a_]):>(E^(Subscript[c, a]))// αCollect
];