(* ::Package:: *)

(************************************************************************)
(* This file was generated automatically by the Mathematica front end.  *)
(* It contains Initialization cells from a Notebook file, which         *)
(* typically will have the same name as this file except ending in      *)
(* ".nb" instead of ".m".                                               *)
(*                                                                      *)
(* This file is intended to be loaded into the Mathematica kernel using *)
(* the package loading commands Get or Needs.  Doing so is equivalent   *)
(* to using the Evaluate Initialization Cells menu command in the front *)
(* end.                                                                 *)
(*                                                                      *)
(* DO NOT EDIT THIS FILE.  This entire file is regenerated              *)
(* automatically each time the parent Notebook file is saved in the     *)
(* Mathematica front end.  Any changes you make to this file will be    *)
(* overwritten.                                                         *)
(************************************************************************)



(* ::Input::Initialization:: *)
SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\OneCo-1606"];
<< NOE-1t.m


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


(* ::Input::Initialization:: *)
RunMess:=(
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[]];
If[!FreeQ[e2,Subscript[f, _][_,_]]\[And](FreeQ[e2,x]\[Or]FreeQ[e2,y]\[Or]FreeQ[e2,z]),
{ff}=Cases[e2, Subscript[f, _][_,_], {0,\[Infinity]}, 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, _][_]]\[And](FreeQ[e2,y|z]\[Or]FreeQ[e2,x|z]\[Or]FreeQ[e2,z|y]),
{gg}=Cases[e2, Subscript[g, _][_], \[Infinity], 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=={}\[And]sxz=!={}\[And]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]\[And]FreeQ[syz,x]\[And]FreeQ[s1,x|y]\[And]Simplify[(sxz/.x->y)+syz ==0],
{{sol}}=Solve[sxz==
\!\(\*SubscriptBox[\(g\), \(++gn\)]\)[z], ff];
rule=((ff/.{x-> x_, y->y_,z->z_}) -> (ff/.sol)) /. Rule->RuleDelayed;
AddRule[ff,rule]; Break[]
]
),
syz=={}\[And]sxy=!={}\[And]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]\[And]FreeQ[sxz,y]\[And]FreeQ[s1,y|z]\[And]Simplify[(sxz/.z->y)+sxy ==0],
{{sol}}=Solve[sxy==
\!\(\*SubscriptBox[\(g\), \(++gn\)]\)[x], ff];
rule=((ff/.{x-> x_, y->y_,z->z_}) -> (ff/.sol)) /. Rule->RuleDelayed;
AddRule[ff,rule]; Break[]
]
),
sxy=!={}\[And]sxz=!={}\[And]syz=!={}, (
kk=Union@Cases[e2, a_.*Subscript[f, k_][x,y]:>k,\[Infinity]];
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[#, 
\!\(\*SuperscriptBox[
SubscriptBox[\(f\), \(_\)], 
TagBox[
RowBox[{"(", 
RowBox[{"0", ",", "1"}], ")"}],
Derivative],
MultilineFunction->None]\)[_,_]|Subscript[g, _][_]|Subscript[h, _][]]&] ];
s=Collect[e3, 
\!\(\*SuperscriptBox[
SubscriptBox[\(f\), \(_\)], 
TagBox[
RowBox[{"(", 
RowBox[{"0", ",", "1"}], ")"}],
Derivative],
MultilineFunction->None]\)[_,_], Factor];
s1=Select[s, FreeQ[
\!\(\*SuperscriptBox[
SubscriptBox[\(f\), \(_\)], 
TagBox[
RowBox[{"(", 
RowBox[{"0", ",", "1"}], ")"}],
Derivative],
MultilineFunction->None]\)[_,_]]];
pxz=Coefficient[s,
\!\(\*SuperscriptBox[
SubscriptBox[\(f\), \(kk\)], 
TagBox[
RowBox[{"(", 
RowBox[{"0", ",", "1"}], ")"}],
Derivative],
MultilineFunction->None]\)[x,z]];
pyz=Coefficient[s,
\!\(\*SuperscriptBox[
SubscriptBox[\(f\), \(kk\)], 
TagBox[
RowBox[{"(", 
RowBox[{"0", ",", "1"}], ")"}],
Derivative],
MultilineFunction->None]\)[y,z]];
mf=MF[pxz,x]; mf*=MF[pyz,y];
{s1,pxz,pyz}=Simplify[{s1,pxz,pyz}/mf];
If[FreeQ[pxz,y]\[And]FreeQ[pyz,x]\[And]FreeQ[s1,x|y]\[And]Simplify[(pyz/.y->x)+pxz ==0],
rule=(Subscript[f, kk][x_,z_]->
\!\(\*SubscriptBox[\(g\), \(++gn\)]\)[z]/pxz+
\!\(\*SubscriptBox[\(g\), \(++gn\)]\)[x]) /. Rule->RuleDelayed;
AddRule[Subscript[f, kk][x,z],rule]; Break[]
]
]
]
)
];
If[FreeQ[e2, Subscript[f, _][_,_]]\[And]!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]\[And]sy=!={}\[And]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[sx,y]\[And]FreeQ[sz,y]\[And]FreeQ[s1,y|z]\[And]Simplify[(sz/.z->y)+sy ==0],
{{sol}}=Solve[sy==
\!\(\*SubscriptBox[\(h\), \(++hn\)]\)[], gg];
rule=((gg/.{x-> x_, y->y_,z->z_}) -> (gg/.sol)) /. Rule->RuleDelayed;
AddRule[gg,rule]; Break[]
]
),
FreeQ[e2,z]\[And]sy=!={}\[And]sx=!={}, (
{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@sx /. Subscript[g, _][x]->1,x];
s1=Plus@@Simplify[s1/mf]; sy=Plus@@Simplify[sy/mf]; sx=Plus@@Simplify[sx/mf];
If[FreeQ[sz,y]\[And]FreeQ[sx,y]\[And]FreeQ[s1,y|x]\[And]Simplify[(sx/.x->y)+sy ==0],
{{sol}}=Solve[sy==
\!\(\*SubscriptBox[\(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];
)


(* ::Input::Initialization:: *)
Rp[i_,j_]:=\[DoubleStruckCapitalE][1, Subscript[b, i] Subscript[c, j],Subscript[u, i] Subscript[w, j],Subscript[c, i] Subscript[f, 1][Subscript[t, i],Subscript[t, j]]+Subscript[c, j] Subscript[f, 2][Subscript[t, i],Subscript[t, j]]+\!\(
\*SubsuperscriptBox[\(c\), \(i\), \(2\)]\ \(
\(\*SubscriptBox[\(f\), \(3\)]\)[
\*SubscriptBox[\(t\), \(i\)], 
\*SubscriptBox[\(t\), \(j\)]]\)\)+Subscript[c, i] Subscript[c, j] Subscript[f, 4][Subscript[t, i],Subscript[t, j]]+\!\(
\*SubsuperscriptBox[\(c\), \(j\), \(2\)]\ \(
\(\*SubscriptBox[\(f\), \(5\)]\)[
\*SubscriptBox[\(t\), \(i\)], 
\*SubscriptBox[\(t\), \(j\)]]\)\)+Subscript[u, i] Subscript[w, i] Subscript[f, 6][Subscript[t, i],Subscript[t, j]]+Subscript[u, i] Subscript[w, j] Subscript[f, 7][Subscript[t, i],Subscript[t, j]]+Subscript[u, j] Subscript[w, i] Subscript[f, 8][Subscript[t, i],Subscript[t, j]]+Subscript[u, j] Subscript[w, j] Subscript[f, 9][Subscript[t, i],Subscript[t, j]]+Subscript[c, i] Subscript[u, i] Subscript[w, i] Subscript[f, 10][Subscript[t, i],Subscript[t, j]]+Subscript[c, i] Subscript[u, i] Subscript[w, j] Subscript[f, 11][Subscript[t, i],Subscript[t, j]]+Subscript[c, i] Subscript[u, j] Subscript[w, i] Subscript[f, 12][Subscript[t, i],Subscript[t, j]]+Subscript[c, i] Subscript[u, j] Subscript[w, j] Subscript[f, 13][Subscript[t, i],Subscript[t, j]]+Subscript[c, j] Subscript[u, i] Subscript[w, i] Subscript[f, 14][Subscript[t, i],Subscript[t, j]]+Subscript[c, j] Subscript[u, i] Subscript[w, j] Subscript[f, 15][Subscript[t, i],Subscript[t, j]]+Subscript[c, j] Subscript[u, j] Subscript[w, i] Subscript[f, 16][Subscript[t, i],Subscript[t, j]]+Subscript[c, j] Subscript[u, j] Subscript[w, j] Subscript[f, 17][Subscript[t, i],Subscript[t, j]]+\!\(
\*SubsuperscriptBox[\(u\), \(i\), \(2\)]\ 
\*SubsuperscriptBox[\(w\), \(i\), \(2\)]\ \(
\(\*SubscriptBox[\(f\), \(18\)]\)[
\*SubscriptBox[\(t\), \(i\)], 
\*SubscriptBox[\(t\), \(j\)]]\)\)+\!\(
\*SubsuperscriptBox[\(u\), \(i\), \(2\)]\ 
\*SubscriptBox[\(w\), \(i\)]\ 
\*SubscriptBox[\(w\), \(j\)]\ \(
\(\*SubscriptBox[\(f\), \(19\)]\)[
\*SubscriptBox[\(t\), \(i\)], 
\*SubscriptBox[\(t\), \(j\)]]\)\)+\!\(
\*SubsuperscriptBox[\(u\), \(i\), \(2\)]\ 
\*SubsuperscriptBox[\(w\), \(j\), \(2\)]\ \(
\(\*SubscriptBox[\(f\), \(20\)]\)[
\*SubscriptBox[\(t\), \(i\)], 
\*SubscriptBox[\(t\), \(j\)]]\)\)+Subscript[u, i] Subscript[u, j] 
\!\(\*SubsuperscriptBox[\(w\), \(i\), \(2\)]\) Subscript[f, 21][Subscript[t, i],Subscript[t, j]]+Subscript[u, i] Subscript[u, j] Subscript[w, i] Subscript[w, j] Subscript[f, 22][Subscript[t, i],Subscript[t, j]]+Subscript[u, i] Subscript[u, j] 
\!\(\*SubsuperscriptBox[\(w\), \(j\), \(2\)]\) Subscript[f, 23][Subscript[t, i],Subscript[t, j]]+\!\(
\*SubsuperscriptBox[\(u\), \(j\), \(2\)]\ 
\*SubsuperscriptBox[\(w\), \(i\), \(2\)]\ \(
\(\*SubscriptBox[\(f\), \(24\)]\)[
\*SubscriptBox[\(t\), \(i\)], 
\*SubscriptBox[\(t\), \(j\)]]\)\)+\!\(
\*SubsuperscriptBox[\(u\), \(j\), \(2\)]\ 
\*SubscriptBox[\(w\), \(i\)]\ 
\*SubscriptBox[\(w\), \(j\)]\ \(
\(\*SubscriptBox[\(f\), \(25\)]\)[
\*SubscriptBox[\(t\), \(i\)], 
\*SubscriptBox[\(t\), \(j\)]]\)\)+\!\(
\*SubsuperscriptBox[\(u\), \(j\), \(2\)]\ 
\*SubsuperscriptBox[\(w\), \(j\), \(2\)]\ \(
\(\*SubscriptBox[\(f\), \(26\)]\)[
\*SubscriptBox[\(t\), \(i\)], 
\*SubscriptBox[\(t\), \(j\)]]\)\)]



