%mathpiper,def="xFactorsResiduals"

//Retract("xFactorsResiduals",*);
//Retract("trySQF",*);
//Retract("tryRealRoots",*);
//Retract("processRealRoots",*);

10 # xFactorsResiduals( residualList_IsList ) <--
[
    If(InVerboseMode(),[NewLine(); Tell("Residuals",residualList);]);
    If(InVerboseMode(),Tell("  --",content));
    If(InVerboseMode(),Tell("  --",factrs));
    If(InVerboseMode(),Tell("  --",factrsnew));
    If(InVerboseMode(),Tell("  --",residuals));
    If(InVerboseMode(),Tell("  -- original ",degrees));
    Local(resid,sqf,sqfGood,rrGood);
    
    //  ---  see if Square-Free factoring can find some factors

    residualList := trySQF(residualList);   //  hso
    
    If(InVerboseMode(),
      [
         Tell("   after trying SQF on all residuals");
         Tell("          ",sqfGood);
         Tell("          ",factrsnew);
         Tell("          ",residualList);
         NewLine();
      ]
    );
    
    //  ---  see if there are any REAL roots to help with factoring

    tryRealRoots(residualList);
    
    If(InVerboseMode(),
      [
         Tell("   after trying for REAL roots on all residuals");
         Tell("          ",rrGood);
         Tell("          ",factrsnew);
         Tell("          ",residuals);
         Tell("          ",residualList);
         NewLine();
      ]
    );

     residOut;
];
UnFence("xFactorsResiduals",1);



10 # trySQF( residualList_IsList ) <--
[
    //--- First, try SquareFree factorization on these residuals 
    Local(resid,sqf);
    If(InVerboseMode(),[NewLine(); Tell("trySQF",residualList);]);
    ForEach(resid,residualList)
    [
        If(InVerboseMode(),Tell("   ",resid));
        
        sqf := SquareFree(resid[1]);
        If(InVerboseMode(),
          [
             Tell("          trying SQF");
             Tell("            ",resid[1]);
             Tell("            ",sqf);
          ]
        );
        If(Degree(sqf) < Degree(resid[1]),
          [
            If(InVerboseMode(),Tell("               sqf helps factor resid"));
            sqfGood := True;
            Local(f1,f2);
            f1 := sqf;
            f2 := Simplify(resid[1]/sqf);
            If( f2 = f1,
                 factrsnew := Concat({{f1,2*resid[2]}},factrsnew),
                 factrsnew := Concat({{f1,resid[2]},{f2,resid[2]}},factrsnew)
            );
            //HSO experimental
            residuals := Difference(residuals,{resid});
            If(InVerboseMode(),Tell("                       new",residuals));
            residualList := residuals;
          ],
          [
            If(InVerboseMode(),
              [
                 Tell("               sqf DOES NOT HELP factor resid");
                 sqfGood := False;
              ]
            );
          ]
        );
        If(InVerboseMode(),Tell("            after sqf ",factrsnew));
        If(InVerboseMode(),Tell("                      ",residuals));
        If(InVerboseMode(),Tell("                      ",residualList));  // hso
    ];
    residualList;   //  hso
];
UnFence("trySQF",1);



