Pensieve header: Finding the most general R using low algebra - automatic error correction.

Warning: b->B, β->b !

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

Errors=Get["Errors.m"]

Simplify[Errors /. (Subscript[f, _])[_,_]->0]

EC={}; E0=Errors; gn=hn=0;

AddRule[ff_,rule_]:=(
Print["As ",e0,", adding ",rule];
done=False; EC=EC⋃{rule}
);
MF[ϕ_,v_]:=Module[{t=ϕ,t1}, If[Simplify[t]===0, 1,
While[(t1=Simplify[t/.v->0])===0, t=D[t,v]]; t1
]];

done=False; While[!done, done=True;
E0=DeleteCases[Simplify[E0//.EC], 0] // SortBy[LeafCount];
Print["Length[E0]==", Length[E0], "; Length[EC]==", Length[EC], "; {gn,hn}==", {gn,hn}];
For[k=1, k≤Length@E0, ++k,
e1=Factor[e0=E0[[k]]];
If[Head[e1]=!=Times, e2=e1,
E0[[k]]=e2=Select[e1, !FreeQ[#, (Subscript[f, _])[_,_]|(Subscript[g, _])[_]|(Subscript[h, _])[]]&] ];
If[e2==1,Print["Panic at ",e0,"! No solutions."]; Break[]];
(*Replace[e2, (Subscript[f, k_])[_,_]:>(
Print["As ",e0,", adding ",(Subscript[f, k])[_,_]->0];
done=False; EC=EC⋃{(Subscript[f, k])[_,_]->0};
Break[]
)];*)
If[!FreeQ[e2,(Subscript[f, _])[_,_]]∧(FreeQ[e2,x]∨FreeQ[e2,y]∨FreeQ[e2,z]),
{ff}=Cases[e2, (Subscript[f, _])[_,_], {0,∞}, 1];
{{sol}}=Solve[e2==0, ff];
rule=((ff/.{x-> x_, y->y_,z->z_}) -> (ff/.sol)) /. Rule->RuleDelayed;
AddRule[ff,rule]; Break[]
];
If[!FreeQ[e2,(Subscript[g, _])[_]]∧(FreeQ[e2,y|z]∨FreeQ[e2,x|z]∨FreeQ[e2,z|y]),
{gg}=Cases[e2, (Subscript[g, _])[_], ∞, 1];
{{sol}}=Solve[e2==0, gg];
rule=((gg/.{x-> x_, y->y_,z->z_}) -> (gg/.sol)) /. Rule->RuleDelayed;
AddRule[gg,rule]; Break[]
];
If[Head[e2]===Plus,
s=List@@Collect[e2, (Subscript[f, _])[_,_], Factor]; s1=Select[s, FreeQ[(Subscript[f, _])[_,_]]];
sxy=Cases[s,a_.*(Subscript[f, _])[x,y]]; sxz=Cases[s,a_.*(Subscript[f, _])[x,z]]; syz=Cases[s,a_.*(Subscript[f, _])[y,z]];
Which[
sxy=={}∧sxz=!={}∧syz=!={}, (
{ff}=Cases[sxz, a_.*(Subscript[f, k_])[x,z]:>(Subscript[f, k])[x,z],{1},1];
mf=MF[First@sxz /. (Subscript[f, _])[x,z]->1,x]; mf*=MF[First@syz /. (Subscript[f, _])[y,z]->1,y];
s1=Plus@@Simplify[s1/mf]; sxz=Plus@@Simplify[sxz/mf]; syz=Plus@@Simplify[syz/mf];
If[FreeQ[sxz,y]∧FreeQ[syz,x]∧FreeQ[s1,x|y]∧Simplify[(sxz/.x->y)+syz ==0],
{{sol}}=Solve[sxz==(Subscript[g, ++gn])[z], ff];
rule=((ff/.{x-> x_, y->y_,z->z_}) -> (ff/.sol)) /. Rule->RuleDelayed;
AddRule[ff,rule]; Break[]
]
),
syz=={}∧sxy=!={}∧sxz=!={}, (
{ff}=Cases[sxy, a_.*(Subscript[f, k_])[x,y]:>(Subscript[f, k])[x,y],{1},1];
mf=MF[First@sxy /. (Subscript[f, _])[x,y]->1,y]; mf*=MF[First@sxz /. (Subscript[f, _])[x,z]->1,z];
s1=Plus@@Simplify[s1/mf]; sxy=Plus@@Simplify[sxy/mf]; sxz=Plus@@Simplify[sxz/mf];
If[FreeQ[sxy,z]∧FreeQ[sxz,y]∧FreeQ[s1,y|z]∧Simplify[(sxz/.z->y)+sxy ==0],
{{sol}}=Solve[sxy==(Subscript[g, ++gn])[x], ff];
rule=((ff/.{x-> x_, y->y_,z->z_}) -> (ff/.sol)) /. Rule->RuleDelayed;
AddRule[ff,rule]; Break[]
]
),
sxy=!={}∧sxz=!={}∧syz=!={}, (
kk=Union@Cases[e2, a_.*(Subscript[f, k_])[x,y]:>k,∞];
If[Length[kk]==1,
{kk}=kk;
{{sol}}=Solve[e2==0, (Subscript[f, kk])[x,y]];
sol=(Subscript[f, kk])[x,y]/.sol;
e3=D[sol,z]//Factor;
If[FreeQ[e3,(Subscript[f, _])[_,_]],
If[Head[e3]===Times, e3=Select[e3, !FreeQ[#, Derivative[0,1][(Subscript[f, _])][_,_]|(Subscript[g, _])[_]|(Subscript[h, _])[]]&] ];
s=Collect[e3, Derivative[0,1][(Subscript[f, _])][_,_], Factor];
s1=Select[s, FreeQ[Derivative[0,1][(Subscript[f, _])][_,_]]];
pxz=Coefficient[s,Derivative[0,1][(Subscript[f, kk])][x,z]];
pyz=Coefficient[s,Derivative[0,1][(Subscript[f, kk])][y,z]];
mf=MF[pxz,x]; mf*=MF[pyz,y];
{s1,pxz,pyz}=Simplify[{s1,pxz,pyz}/mf];
If[FreeQ[pxz,y]∧FreeQ[pyz,x]∧FreeQ[s1,x|y]∧Simplify[(pyz/.y->x)+pxz ==0],
rule=((Subscript[f, kk])[x_,z_]->(Subscript[g, ++gn])[z]/pxz+(Subscript[g, ++gn])[x]) /. Rule->RuleDelayed;
AddRule[(Subscript[f, kk])[x,z],rule]; Break[]
]
]
]
)
];
If[FreeQ[e2, (Subscript[f, _])[_,_]]∧!FreeQ[e2,(Subscript[g, _])[_]],
s=List@@Collect[e2, (Subscript[g, _])[_], Factor]; s1=Select[s, FreeQ[(Subscript[g, _])[_]]];
sx=Cases[s,a_.*(Subscript[g, _])[x]]; sy=Cases[s,a_.*(Subscript[g, _])[y]]; sz=Cases[s,a_.*(Subscript[g, _])[z]];
Which[
FreeQ[e2,x]∧sy=!={}∧sz=!={}, (
{gg}=Cases[sy, a_.*(Subscript[g, k_])[y]:>(Subscript[g, k])[y],{1},1];
mf=MF[First@sy /. (Subscript[g, _])[y]->1,y]; mf*=MF[First@sz /. (Subscript[g, _])[z]->1,z];
s1=Plus@@Simplify[s1/mf]; sy=Plus@@Simplify[sy/mf]; sz=Plus@@Simplify[sz/mf];
If[FreeQ[sz,y]∧FreeQ[sz,y]∧FreeQ[s1,y|z]∧Simplify[(sz/.z->y)+sy ==0],
{{sol}}=Solve[sy==(Subscript[h, ++hn])[], gg];
rule=((gg/.{x-> x_, y->y_,z->z_}) -> (gg/.sol)) /. Rule->RuleDelayed;
AddRule[gg,rule]; Break[]
]
)
] (* Which *)
] (* If *)
] (* If *)
] (* For *)
]; (* While *)
E0=Union[DeleteCases[Simplify[E0//.EC], 0]] // SortBy[LeafCount];

EC

E0 // Simplify //Column

Simplify[Errors //. EC]