Pensieve header: Comparing frakg_1 with Roland’s picture.

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\OneCo-1606"];
<< OneCo.m;
ϵ=0;

bas=LBasis[1] /. (Subscript[x_, _]):>x

u1=(Subscript[f, 3]) U[c]+ϵ (Subscript[f, 6]) U[c]+(Subscript[f, 4]) U[u]+ϵ (Subscript[f, 7]) U[u]+(Subscript[f, 5]) U[w]+ϵ (Subscript[f, 8]) U[w]+ϵ (Subscript[f, 10]) U[c,c]+ϵ (Subscript[f, 11]) U[c,u]+ϵ (Subscript[f, 12]) U[c,w]+(Subscript[f, 9]) U[u,w]+ϵ (Subscript[f, 13]) U[u,w];
w1=(Subscript[g, 3]) U[c]+ϵ (Subscript[g, 6]) U[c]+(Subscript[g, 4]) U[u]+ϵ (Subscript[g, 7]) U[u]+(Subscript[g, 5]) U[w]+ϵ (Subscript[g, 8]) U[w]+ϵ (Subscript[g, 10]) U[c,c]+ϵ (Subscript[g, 11]) U[c,u]+ϵ (Subscript[g, 12]) U[c,w]+(Subscript[g, 9]) U[u,w]+ϵ (Subscript[g, 13]) U[u,w];
c1=(Subscript[h, 1]) U[]+ϵ (Subscript[h, 2]) U[]+(Subscript[h, 3]) U[c]+ϵ (Subscript[h, 6]) U[c]+(Subscript[h, 4]) U[u]+ϵ (Subscript[h, 7]) U[u]+(Subscript[h, 5]) U[w]+ϵ (Subscript[h, 8]) U[w]+ϵ (Subscript[h, 10]) U[c,c]+ϵ (Subscript[h, 11]) U[c,u]+ϵ (Subscript[h, 12]) U[c,w]+(Subscript[h, 9]) U[u,w]+ϵ (Subscript[h, 13]) U[u,w];
eqs1=Simp[{
B[w1,c1]-w1,
B[c1,u1]-u1,
B[w1,u1]-(ϵ u1**w1+(1-t-0ϵ t)U[]-2 ϵ t c1)
}]

eqs2=DeleteCases[Cases[eqs1, a_*_U:>{(a/.ϵ->0)==0}, ∞]//Flatten, True]

vars=Union@Cases[eqs2, (Subscript[f, _])|(Subscript[g, _])|(Subscript[h, _]), ∞]

sol=Solve[eqs2, vars]

further={(Subscript[f, 4])->((-1+t)/b), (Subscript[h, 9])->-(((-2+b+2 t+b t) )/(4 (b^2) t))}

u1 /.sol[[2]] /. further

Collect[w1/.sol[[2]]/. further,_U,Simplify]

Collect[c1/.sol[[2]]/. further, _U,Simplify]

Simp[eqs1/.sol[[2]] /. further] // Simplify

Collect[{c1,u1,w1}/.sol[[2]] /. further /. ϵ->0,_U,Simplify]

Collect[{c1,u1,w1}/.sol[[2]] /. {(Subscript[f, 4])->((-1+t)/b),(Subscript[h, 1|9])->0} /. ϵ->0,_U,Simplify]