10 # tryRealRoots(residualList_IsList)_(Length(residualList)>0) <--
[
    //--- See if there are any REAL roots to factor out
    If(InVerboseMode(),[NewLine(); Tell("tryRealRoots",residualList);]);
    ForEach(resid,residualList)
    [
        Local(nrr,rr,ptry,uptry);
        nrr := RealRootsCount(resid[1]);
        If(InVerboseMode(),
          [ Tell("            this ",resid[1]); Tell("            ",nrr); ]
        );
        If( nrr > 0, rr := FindRealRoots(resid[1]), rr := {} );
        processRealRoots(rr);
        
        If( nrr = 2,
          [
             If( nrr = 0,
               [
                  //  OhOh - no real solutions -- have to try something else
                  If(InVerboseMode(),
                    [
                       NewLine();
                       Tell("               NO real solutions");
                       Tell("               try something else");
                    ]
                  );
                  //  Here go some ad-hoc solutions that can be useful....
                  Local(u,X);
                  u := MakeUni(resid[1]);
                  X := u[1];
                  If( u[2]=0 And u[3]={1,0,1,0,1},
                    [ 
                       DestructiveAppend(residOut,{X^2-X+1,1});
                       DestructiveAppend(residOut,{X^2+X+1,1});
                       If(InVerboseMode(),
                         [
                            Tell("     found ",factrsnew);
                            Tell("           ",resid);
                            Tell("           ",factrs);
                            Tell("           ",residOut);
                         ]
                       );
                    ]
                  );
               ],
               [
                  //  more than 2 real solutions -- have to do a bit more work
                  rr := FindRealRoots(resid[1]);
                  If(InVerboseMode(),Tell("    ",rr));
                  // try them pairwise
                  goodptry := {};
                  For(ii:=1,ii<nrr,ii++)
                      For(jj:=ii+1,jj<=nrr,jj++)
                      [
                          If(InVerboseMode(),Tell("   ",{ii,jj}));
                          ptry     := Expand((x-rr[ii])*(x-rr[jj]));
                          uptry    := MakeUni(ptry);
                          uptry[3] := "NearRational" /@ uptry[3];
                          If(InVerboseMode(),Tell("    rat",uptry[3]));
                          If(InVerboseMode(),Tell("  ",Maximum(Denominator /@ uptry[3])));
                          If( Maximum(Denominator /@ uptry[3]) < 100,
                            [ DestructiveAppend(goodptry,NormalForm(uptry)); ]    );
                      ];
                  If(InVerboseMode(),Tell("    ",goodptry));
                  If(Length(goodptry) > 0,
                    [
                       ForEach(pt,goodptry)
                         [ DestructiveAppend(residOut,{pt,1}); ];
                    ]
                  );
               ]
             );  //   if nrr=0
          ]
        );  //  if nrr=2
     ];  
];
UnFence("tryRealRoots",1);


10 # processRealRoots( rr_IsNumericList )_(Length(rr) = 1) <--
[
    //  Only one real root, so it will probably be of no help
    //  in factoring, unless it is integer or small rational
    If(InVerboseMode(),Tell("  Only 1 real root",rr));
    Local(root);
    root := rr[1];
    rrGood := False;
    If(IsInteger(root), 
      [
          If(InVerboseMode(),Tell("    integer ",root));
          rrGood := True;
      ],
      [
          Local(rroot);
          rroot := NearRational(root);
          If(InVerboseMode(),Tell("    rational ",rroot));
          If(Denominator(rroot) < 100, [root := rroot; rrGood:=True;] );
      ]
    );
    
];
UnFence("processRealRoots",1);


10 # processRealRoots( rr_IsNumericList )_(Length(rr) = 2) <--
[
    // a pair of real solutions -- probably form a quadratic
    ptry  := Expand((x-rr[1])*(x-rr[2]));
    If(InVerboseMode(),[Tell("    ",rr);Tell("    ",ptry);]);
    uptry    := MakeUni(ptry);
    uptry[3] := "NearRational" /@ uptry[3];
    ptry     := NormalForm(uptry);
    If(InVerboseMode(),Tell("    ",ptry));
    If( Abs(Lcm(uptry[3])) < 100,
      [
         //  looks OK -- try to use it
         Local(f1,f2,new);
         f1    := ptry;
         f2    := Simplify(resid[1]/f1);
         new   := {{f1,resid[2]},{f2,resid[2]}};
         If(InVerboseMode(),Tell("    ",new));
         resid := new;
         residOut := new;
         If(InVerboseMode(),Tell("    ",residOut)); 
      ]
    );
];
UnFence("processRealRoots",1);



10 # processRealRoots( rr_IsNumericList )_(Length(rr) >= 4) <--
[
     //  more than 2 real solutions -- have to do a bit more work
     If(InVerboseMode(),Tell("    ",rr));
     // try them pairwise
     goodptry := {};
     For(ii:=1,ii<nrr,ii++)
         For(jj:=ii+1,jj<=nrr,jj++)
         [
             If(InVerboseMode(),Tell("   ",{ii,jj}));
             ptry     := Expand((x-rr[ii])*(x-rr[jj]));
             uptry    := MakeUni(ptry);
             uptry[3] := "NearRational" /@ uptry[3];
             If(InVerboseMode(),Tell("    rat",uptry[3]));
             If(InVerboseMode(),Tell("  ",Maximum(Denominator /@ uptry[3])));
             If( Maximum(Denominator /@ uptry[3]) < 100,
               [ DestructiveAppend(goodptry,NormalForm(uptry)); ]    );
         ];
         If(InVerboseMode(),Tell("    ",goodptry));
         If(Length(goodptry) > 0,
           [
               ForEach(pt,goodptry)
               [ DestructiveAppend(residOut,{pt,1}); ];
           ]
         );
     ];


%/mathpiper

    %output,preserve="false"
      Result: True
.   %/output



