%mathpiper,title="xSolvePoly"

//Retract("xSolve'Poly",*);

/******************** xSolve'Poly ********************/

/* Tries to solve by calling PSolve */
/* Returns Failed if this doesn't work, and the solution otherwise */

/* CanBeUni is not documented, but defined in univar.rep/code.mpi */
/* It returns True iff 'expr' is or can be considered to be a univariate polynomial in 'var' */

10 # xSolve'Poly(_expr, _var)_(Not CanBeUni(var, expr)) <-- 
  [
      If(iDebug=True,Tell("xSolvePoly_NoUni",{expr,var}));
      Failed;
  ];

  
20 # xSolve'Poly(_expr, _var) <--
  LocalSymbols(x)
  [
      If(iDebug=True,Tell("xSolvePoly_Uni_F",{expr,var}));
      Local(factors,nfactors,roots);
      factors  := Factors(expr);
      nfactors := Length(factors);
      If(iDebug=True,Tell("  sp1",{nfactors,factors}));
      roots := {};
      ForEach(factor,factors) 
          If(Contains(VarList(factor[1]),var),
              [
                  Local(rs,r);
                  rs := PSolve(factor[1],var);
                  If(iDebug=True,Tell("    sp2",rs));
                  If( Type(rs)="List",
                      ForEach(r,rs) Push(roots,r),
                      Push(roots,rs)
                  );
              ]
          );
      If(iDebug=True,Tell("  sp3",roots));
      Local(result);
      If(Type(roots) = "List",
          [
              If(iDebug=True,Tell("   sp4_is_list",Length(roots)));
              If(Length(roots) > 1, 
                  [Tell("      >1"); result := MapSingle({{t},var==t}, roots);],
                  If( Type(roots[1]) = "List",
                      [Tell("        List"); result := MapSingle({{t},var==t}, roots[1]);],
                      [Tell("        Not List"); result := {var == roots[1]};]
                  )
              );
          ],  
          [
              If(iDebug=True,Tell("   sp4_not_list"));
              result := {var == roots};
          ]
       );  
       result;
  ];
  
  
/* 
 * The call to PSolve (below) can have three kind of results
 *   1) PSolve returns a single root
 *   2) PSolve returns a list of roots
 *   3) PSolve remains unevaluated
 */

30 # xSolve'Poly(_expr, _var) <--
  LocalSymbols(x)
  [
      If(iDebug=True,Tell("xSolvePoly_Uni_P",{expr,var}));
      Local(roots);
      roots := PSolve(expr, var);
      If(Type(roots) = "PSolve",
         Failed,                               /* Case 3 */
         If(Type(roots) = "List",
             MapSingle({{x},var==x}, roots),   /* Case 2 */
             {var == roots})                   /* Case 1 */
      );
  ];


%/mathpiper

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



