SetDirectory["C:/drorbn/AcademicPensieve/2013-02/Sheffield/"]

(({{1, 0, 0, 0, 0, X-1, 0, -X}, {-1, X, 0, 0, 0, 0, 1-X, 0}, {0, -1, X, 0, 1-X, 0, 0, 0}, {X-1, 0, -X, 1, 0, 0, 0, 0}, {0, 1-X, 0, -1, X, 0, 0, 0}, {0, 0, 0, 0, -X, 1, 0, X-1}, {0, 0, 1-X, 0, 0, -1, X, 0}, {0, 0, 0, X-1, 0, 0, -X, 1}}))[[1;;7,1;;7]] // Det

βSimp=Factor; SetAttributes[βCollect, Listable];
βCollect[B[ω_, Λ_]] := B[βSimp[ω],
Collect[Λ, (Subscript[h, _]), Collect[#,(Subscript[t, _]), βSimp]&]];
βForm[B[ω_, Λ_]] := Module[{ts, hs, M},
ts = Union[Cases[B[ω, Λ], (Subscript[t, u_]) :> u, Infinity]];
hs = Union[Cases[B[ω, Λ], (Subscript[h, x_]) :> x, Infinity]];
M = Outer[βSimp[Coefficient[Λ, (Subscript[h, #1]) (Subscript[t, #2])]]&, hs, ts];
PrependTo[M, (Subscript[t, #])& /@ ts];
M = Prepend[Transpose[M], Prepend[(Subscript[h, #])& /@ hs, ω]];
MatrixForm[M]];
βForm[else_] := else /. β_B :> βForm[β];
Format[β_B, StandardForm] := βForm[β];

⟨μ_⟩ := μ /. (Subscript[t, _])->1;
(Subscript[tm, u_,v_->w_])[β_] := βCollect[β /. (Subscript[t, u|v])->(Subscript[t, w])];
(Subscript[hm, x_,y_->z_])[B[ω_, Λ_]] := Module[
{α= D[Λ, (Subscript[h, x])], β=D[Λ, (Subscript[h, y])], γ=Λ /. (Subscript[h, x|y]) -> 0},
B[ω, (α+(1+⟨α⟩)β)(Subscript[h, z])+γ] // βCollect];
(Subscript[sw, u_,x_])[B[ω_, Λ_]] := Module[{α,β,γ,δ,ϵ},
α = Coefficient[Λ, (Subscript[h, x])(Subscript[t, u])]; β = D[Λ, (Subscript[t, u])] /. (Subscript[h, x]) -> 0;
γ = D[Λ, (Subscript[h, x])] /. (Subscript[t, u]) -> 0;      δ = Λ /. (Subscript[h, x])|(Subscript[t, u]) -> 0;
ϵ = 1+α;
B[ω*ϵ, α(1+⟨γ⟩/ϵ)(Subscript[h, x])(Subscript[t, u]) + β(1+⟨γ⟩/ϵ)(Subscript[t, u])
      +γ/ϵ (Subscript[h, x])                          + δ-γ*β/ϵ
] // βCollect];
(Subscript[gm, a_,b_->c_])[β_] := β // (Subscript[sw, a,b]) // (Subscript[hm, a,b->c]) // (Subscript[tm, a,b->c]);
B /: B[ω1_, Λ1_]B[ω2_, Λ2_] := B[ω1*ω2, Λ1+Λ2];
(Subscript[Rp, a_,b_]) := B[1, (X-1)(Subscript[t, a])(Subscript[h, b])];
(Subscript[Rm, a_,b_]) := B[1, ((X^(-1))-1)(Subscript[t, a])(Subscript[h, b])];

{β= B[ω,Sum[(Subscript[α, 10i+j])(Subscript[t, i])(Subscript[h, j]), {i,{1,2,3}}, {j,{4,5}}]],
(β//(Subscript[tm, 1,2->1])//(Subscript[sw, 1,4]))==(β//(Subscript[sw, 2,4])// (Subscript[sw, 1,4])// (Subscript[tm, 1,2->1]))}

{(Subscript[Rm, 5,1])(Subscript[Rm, 6,2])(Subscript[Rp, 3,4])//(Subscript[gm, 1,4->1])//(Subscript[gm, 2,5->2])//(Subscript[gm, 3,6->3]),
 (Subscript[Rp, 6,1])(Subscript[Rm, 2,4])(Subscript[Rm, 3,5])//(Subscript[gm, 1,4->1])//(Subscript[gm, 2,5->2])//(Subscript[gm, 3,6->3])}

β=(Subscript[Rm, 12,1])(Subscript[Rm, 2,7])(Subscript[Rm, 8,3])(Subscript[Rm, 4,11])(Subscript[Rp, 16,5])(Subscript[Rp, 6,13])(Subscript[Rp, 14,9])(Subscript[Rp, 10,15])

Do[β = β // (Subscript[gm, 1,k->1]), {k,2,10}]; β

Do[β = β // (Subscript[gm, 1,k->1]), {k,11,16}]; β