Pensieve header: Solving the equations for $\rho_d$ degree by degree.

Preliminaries

SetDirectory["C:\\drorbn\\AcademicPensieve\\Talks\\Oaxaca-2210"];
Once[<<KnotTheory`; <<Rot.m];

The Old Program

(Subscript[R, 1])[s_,i_,j_]:=s((Subscript[g, j,i])((Subscript[g, (SuperPlus[j]),j])+(Subscript[g, j,(SuperPlus[j])])-(Subscript[g, i,j]))-(Subscript[g, i,i])((Subscript[g, j,(SuperPlus[j])])-1)-1/2);
ρ[K_]:=ρ[K]=Module[{Cs,φ,n,A,s,i,j,k,Δ,G,ρ1},
{Cs,φ}=Rot[K]; n=Length[Cs];
A=IdentityMatrix[2n+1];
Cases[Cs,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=(({{-(T^s), (T^s)-1}, {0, -1}})))];
Δ=(T^((-Total[φ]-Total[Cs[[All,1]]])/2))Det[A];
G=Inverse[A];
ρ1=(∑_(k=1)^n)(Subscript[R, 1])@@Cs[[k]] - (∑_(k=1)^(2n))φ[[k]]((Subscript[g, k,k])-1/2);
Factor@{Δ,(Δ^2)ρ1/.(SuperPlus[α_]):>α+1/.(Subscript[g, α_,β_]):>G[[α,β]]}];

The g-Rules

(Subscript[δ, i_,j_]):=If[i===j,1,0];
(Subscript[gRules, s_,i_,j_]):={(Subscript[g, i,β_]):>(Subscript[δ, i,β])+(T^s)(Subscript[g, (SuperPlus[i]),β])+(1-(T^s))(Subscript[g, (SuperPlus[j]),β]),(Subscript[g, j,β_]):>(Subscript[δ, j,β])+(Subscript[g, (SuperPlus[j]),β]),
(Subscript[g, α_,i]):>(T^(-s))((Subscript[g, α,(SuperPlus[i])])-(Subscript[δ, α,(SuperPlus[i])])),(Subscript[g, α_,j]):>(Subscript[g, α,(SuperPlus[j])])-(1-(T^s))(Subscript[g, α,i])-(Subscript[δ, α,(SuperPlus[j])])}
(SuperPlus[((SuperPlus[α_]))]):=(α^("++"));(* this is for cosmetic reasons only *)

CF

CF[ℰ_]:=Module[{vs=Union[{ϵ},Cases[ℰ,(Subscript[(g|p|x), __]),∞]]},Total[
CoefficientRules[Expand@ℰ,vs]/.(ps_->c_):>Factor[c](Times@@(vs^ps))
]]

g2px and px2g

g2px[ℰ_]:=Module[{λ},Expand[ℰ/.(Subscript[g, α_,β_]):>λ (Subscript[p, α])(Subscript[x, β])]/.(λ^(k_.)):>1/k!]

{(SuperStar[p]),(SuperStar[x]),(SuperStar[π]),(SuperStar[ξ])}={π,ξ,p,x};  (SuperStar[((Subscript[u_, i_]))]):=(Subscript[((SuperStar[u])), i]);

(Subscript[Zip, {}])[ℰ_]:=ℰ;
(Subscript[Zip, {ζ_,ζs___}])[ℰ_] := (Collect[ℰ//(Subscript[Zip, {ζs}]),ζ] /. f_.(ζ^(d_.)):>(D[f,{(SuperStar[ζ]),d}]))/.(SuperStar[ζ])->0

px2g[ℰ_]:=Module[{ps,xs,Q},
ps=Union[Cases[ℰ,(Subscript[p, α_]),∞]];
xs=Union[Cases[ℰ,(Subscript[x, α_]),∞]];
Q=Sum[(SuperStar[p0]) (SuperStar[x0]) (Subscript[g, p0[[2]],x0[[2]]]),{p0,ps},{x0,xs}];
(Subscript[Zip, ps⋃xs])[ℰ (E^Q)]//Expand
]

Generic Perturbations

Module[{i,j,k},
AllMonomials[{},0]={1};
AllMonomials[{},d_Integer] /; d>0 := {};
AllMonomials[{v_,vs___},d_Integer] := Join@@Table[(v^(d-k))AllMonomials[{vs},k],{k,0,d}];
AllMonomials[vs_List, {d_}] := Join@@Table[AllMonomials[vs,k],{k,0,d}];
Basis[js_List,m_]:=Flatten@Outer[Times,AllMonomials[Table[(Subscript[p, j]),{j,js}],m],AllMonomials[Table[(Subscript[x, j]),{j,js}],m]];
Basis[js_List,{m_}]:=Flatten@Table[Basis[js,k],{k,0,m}];
GenericCombination[bas_,c_]:=bas.Table[(Subscript[c, j]),{j,Length@bas}];
GenericCombination[bas_,(Subscript[c_, k_])]:=bas.Table[(Subscript[c, k,j]),{j,Length@bas}];
]

Module[{k,x1,x2,p1,p2},
(Subscript[r, d_])[1,i_,j_]:=Expand@Together@Sum[(ϵ^k)GenericCombination[Basis[{i,j},{k+1}],(Subscript[ca, k])],{k,d}];
(Subscript[r, d_])[-1,i_,j_]:=Expand@Together@Sum[(ϵ^k)GenericCombination[Basis[{i,j},{k+1}],(Subscript[cb, k])],{k,d}];
(Subscript[γ, d_])[0,j_]:=0;
(Subscript[γ, d_])[1,j_]:=Expand@Together@Sum[(ϵ^k)GenericCombination[Basis[{j},{k+1}],(Subscript[cc, k])],{k,d}];
(Subscript[γ, d_])[-1,j_]:=Expand@Together@Sum[(ϵ^k)GenericCombination[Basis[{j},{k+1}],(Subscript[cd, k])],{k,d}];
{(SuperStar[x1]),(SuperStar[x2]),(SuperStar[p1]),(SuperStar[p2])}={p1,p2,x1,x2};
(Subscript[r, d_])[s_,φi_,φj_,i_,j_]:=Normal[Log[((O[ϵ])^(d+1))+(Subscript[Zip, {x1,x2}])[Exp[((O[ϵ])^(d+1))+
((Subscript[γ, d])[φi,i]/.(Subscript[x, i])->(Subscript[x, i])+x1)+((Subscript[γ, d])[φj,j]/.(Subscript[x, j])->(Subscript[x, j])+x2)+((Subscript[r, d])[s,i,j]/.{(Subscript[p, i])->(Subscript[p, i])-p1,(Subscript[p, j])->(Subscript[p, j])-p2})
]]]]
];

(Subscript[r, 2])[1,j,k]//CF

(Subscript[r, 2])[-1,j,k]//CF

(Subscript[γ, 2])[1,i]//CF

(Subscript[r, 2])[-1,φj,φk,j,k]//CF

Non-Universally Solving at d=1

d=1;
vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k1]+(Subscript[γ, d])[-1,k2]], (Subscript[(ca|cb|cc|cd), __])]

C (OverBar[C])

lhs=Module[{x1,p1},
{(SuperStar[x1]),(SuperStar[p1])}={p1,x1};
Normal[Log[((O[ϵ])^(d+1))+(Subscript[Zip, {x1}])[Exp[((O[ϵ])^(d+1))+((Subscript[γ, d])[1,i]/.(Subscript[x, i])->(Subscript[x, i])+x1)+((Subscript[γ, d])[-1,i]/.(Subscript[p, i])->(Subscript[p, i])-p1)]]]]
]
rhs=0

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsCCbar=(#==0)&/@Union[Last /@ CoefficientRules[Expand[lhs-rhs], covars]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k1]+(Subscript[γ, d])[-1,k2]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsCCbar,vars]
sol/.Rule->Set;
(Subscript[γ, d])[1,k]
(Subscript[γ, d])[-1,k]

R3

Short[lhs=CF[Module[{es={i,j,k,(SuperPlus[i]),(SuperPlus[j]),(SuperPlus[k])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,j,k]+(Subscript[r, d])[1,i,(SuperPlus[k])]+(Subscript[r, d])[1,(SuperPlus[i]),(SuperPlus[j])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,j,k])⋃(Subscript[gRules, 1,i,(SuperPlus[k])])⋃(Subscript[gRules, 1,(SuperPlus[i]),(SuperPlus[j])])]]

Short[rhs=CF[Module[{es={i,j,k,(SuperPlus[i]),(SuperPlus[j]),(SuperPlus[k])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,i,j]+(Subscript[r, d])[1,(SuperPlus[i]),k]+(Subscript[r, d])[1,(SuperPlus[j]),(SuperPlus[k])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])⋃(Subscript[gRules, 1,(SuperPlus[i]),k])⋃(Subscript[gRules, 1,(SuperPlus[j]),(SuperPlus[k])])]]

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

Short[eqnsR3=(#==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]]

R2b

lhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,i,j]+(Subscript[r, d])[-1,(SuperPlus[i]),(SuperPlus[j])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])⋃(Subscript[gRules, -1,(SuperPlus[i]),(SuperPlus[j])])]

rhs=1

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsR2b=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]

R2c

lhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[-1,i,(SuperPlus[j])]+(Subscript[r, d])[1,(SuperPlus[i]),j]+(Subscript[γ, d])[1,(SuperPlus[j])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, -1,i,(SuperPlus[j])])⋃(Subscript[gRules, 1,(SuperPlus[i]),j])]

rhs=CF[Module[{es={(SuperPlus[((SuperPlus[j]))])}},
Times[
Normal@Series[Exp[(Subscript[γ, d])[1,(SuperPlus[((SuperPlus[j]))])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]]

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsR2c=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]

R1l

lhs=CF[Module[{es={i,(SuperPlus[i])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,(SuperPlus[i]),i]+(Subscript[γ, d])[1,(SuperPlus[i])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.{(Subscript[g, (SuperPlus[i]),β_]):>(T^(-1))(Subscript[δ, (SuperPlus[i]),β])+(Subscript[g, (SuperPlus[(SuperPlus[i])]),β]),(Subscript[g, i,β_]):>(Subscript[δ, i,β])+(Subscript[g, (SuperPlus[i]),β])}]

rhs=1

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsR1l=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]

R1r

lhs=CF[Module[{es={i,(SuperPlus[i])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,i,(SuperPlus[i])]+(Subscript[γ, d])[-1,(SuperPlus[i])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.{
(Subscript[g, i,β_]):>(Subscript[δ, i,β])+T (Subscript[g, (SuperPlus[i]),β])+(1-T)(Subscript[g, (SuperPlus[(SuperPlus[i])]),β]),(Subscript[g, (SuperPlus[i]),β_]):>(Subscript[δ, (SuperPlus[i]),β])+(Subscript[g, (SuperPlus[(SuperPlus[i])]),β]),
(Subscript[g, α_,i]):>(T^(-1))((Subscript[g, α,(SuperPlus[i])])-(Subscript[δ, α,(SuperPlus[i])])),(Subscript[g, α_,(SuperPlus[i])]):>T (Subscript[g, α,(SuperPlus[(SuperPlus[i])])])-(1-T)(Subscript[δ, α,(SuperPlus[i])])-T (Subscript[δ, α,(SuperPlus[(SuperPlus[i])])]) }
]

rhs=1

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsR1r=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]

(SuperPlus[Sw])

lhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,i,j]+(Subscript[γ, d])[-1,i]+(Subscript[γ, d])[-1,j]+(Subscript[γ, d])[1,(SuperPlus[i])]+(Subscript[γ, d])[1,(SuperPlus[j])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])
]

rhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,i,j]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])
]

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsSwp={}

Solution

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]
sol/.Rule->Set;
(Subscript[r, d])[1,i,j]
(Subscript[r, d])[-1,i,j]
(Subscript[γ, d])[1,k]
(Subscript[γ, d])[-1,k]

lhs=CF[((Subscript[r, 1])[1,i,j]//px2g)//.(Subscript[gRules, 1,i,j])/.{ϵ->1,(Subscript[ca, 1,2])->1,(Subscript[ca, 1,10])->-1}]
rhs=CF[(Subscript[R, 1])[1,i,j]//.(Subscript[gRules, 1,i,j])]
Simplify[lhs==rhs]

Non-Universally Solving at d=2

d=2;
vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k1]+(Subscript[γ, d])[-1,k2]], (Subscript[(ca|cb|cc|cd), __])]

C (OverBar[C])

lhs=Module[{x1,p1},
{(SuperStar[x1]),(SuperStar[p1])}={p1,x1};
Normal[Log[((O[ϵ])^(d+1))+(Subscript[Zip, {x1}])[Exp[((O[ϵ])^(d+1))+((Subscript[γ, d])[1,i]/.(Subscript[x, i])->(Subscript[x, i])+x1)+((Subscript[γ, d])[-1,i]/.(Subscript[p, i])->(Subscript[p, i])-p1)]]]]
]
rhs=0

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsCCbar=(#==0)&/@Union[Last /@ CoefficientRules[Expand[lhs-rhs], covars]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k1]+(Subscript[γ, d])[-1,k2]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsCCbar,vars]
sol/.Rule->Set;
(Subscript[γ, d])[1,k]
(Subscript[γ, d])[-1,k]

R3 @ d=2

Short[lhs=CF[Module[{es={i,j,k,(SuperPlus[i]),(SuperPlus[j]),(SuperPlus[k])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,j,k]+(Subscript[r, d])[1,i,(SuperPlus[k])]+(Subscript[r, d])[1,(SuperPlus[i]),(SuperPlus[j])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,j,k])⋃(Subscript[gRules, 1,i,(SuperPlus[k])])⋃(Subscript[gRules, 1,(SuperPlus[i]),(SuperPlus[j])])],5]

Short[rhs=CF[Module[{es={i,j,k,(SuperPlus[i]),(SuperPlus[j]),(SuperPlus[k])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,i,j]+(Subscript[r, d])[1,(SuperPlus[i]),k]+(Subscript[r, d])[1,(SuperPlus[j]),(SuperPlus[k])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])⋃(Subscript[gRules, 1,(SuperPlus[i]),k])⋃(Subscript[gRules, 1,(SuperPlus[j]),(SuperPlus[k])])],5]

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

Short[eqnsR3=(#==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]]

R2b @ d=2

Short[lhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,i,j]+(Subscript[r, d])[-1,(SuperPlus[i]),(SuperPlus[j])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])⋃(Subscript[gRules, -1,(SuperPlus[i]),(SuperPlus[j])])]]

rhs=1

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

Short[eqnsR2b=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]
sol/.Rule->Set;
(Subscript[r, d])[1,i,j]
(Subscript[γ, d])[1,k]

R2c @ d=2

lhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[-1,0,1,i,(SuperPlus[j])]+(Subscript[r, d])[1,(SuperPlus[i]),j]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, -1,i,(SuperPlus[j])])⋃(Subscript[gRules, 1,(SuperPlus[i]),j])]

rhs=CF[Module[{es={(SuperPlus[((SuperPlus[j]))])}},
Times[
Normal@Series[Exp[(Subscript[γ, d])[1,(SuperPlus[((SuperPlus[j]))])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]]

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]//Column

eqnsR2c=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]
sol/.Rule->Set;
(Subscript[r, d])[1,i,j]
(Subscript[γ, d])[1,k]

R1l

lhs=CF[Module[{es={i,(SuperPlus[i])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,1,0,(SuperPlus[i]),i]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.{(Subscript[g, (SuperPlus[i]),β_]):>(T^(-1))(Subscript[δ, (SuperPlus[i]),β])+(Subscript[g, (SuperPlus[(SuperPlus[i])]),β]),(Subscript[g, i,β_]):>(Subscript[δ, i,β])+(Subscript[g, (SuperPlus[i]),β])}]

rhs=1

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsR1l=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]
sol/.Rule->Set;
(Subscript[r, d])[1,i,j]
(Subscript[γ, d])[1,k]

R1r

lhs=CF[Module[{es={i,(SuperPlus[i])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,0,-1,i,(SuperPlus[i])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.{
(Subscript[g, i,β_]):>(Subscript[δ, i,β])+T (Subscript[g, (SuperPlus[i]),β])+(1-T)(Subscript[g, (SuperPlus[(SuperPlus[i])]),β]),(Subscript[g, (SuperPlus[i]),β_]):>(Subscript[δ, (SuperPlus[i]),β])+(Subscript[g, (SuperPlus[(SuperPlus[i])]),β]),
(Subscript[g, α_,i]):>(T^(-1))((Subscript[g, α,(SuperPlus[i])])-(Subscript[δ, α,(SuperPlus[i])])),(Subscript[g, α_,(SuperPlus[i])]):>T (Subscript[g, α,(SuperPlus[(SuperPlus[i])])])-(1-T)(Subscript[δ, α,(SuperPlus[i])])-T (Subscript[δ, α,(SuperPlus[(SuperPlus[i])])]) }
]

rhs=1

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsR1r=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]
sol/.Rule->Set;
(Subscript[r, d])[1,i,j]
(Subscript[γ, d])[1,k]

(SuperPlus[Sw])

lhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,-1,-1,i,j]+(Subscript[γ, d])[1,(SuperPlus[i])]+(Subscript[γ, d])[1,(SuperPlus[j])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])
]

rhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,i,j]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])
]

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsSwp={}

Solution

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k1]+(Subscript[γ, d])[-1,k2]], (Subscript[(ca|cb|cc|cd), __])]

{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]

sol/.Rule->Set

Column[Collect[#,ϵ,CF]&/@{(Subscript[r, d])[1,i,j],(Subscript[r, d])[-1,i,j],(Subscript[γ, d])[1,k],(Subscript[γ, d])[-1,k]}]

Non-Universally Solving at d=3

d=3;
vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k1]+(Subscript[γ, d])[-1,k2]], (Subscript[(ca|cb|cc|cd), __])]

C (OverBar[C])

lhs=Module[{x1,p1},
{(SuperStar[x1]),(SuperStar[p1])}={p1,x1};
Normal[Log[((O[ϵ])^(d+1))+(Subscript[Zip, {x1}])[Exp[((O[ϵ])^(d+1))+((Subscript[γ, d])[1,i]/.(Subscript[x, i])->(Subscript[x, i])+x1)+((Subscript[γ, d])[-1,i]/.(Subscript[p, i])->(Subscript[p, i])-p1)]]]]
]
rhs=0

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsCCbar=(#==0)&/@Union[Last /@ CoefficientRules[Expand[lhs-rhs], covars]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k1]+(Subscript[γ, d])[-1,k2]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsCCbar,vars]
sol/.Rule->Set;
(Subscript[γ, d])[1,k]
(Subscript[γ, d])[-1,k]

R3 @ d=3

Short[lhs=CF[Module[{es={i,j,k,(SuperPlus[i]),(SuperPlus[j]),(SuperPlus[k])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,j,k]+(Subscript[r, d])[1,i,(SuperPlus[k])]+(Subscript[r, d])[1,(SuperPlus[i]),(SuperPlus[j])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,j,k])⋃(Subscript[gRules, 1,i,(SuperPlus[k])])⋃(Subscript[gRules, 1,(SuperPlus[i]),(SuperPlus[j])])],5]

Short[rhs=CF[Module[{es={i,j,k,(SuperPlus[i]),(SuperPlus[j]),(SuperPlus[k])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,i,j]+(Subscript[r, d])[1,(SuperPlus[i]),k]+(Subscript[r, d])[1,(SuperPlus[j]),(SuperPlus[k])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])⋃(Subscript[gRules, 1,(SuperPlus[i]),k])⋃(Subscript[gRules, 1,(SuperPlus[j]),(SuperPlus[k])])],5]

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

Short[eqnsR3=(#==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]]

R2b @ d=3

Short[lhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,i,j]+(Subscript[r, d])[-1,(SuperPlus[i]),(SuperPlus[j])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])⋃(Subscript[gRules, -1,(SuperPlus[i]),(SuperPlus[j])])]]

rhs=1

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

Short[eqnsR2b=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]
sol/.Rule->Set;
(Subscript[r, d])[1,i,j]
(Subscript[γ, d])[1,k]

R2c @ d=3

lhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[-1,0,1,i,(SuperPlus[j])]+(Subscript[r, d])[1,(SuperPlus[i]),j]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, -1,i,(SuperPlus[j])])⋃(Subscript[gRules, 1,(SuperPlus[i]),j])]

rhs=CF[Module[{es={(SuperPlus[((SuperPlus[j]))])}},
Times[
Normal@Series[Exp[(Subscript[γ, d])[1,(SuperPlus[((SuperPlus[j]))])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]]

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]//Column

eqnsR2c=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]
sol/.Rule->Set;
(Subscript[r, d])[1,i,j]
(Subscript[γ, d])[1,k]

R1l

lhs=CF[Module[{es={i,(SuperPlus[i])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,1,0,(SuperPlus[i]),i]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.{(Subscript[g, (SuperPlus[i]),β_]):>(T^(-1))(Subscript[δ, (SuperPlus[i]),β])+(Subscript[g, (SuperPlus[(SuperPlus[i])]),β]),(Subscript[g, i,β_]):>(Subscript[δ, i,β])+(Subscript[g, (SuperPlus[i]),β])}]

rhs=1

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsR1l=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]
sol/.Rule->Set;
(Subscript[r, d])[1,i,j]
(Subscript[γ, d])[1,k]

R1r

lhs=CF[Module[{es={i,(SuperPlus[i])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,0,-1,i,(SuperPlus[i])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.{
(Subscript[g, i,β_]):>(Subscript[δ, i,β])+T (Subscript[g, (SuperPlus[i]),β])+(1-T)(Subscript[g, (SuperPlus[(SuperPlus[i])]),β]),(Subscript[g, (SuperPlus[i]),β_]):>(Subscript[δ, (SuperPlus[i]),β])+(Subscript[g, (SuperPlus[(SuperPlus[i])]),β]),
(Subscript[g, α_,i]):>(T^(-1))((Subscript[g, α,(SuperPlus[i])])-(Subscript[δ, α,(SuperPlus[i])])),(Subscript[g, α_,(SuperPlus[i])]):>T (Subscript[g, α,(SuperPlus[(SuperPlus[i])])])-(1-T)(Subscript[δ, α,(SuperPlus[i])])-T (Subscript[δ, α,(SuperPlus[(SuperPlus[i])])]) }
]

rhs=1

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsR1r=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]
sol/.Rule->Set;
(Subscript[r, d])[1,i,j]
(Subscript[γ, d])[1,k]

(SuperPlus[Sw])

lhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,-1,-1,i,j]+(Subscript[γ, d])[1,(SuperPlus[i])]+(Subscript[γ, d])[1,(SuperPlus[j])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])
]

rhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,i,j]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])
]

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsSwp={}

Solution

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k1]+(Subscript[γ, d])[-1,k2]], (Subscript[(ca|cb|cc|cd), __])]

{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]

sol/.Rule->Set

(Subscript[r, d])[1,i,j]//CF
(Subscript[r, d])[-1,i,j]//CF
(Subscript[γ, d])[1,k]//CF
(Subscript[γ, d])[-1,k]//CF

{(Subscript[ca, 1,2])=1,(Subscript[ca, 1,10])=-1,(Subscript[ca, 2,1])=0,(Subscript[cb, 2,10])=3/2};

Column[Collect[#,ϵ,CF]&/@{(Subscript[r, d])[1,i,j],(Subscript[r, d])[-1,i,j],(Subscript[γ, d])[1,k],(Subscript[γ, d])[-1,k]}]

Non-Universally Solving at d=4

{(Subscript[ca, 1,2])=1,(Subscript[ca, 1,10])=-1,(Subscript[ca, 2,1])=0,(Subscript[cb, 2,10])=3/2,(Subscript[cb, 3,10])=(7-12(Subscript[ca, 3,1]))/6, (Subscript[ca, 3,1])=0};

d=4;
vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k1]+(Subscript[γ, d])[-1,k2]], (Subscript[(ca|cb|cc|cd), __])]

C (OverBar[C])

lhs=Module[{x1,p1},
{(SuperStar[x1]),(SuperStar[p1])}={p1,x1};
Normal[Log[((O[ϵ])^(d+1))+(Subscript[Zip, {x1}])[Exp[((O[ϵ])^(d+1))+((Subscript[γ, d])[1,i]/.(Subscript[x, i])->(Subscript[x, i])+x1)+((Subscript[γ, d])[-1,i]/.(Subscript[p, i])->(Subscript[p, i])-p1)]]]]
]
rhs=0

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsCCbar=(#==0)&/@Union[Last /@ CoefficientRules[Expand[lhs-rhs], covars]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k1]+(Subscript[γ, d])[-1,k2]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsCCbar,vars]
sol/.Rule->Set;
(Subscript[γ, d])[1,k]
(Subscript[γ, d])[-1,k]

R3 @ d=4

Short[lhs=CF[Module[{es={i,j,k,(SuperPlus[i]),(SuperPlus[j]),(SuperPlus[k])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,j,k]+(Subscript[r, d])[1,i,(SuperPlus[k])]+(Subscript[r, d])[1,(SuperPlus[i]),(SuperPlus[j])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,j,k])⋃(Subscript[gRules, 1,i,(SuperPlus[k])])⋃(Subscript[gRules, 1,(SuperPlus[i]),(SuperPlus[j])])],5]

Short[rhs=CF[Module[{es={i,j,k,(SuperPlus[i]),(SuperPlus[j]),(SuperPlus[k])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,i,j]+(Subscript[r, d])[1,(SuperPlus[i]),k]+(Subscript[r, d])[1,(SuperPlus[j]),(SuperPlus[k])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])⋃(Subscript[gRules, 1,(SuperPlus[i]),k])⋃(Subscript[gRules, 1,(SuperPlus[j]),(SuperPlus[k])])],5]

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

Short[eqnsR3=(#==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]]

R2b @ d=4

Short[lhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,i,j]+(Subscript[r, d])[-1,(SuperPlus[i]),(SuperPlus[j])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])⋃(Subscript[gRules, -1,(SuperPlus[i]),(SuperPlus[j])])]]

rhs=1

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

Short[eqnsR2b=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]
sol/.Rule->Set;
(Subscript[r, d])[1,i,j]
(Subscript[γ, d])[1,k]

R2c @ d=4

lhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[-1,0,1,i,(SuperPlus[j])]+(Subscript[r, d])[1,(SuperPlus[i]),j]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, -1,i,(SuperPlus[j])])⋃(Subscript[gRules, 1,(SuperPlus[i]),j])]

rhs=CF[Module[{es={(SuperPlus[((SuperPlus[j]))])}},
Times[
Normal@Series[Exp[(Subscript[γ, d])[1,(SuperPlus[((SuperPlus[j]))])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]]

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]//Column

eqnsR2c=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]
sol/.Rule->Set;
(Subscript[r, d])[1,i,j]
(Subscript[γ, d])[1,k]

R1l

lhs=CF[Module[{es={i,(SuperPlus[i])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,1,0,(SuperPlus[i]),i]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.{(Subscript[g, (SuperPlus[i]),β_]):>(T^(-1))(Subscript[δ, (SuperPlus[i]),β])+(Subscript[g, (SuperPlus[(SuperPlus[i])]),β]),(Subscript[g, i,β_]):>(Subscript[δ, i,β])+(Subscript[g, (SuperPlus[i]),β])}]

rhs=1

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsR1l=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]
sol/.Rule->Set;
(Subscript[r, d])[1,i,j]
(Subscript[γ, d])[1,k]

R1r

lhs=CF[Module[{es={i,(SuperPlus[i])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,0,-1,i,(SuperPlus[i])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.{
(Subscript[g, i,β_]):>(Subscript[δ, i,β])+T (Subscript[g, (SuperPlus[i]),β])+(1-T)(Subscript[g, (SuperPlus[(SuperPlus[i])]),β]),(Subscript[g, (SuperPlus[i]),β_]):>(Subscript[δ, (SuperPlus[i]),β])+(Subscript[g, (SuperPlus[(SuperPlus[i])]),β]),
(Subscript[g, α_,i]):>(T^(-1))((Subscript[g, α,(SuperPlus[i])])-(Subscript[δ, α,(SuperPlus[i])])),(Subscript[g, α_,(SuperPlus[i])]):>T (Subscript[g, α,(SuperPlus[(SuperPlus[i])])])-(1-T)(Subscript[δ, α,(SuperPlus[i])])-T (Subscript[δ, α,(SuperPlus[(SuperPlus[i])])]) }
]

rhs=1

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsR1r=(Factor[#]==0)&/@Union[Last /@ CoefficientRules[Expand[(T^(-me))(lhs-rhs)], covars]]

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k]], (Subscript[(ca|cb|cc|cd), __])]
{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]
sol/.Rule->Set;
(Subscript[r, d])[1,i,j]
(Subscript[γ, d])[1,k]

(SuperPlus[Sw])

lhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,-1,-1,i,j]+(Subscript[γ, d])[1,(SuperPlus[i])]+(Subscript[γ, d])[1,(SuperPlus[j])]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])
]

rhs=CF[Module[{es={i,j,(SuperPlus[i]),(SuperPlus[j])}},
Times[
Normal@Series[Exp[(Subscript[r, d])[1,i,j]], {ϵ,0,d}],
Exp[Sum[(Subscript[g, α,β])(Subscript[π, α])(Subscript[ξ, β]),{α,es},{β,es}]]
]//(Subscript[Zip, ((Subscript[p, #])&/@es)⋃((Subscript[x, #])&/@es)])//Expand
]//.(Subscript[gRules, 1,i,j])
]

me=Exponent[lhs-rhs,T,Min]

covars=DeleteCases[Variables[lhs-rhs],T|(Subscript[(ca|cb|cc|cd), __])]

eqnsSwp={}

Solution

vars=Cases[Variables[(Subscript[r, d])[1,i1,j1]+(Subscript[r, d])[-1,i2,j2]+(Subscript[γ, d])[1,k1]+(Subscript[γ, d])[-1,k2]], (Subscript[(ca|cb|cc|cd), __])]

{sol}=Solve[eqnsR3⋃eqnsR2b⋃eqnsR2c⋃eqnsR1l⋃eqnsR1r⋃eqnsSwp,vars]

sol/.Rule->Set

(Subscript[r, d])[1,i,j]//CF
(Subscript[r, d])[-1,i,j]//CF
(Subscript[γ, d])[1,k]//CF
(Subscript[γ, d])[-1,k]//CF

{(Subscript[ca, 1,2])=1,(Subscript[ca, 1,10])=-1,(Subscript[ca, 2,1])=0,(Subscript[cb, 2,10])=3/2};

Column[Collect[#,ϵ,CF]&/@{(Subscript[r, d])[1,i,j],(Subscript[r, d])[-1,i,j],(Subscript[γ, d])[1,k],(Subscript[γ, d])[-1,k]}]

TimeUsed[]