Sindbad~EG File Manager

Current Path : /usr/home/beeson/MathXpert/algebra/
Upload File :
Current File : /usr/home/beeson/MathXpert/algebra/eqn2.c

/*  Some equation-solving operators for MathXpert */
/* M. Beeson
12.27.90 Original date
3.30.99 modified
1.4.00 added missing !get_complex() two places in rejecteqn
6.18.04 modified squareeqn for complex square roots
7.6.05 modified rejecteqn at the dated line
1.15.11 modified rejecteqn to deal with e^y = x - sqrt(x^2+1), and changed strcpy to strcat in rejecteqn
8.26.11 changed english(1455) to english(1456) to correct a wrong reason string.
        Modified p2_aux at line 535 to prevent rejecting solutions wrongly when the base of logarithms is not numerical.
5.5.13  corrected line 1260 in checkroot_aux
8.24.23  eliminated OEM for \sqrt and fixed reason string in reject_eqn, eliminating OEM
12.11.23  changed oem_atom_string to atom_string
2.16.25  removed unused variable 'x' in rejecteqn
*/


#include <string.h>
#include <assert.h>
#include <math.h>
#include "globals.h"
#include "graphstr.h"
#include "mpdoc.h"
#include "ops.h"
#include "operator.h"
#include "probtype.h"
#include "dcomplex.h"
#include "order.h"
#include "cancel.h"
#include "factor.h"
#include "simpprod.h"
#include "simpsums.h"
#include "algaux.h"
#include "advfact.h"
#include "ceval.h"
#include "deval.h"
#include "complex4.h"  /* for rootofunity */
#include "eqn.h"
#include "prover.h"
#include "english.h"
#include "checkarg.h"  /* for operator typedef */
#include "nextstep.h"  /* for opseq   */
#include "symbols.h"
#include "cflags.h"   /* display_on() etc. */
#include "mtext.h"    /* MAXMENUS    */
#include "optable.h"  /* access_optable    */
#include "errbuf.h"   /* commentbuf,errbuf */
#include "pvalaux.h"  /* obviously_positive, etc. */
#include "autosimp.h" /* set_pathtail      */
#include "dispfunc.h" /* atom_string   */
#include "nfactor.h"  /* factor_integer    */

static int rejectcomplexroot(term,term);
static int rejectrealroot(term index, term right);
static int checkroot_aux(term test, int substflag, int complexflag, term right, term x);
static int set_good_values(term);
static int same_sign(term left, term right);
/*__________________________________________________________________*/
int squareeqn( term eqn, term arg, term *next, char *reason)
/* square both sides; is listed in the menus but is also
called by powereqn.  If either side satisfies is_complex (which will be satisfied
if the variable has type complex) then it just squares.  The rest of the specs
assume it's a real equation.  In that case, if it can refute that the two sides
have the same sign it will fail.
  To check if the right side of sqrt(u) = c is nonnegative, we don't just
call 'check', since now check refuses to make assumptions about the
eigenvariable.   Equations are squared without making assumptions involving
the eigenvariable; extra solutions will be rejected by checking in the 
original equation.
*/

{ term left,right;
  int err;
  term x = get_eigenvariable();
  if(FUNCTOR(eqn) != '=')
     return 1;
  left = ARG(0,eqn);
  right = ARG(1,eqn);
  if(
      ( FUNCTOR(left)==SQRT && FUNCTOR(right) == SQRT) ||
      ( FUNCTOR(left) == '^' && ONEHALF(ARG(1,left)) && FUNCTOR(right) == '^' && ONEHALF(ARG(1,right)))
    )

     { *next = equation(ARG(0,left),ARG(0,right));
       HIGHLIGHT(*next);
       strcpy(reason,"$\\sqrt a=\\sqrt b$ iff a=b");
       set_checksolutionsflag(1);
       return 0;
     }
  if(FUNCTOR(left)==SQRT || (FUNCTOR(left) == '^' && ONEHALF(ARG(1,left))))
     { err = is_complex(eqn) ? 0 : infer(le(zero,right));
       if(err)
          { err = infer(lessthan(right,zero));
            if(!err)
               { if(!get_complex())
                    errbuf(0,english(1549));
                      /* Right-hand side must be nonnegative */
                 return 1;
               }
            if(!contains(right,FUNCTOR(x)) &&  !is_complex(left) && !iscomplex(right))
               { assume(lpt(le(zero,right)));
                 commentbuf(0,english(1817));
                 /* !Assuming the right side is non-negative. */
               }
          }
       *next = equation(ARG(0,left),square(right));
       HIGHLIGHT(*next);
       strcpy(reason, english(1553));  /* square both sides */  
       set_checksolutionsflag(1);
       return 0;
     }
  if(FUNCTOR(right)==SQRT || (FUNCTOR(right) == '^' && ONEHALF(ARG(1,right))))
     { err = is_complex(eqn)? 0 : infer(le(zero,left));
       if(err)
          { err = infer(lessthan(left,zero));
            if(!err)
                { if(!get_complex())
                     errbuf(0,english(1559));
                  /* Left-hand side must be nonnegative */
                  return 1;
                }
            if(!contains(left,FUNCTOR(x))&&  !is_complex(left) && !iscomplex(right))
               { assume(lpt(le(zero,left)));
                 commentbuf(0,english(1816));
                 /* !Assuming the left side is non-negative. */
               }
          }
       *next = equation(square(left), ARG(0,right));
       HIGHLIGHT(*next);
       strcpy(reason, english(1553));  /* square both sides */
       set_checksolutionsflag(1);
       return 0;
     }
  if(!is_complex(eqn) && econstant(right))
     /* example:  abs(x-1) + abs(x+1) = -1.  Don't allow this to
        be squared. */

     { if(obviously_nonnegative(right))
          { err = infer(le(zero,left));
            if(!err)
               goto out;
            errbuf(0,english(1550));  /* The two sides must have the same sign */
            return 1;
          }
       else if(NEGATIVE(right) && obviously_nonnegative(ARG(0,right)))
          { err = infer(le(left,zero));
            if(!err)
               goto out;
            errbuf(0,english(1550));  /* The two sides must have the same sign */
            return 1;
          }
       err = infer(le(zero,left));
       if(!err)
          { err = check1(le(zero,right));
            if(!err)
               goto out;
            errbuf(0,english(1550));  /* The two sides must have the same sign */
            return 1;
          }
       else
          { err = infer(le(left,zero));
            if(!err)
               { err = check1(le(right,zero));
                 if(!err)
                    goto out;
                 errbuf(0,english(1550));
                 return 1;
               }
          }
       return 1;
     }
  /* err = check1(le(zero,product(left,right)))
     is no longer good code here, since check will refuse to make
     assumptions about the eigenvariable for fear of losing solutions.
     We have to be more careful.  Instead, if the sign of one side
     of the equation can be inferred, it's legal to assume the other
     side has that sign--you can't lose any solutions that way!
     Indeed, you really can't lose any solutions by assuming the
     two sides have the same sign, so in the end we go ahead and do
     that if the sign of neither side is obvious.
        It can also happen that product(left,right) is obviously_nonnegative
     when neither the sign of left nor that of right can be inferred,
     e.g. if both have a factor of some parameter c.
  */
  err = same_sign(left,right);
  if(err == 1)  /* refuted */
     { errbuf(0,english(1550));  /* The two sides must have the same sign */
       return 1;
     }
  if(err == 2)  /* Not refuted or verified either */
     goto out;
  out:
  *next = equation(square(left), square(right));
  HIGHLIGHT(*next);
  strcpy(reason, english(249));  /* u=v iff u^2=v^2, uv \ge 0 */
  set_checksolutionsflag(1);
  return 0;
}
/*__________________________________________________________________*/
static int isoddnumber(term t)
/* return 1 if t is an odd positive or negative integer or bignum,
or a quotient of odd positive or negative integers or bignums,
or a negation of such a quotient; 0 if not; -1 if t isn't an
integer or rational. (This recursive function actually works on
some more general compound numerical terms.) */

{ if(FUNCTOR(t) == '-')
     return isoddnumber(ARG(0,t));
  if(FUNCTOR(t) == '/')
     return (isoddnumber(ARG(0,t)) && isoddnumber(ARG(1,t)));
  if(!OBJECT(t))
     return -1;
  if(TYPE(t)==BIGNUM)
     return (BIGODD(t) ? 1 : 0);
  if(ISINTEGER(t))
     return (ODD(t) ? 1 : 0);
  else return -1;
}
/*__________________________________________________________________*/
static int poweraux(term t, term m, term *ans)
/* compute *ans = t^m, simplifying if t is an m-th root,
checking definedness conditions appropriately;
return a negative value if a definedness condition is refutable.
Return 0 if t^m is a one-one function on the reals; return 1 if not.  */
/* if t is an integer power and powertopower is KNOWN then apply it */
/* otherwise if t is a protected power, unprotect it in the returned t^m. */

{ int err;
  term temp;
  int domainflag = get_polyvaldomainflag();
  if(equals(m,two) && FUNCTOR(t) == SQRT)
     { *ans = ARG(0,t);
       if(get_complex())
           return 1;
       err = domainflag ? check1(le(zero,*ans)) : 0;
       if(err)
          return -1;
       return 1;
     }
  if(FUNCTOR(t) == ROOT && equals(m,ARG(0,t)))
     { *ans = ARG(1,t);
       if(get_complex())
          return 1;
       err = domainflag ? check1(domain(t)) : 0;
       if(err)
          return -1;
     }
  else if(ZERO(t))
     *ans = zero;
  else if(FUNCTOR(t) == '^' && status(powertopower) >= KNOWN && INTEGERP(m))
   // Do we need INTEGERP(m) or only RATIONALP(m) there?  
   // (a^b)^c = a^(bc) if a>=0 or c is an integer;
   // but for a^b to be defined do we need a >= 0?
   // is (-1)^(1/3)  defined?
   // Yes, in MathXpert, and = root(3,-1).
   // No, in  French schools, where a^b := e^(b ln a).
   // with a = -1, b = 1/2, c = 2,  we have (a^b)^c undefined but a^(bc) = 1,
   // so you cannot replace INTEGERP with RATIONALP  in the above line of code.  
     { term temp = product(ARG(1,t),m);
       term newpower;
       value(temp,&newpower);
       if(FUNCTOR(newpower) == '*')
          sortargs(newpower);
       *ans = make_power(ARG(0,t),newpower);
     }
  else if(FUNCTOR(t) == '^')
     { UNPROTECT(t);
       *ans = make_power(t,m);
      }
  else
     *ans = make_power(t,m);
  if(INTEGERP(m))
      /* Now determine whether t^m is one-one or not */
      return !isoddnumber(m);
  temp = domain(*ans);
  if(FUNCTOR(temp) == '=')
     { errbuf(0, english(1586));
       /* This equation may or may not have solutions,
          depending on the values of the parameters. */
       return 1;  /* e.g. if *ans = (-a^2)^(1/2)  */
     }
  err = check1(temp);
  if(err)
     return -1;
  return !isoddnumber(m);
}
/*__________________________________________________________________*/
int powereqn( term eqn, term arg, term *next, char *reason)
/* if u=v then u^n=v^n if n is odd and not complex; otherwise solutions are tentative;
that is, we may be introducing unwanted solutions.  x^(3/8) = 1, raise to the (8/3)
power, should be OK. FINISH THIS. */
/* take both sides to user-specified power; but if one side is a square root
or a root, get_arg does not ask the user, so we get an ILLEGAL arg just
like in auto mode. */

{ term left,right,newleft,newright,y,a,b;
  int problemtype;
  int err,e1,e2;
  int savenvariables, saveeigen, savenextdefn;
  short savenextassumption;
  int fractflag = 0;  /* set if we're squaring a sqrt of a fraction or
                         taking a power of a root of a fraction */
  int flag = 0;  /* is there a risk of introducing spurious solutions? */
  unsigned f,g;
  if(FUNCTOR(eqn) != '=')
     return 1;
  left = ARG(0,eqn);
  right = ARG(1,eqn);
  f = FUNCTOR(left);
  g = FUNCTOR(right);

  /* First reject some obviously wrong equations */
  if((!get_complex() && f == SQRT) || g == SQRT )
     { y = (f == SQRT ? right : left);
       err = rejectrealroot(two,y);
       if(err == -1)
          { *next = falseterm;
            HIGHLIGHT(*next);
            strcpy(reason, english(1585));  /* unsolvable equation */
            return 0;  /* no solution */
          }
       if(err == 1)
          flag = 1;  /* can't be certain y is a square root */
     }
  else if((!get_complex() && f == ROOT) || g == ROOT )
     { y = (f == ROOT ? right : left);
       err = rejectrealroot(ARG(0,(f==ROOT ? left : right)),y);
       if(err == -1)
          { *next = falseterm;
            strcpy(reason, english(1585));  /* unsolvable equation */
            HIGHLIGHT(*next);
            return 0;  /* no solution */
          }
       if(err == 1)
          flag = 1; /* uncertain */
     }
  else if(f == SQRT || g == SQRT )  /* && complex */
     { y = (f == SQRT ? right : left);
       err = rejectcomplexroot(two,y);
       if(err == -1)
          { *next = falseterm;
            strcpy(reason, english(1585));   /* unsolvable equation */
            HIGHLIGHT(*next);
            return 0;  /* no solution */
          }
       if(err == 1)
          flag = 1;
     }
  else if(f == ROOT || g == ROOT )
     { y = (f == ROOT ? right : left);
       err = rejectcomplexroot(ARG(0,(f==ROOT ? left : right)),y);
       if(err == -1)
          { *next = falseterm;
            HIGHLIGHT(*next);
            strcpy(reason, english(1585));  /* unsolvable equation */
            return 0;  /* no solution */
          }
       if(err == 1)
          flag = 1;
     }
  else
     flag = 1;

  /* Now proceed to apply powereqn */
  if(FUNCTOR(arg)==ILLEGAL)  /* we must determine arg */
     { if (f == SQRT && g != ROOT)
          { arg = two;
            if(FRACTION(ARG(0,left)))
               fractflag = 1;
          }
       else if(g == SQRT && f != ROOT)
          { arg = two;
            if(FRACTION(ARG(0,right)))
               fractflag = 1;
          }
       else if(f == ROOT && g != ROOT)
          { arg = ARG(0,left);
            if(FRACTION(ARG(1,left)))
               fractflag = 1;
          }
       else if(g == ROOT && f != ROOT)
          { arg = ARG(0,right);
            if(FRACTION(ARG(1,right)))
               fractflag = 1;
          }
       else if(g == ROOT && f == ROOT)
          { naive_lcm(ARG(0,left),ARG(0,right),&arg);
            if(FRACTION(ARG(1,left)) || FRACTION(ARG(1,right)))
               fractflag = 1;
          }
       else if(f == '^')  /* as in x^a = 5 */
          { if(isinteger(ARG(1,left)))
               arg = reciprocal(ARG(1,left));
            else if(RATIONALP(ARG(1,left)) && ISEVEN(ARG(0,ARG(1,left))))
               /* example, x^(2/5) = 4.   Don't raise
                  it to the 5/2 power which loses the negative
                  root; instead raise it to the power 5. */
               arg = ARG(1,ARG(1,left));
            else if(NEGATIVE(ARG(1,left)) && RATIONALP(ARG(0,ARG(1,left))) && ISEVEN(ARG(0,ARG(0,ARG(1,left)))))
               arg = tnegate(ARG(1,ARG(0,ARG(1,left))));
            else
               polyval(reciprocal(ARG(1,left)), &arg);
          }
       else if(f == '*')  /* as in sec t tan t = c,  or 2 sqrt n */
          { unsigned short ff, j;
            term v;
            unsigned short nn = ARITY(left);
            unsigned short  count=0;
            for(j=0; j<nn; j++)
               { v = ARG(j,left);
                 ff = FUNCTOR(v);
                 if(ff == SQRT)
                    { arg = two;
                      if(FRACTION(ARG(0,v)))
                         fractflag = 1;
                      break;
                    }
                 else if (ff == ROOT)
                    { arg = ARG(0,v);
                      if(FRACTION(ARG(1,v)))
                         fractflag = 1;
                      break;
                    }
                 else if(ff == '^' && ISINTEGER(ARG(1,v)) && (INTDATA(ARG(1,v)) & 1))
                     ff = FUNCTOR(ARG(0,v));
                 if(get_trigexpandflag() &&
                     (ff == COS || ff == SIN || ff==TAN || ff == CSC || ff == SEC || ff == COT)
                   )
                     { ++count;  /* count the trig functors occurring as factors to an odd power */
                        if(count >= 2)
                            { arg = two;
                              break;
                            }
                     }
               }
            if(j==nn)
               return 1;  /* don't do anything */
          }
       else
          return 1;
     }
  if(equals(arg,two))
     { err =  squareeqn(eqn,arg,next,reason);
       if(err)
          return 1;
       goto out;
     }
  savenextassumption = get_nextassumption();
  savenvariables = get_nvariables();
  saveeigen = get_eigenindex();
  savenextdefn = get_nextdefn();
  e1 = poweraux(left,arg,&newleft);
  if(e1 < 0)
     { errbuf(0,english(1835)); /* Power requested is undefined */
       set_nvariables(savenvariables);
       set_eigenvariable(saveeigen);
       set_nextassumption(savenextassumption);
       set_nextdefn(savenextdefn);
       return 1;
     }
  if(e1 >= 0)
     e2 = poweraux(right,arg,&newright);
  if(e1 < 0 || e2 < 0)
     { errbuf(0,english(1835)); /* Power requested is undefined */
       set_nvariables(savenvariables);
       set_eigenvariable(saveeigen);
       set_nextassumption(savenextassumption);
       set_nextdefn(savenextdefn);
       return 1;
     }
  *next = equation(newleft,newright);
  HIGHLIGHT(*next);
  strcpy(reason, english(247));  /* if a=b then a\sqrt =b\sqrt  */
  out:
  problemtype = get_problemtype();
  if(flag && SOLVETYPE(problemtype))

        /* The SOLVETYPE clause prevents the following comment being
           issued when this operator is called by ssolve for example
           during solution of limit problems, where the comment is
           incongruous.  */


     {  /* If the function x^arg is not one-to-one, we want to issue
           the following warning:
               Because a^n=b^n doesn't imply a=b, this equation
               may not be equivalent to the previous one.
              Check your final solutions in the original equation.
           It's enough to issue this warning for even (integer) exponents,
           since fractional exponents always determine 1-1 functions,
           because when the denom is even they're undefined for negative
           arguments, and the same is true for irrational exponents.
        */
       if(isinteger(arg))
          err = iseven(arg);
       else if(RATIONALP(arg) && cancel(ARG(0,arg),ARG(1,arg),&a,&b))
          /* rational exponent in lowest terms */
          err = 0;
       else if(NEGATIVE(arg) && FRACTION(ARG(0,arg)) &&
               cancel(ARG(0,ARG(0,arg)),ARG(1,ARG(0,arg)),&a,&b)
              )
          /* negative rational exponent in lowest terms */
          err = 0;
       else if(FRACTION(arg) && ISINTEGER(ARG(1,arg)) && isinteger(ARG(0,arg)))
          err = 0;  /* example, n/2  */
       else
          err = 0;  // are you sure?! 
          
       if(err)
          { commentbuf(0, english(156));
            commentbuf(1, english(157));
            commentbuf(2, english(158));
            set_checksolutionsflag(1);
          }
     }
  if(fractflag && equals(arg,two))
     inhibit(sqrtofquotient);  /* sqrt(a/b) = (sqrt a) / sqrtb  shouldn't be used
                                 before  (sqrt(a/b))^2 = a/b, as it
                                 introduces unnecesary assumptions */
  else if(fractflag)
     inhibit(rootofquotient);
  set_checksolutionsflag(1);
  return 0;
}
/*__________________________________________________________________*/
static int p2aux(term t, term arg, term *ans)
/* raise arg to the t-th power */
/* return 0 for success */

{ int err;
  if(ZERO(t))
     { *ans = one;   /* x^0 = 1 */
       return 0;
     }
  if(ONE(t))
     { *ans = arg;
       return 0;
     }
  if(FUNCTOR(t) == LN && equals(arg,eulere))
     { *ans = ARG(0,t);  /* e^ln x = x */
       return 0;
     }
  if(FUNCTOR(t) == LOG && ISINTEGER(arg) && INTDATA(arg) == 10)
     { *ans = ARG(0,t);  /* 10^log x = x */
       return 0;
     }
  if(FUNCTOR(t) == LOGB && equals(ARG(0,t),arg))
     { *ans = ARG(1,t);  /* b^log(b,x) = x */
       if(ISATOM(arg))
          SETVALUE(ARG(0,t),2.0);   // Make sure it is positive so that we won't reject solutions just because the default numerical value of the base is 1.
       return 0;
     }
  *ans = make_power(arg,t);
  err = check1(domain(*ans));
  if(err)
     { errbuf(0,english(161)); /* That would result in an undefined term */
       return 1;
     }
  return 0;
}
/*__________________________________________________________________*/
int powereqn3(term eqn, term arg, term *next, char *reason)
/* if ln u = v then u = e^v */
{ term left,right,newleft,newright;
  int err1,err2;
  if(FUNCTOR(eqn) != '=')
     return 1;
  left = ARG(0,eqn);
  right = ARG(1,eqn);
  if(FUNCTOR(left) != LN && FUNCTOR(right) != LN)
     return 1;
  err1 = p2aux(left,eulere,&newleft);
  if(err1)
     return 1;
  err2 = p2aux(right,eulere,&newright);
  if(err2)
     return 1;
  *next = equation(newleft,newright);
  HIGHLIGHT(*next);
  strcpy(reason, english(1454));  /* if ln u=v then u=e^v */
  return 0;
}
/*__________________________________________________________________*/
int powereqn4(term eqn, term arg, term *next, char *reason)
/* if log u = v then u = 10^v */
{ term left,right,newleft,newright;
  int err1,err2;
  if(FUNCTOR(eqn) != '=')
     return 1;
  left = ARG(0,eqn);
  right = ARG(1,eqn);
  if(FUNCTOR(left) != LOG && FUNCTOR(right) != LOG)
     return 1;
  err1 = p2aux(left,ten,&newleft);
  if(err1)
     return 1;
  err2 = p2aux(right,ten,&newright);
  if(err2)
     return 1;
  *next = equation(newleft,newright);
  HIGHLIGHT(*next);
  strcpy(reason, english(1455));  /* if log u=v then u=10^v */
  return 0;
}
/*__________________________________________________________________*/
int powereqn5(term eqn, term arg, term *next, char *reason)
/* if log_b u = v then u = b^v */
{ term left,right,newleft,newright,base;
  int err1,err2;
  if(FUNCTOR(eqn) != '=')
     return 1;
  left = ARG(0,eqn);
  right = ARG(1,eqn);
  if(FUNCTOR(left) == LOGB && FUNCTOR(right) == LOGB)
     { if(!equals(ARG(0,left),ARG(0,right)))
          { errbuf(0, english(1457));
            /* Change the base of logarithms first. */
            return 1;
          }
       base = ARG(0,left);
     }
  else if(FUNCTOR(left) == LOGB)
     base = ARG(0,left);
  else if(FUNCTOR(right) == LOGB)
     base = ARG(0,right);
  else
     return 1;
  err1 = p2aux(left,base,&newleft);
  if(err1)
     return 1;
  err2 = p2aux(right,base,&newright);
  if(err2)
     return 1;
  *next = equation(newleft,newright);
  HIGHLIGHT(*next);
  strcpy(reason, english(1456));  /* if log(b,u)=v then u=b^v */
  return 0;
}

/*__________________________________________________________________*/
int powereqn2(term eqn, term arg, term *next, char *reason)

/* raise user-specified base to both sides; but if one side is
ln or log, or logb, get_arg does not ask the user, so we get an
ILLEGAL arg just like in auto mode. */

{ term left,right,newleft,newright;
  int err1,err2;
  if(FUNCTOR(eqn) != '=')
     return 1;
  left = ARG(0,eqn);
  right = ARG(1,eqn);
  if(FUNCTOR(arg)==ILLEGAL)  /* we must determine arg */
    { if (FUNCTOR(left) == LOG)
         arg = ten;
      else if(FUNCTOR(left) == LN)
         arg = eulere;
      else if(FUNCTOR(left) == LOGB)
         arg = ARG(0,left);
      else if (FUNCTOR(right) == LOG)
         arg = ten;
      else if(FUNCTOR(right) == LN)
         arg = eulere;
      else if(FUNCTOR(right) == LOGB)
         arg = ARG(0,left);
      else
         return 1;
    }
  err1 = p2aux(left,arg,&newleft);
  if(err1)
     return 1;
  err2 = p2aux(right,arg,&newright);
  if(err2)
     return 1;
  *next = equation(newleft,newright);
  HIGHLIGHT(*next);
  strcpy(reason, english(248)); /* if a=b then c^a=c^b */
  set_checksolutionsflag(1);  /* In case some of the solutions come out negative */ 
  return 0;
}
/*__________________________________________________________________*/
int sqrteqn(term eqn, term arg, term *next, char *reason)
{ return rooteqn(eqn, two, next, reason);
}
/*__________________________________________________________________*/
int rooteqn(term eqn, term arg, term *next, char *reason)
{ term left,right,newleft,newright,temp;
  int err,err2,err3;
  int problemtype;
  long m;
  unsigned f = FUNCTOR(eqn);
  if(f != '=')
     return 1;
  left = ARG(0,eqn);
  right = ARG(1,eqn);
  if(get_mathmode() == AUTOMODE && !econstant(right))
     return 1;
  if(FUNCTOR(arg)==ILLEGAL)  /* this is so even in menu mode */
     { if(FUNCTOR(left) == '^' && !econstant(left))
          { arg = ARG(1,left);
            if(get_mathmode() == AUTOMODE && !econstant(arg))
            /* e.g.  don't take x-th root of x^x */
                return 1;
          }
       else if(FUNCTOR(right) == '^' && !econstant(right))
          arg = ARG(1,right);
     }
  if(ISINTEGER(arg))
     { m = INTDATA(arg);
       if(m==1)
          return 1;
     }
  else  /* arg isn't an integer (might still be a bignum or symbolic integer) */
     { err = infer(and(type(arg,INTEGER),lessthan(zero,arg)));
       if(err)
          { errbuf(0,english(162));
               /* Can't take root(n,a) unless n is a positive integer. */
            return 1;
          }
       m = -1;  /* just so it isn't 2 */
     }
  err  = (m==2 ? sqrt_aux(left,&newleft) : nthroot_aux(left,arg,&newleft));
  err2 = (m==2 ? sqrt_aux(right,&newright) : nthroot_aux(right,arg,&newright));
  problemtype = get_problemtype();
  if(!SOLVETYPE(problemtype))
     { /* verifying identities; don't produce an OR */
       if(err)
          newleft = m==2 ? make_sqrt(left) : make_root(arg,left);
       if(err2)
          newright = m==2 ? make_sqrt(right) : make_root(arg,right);
       *next = equation(newleft,newright);
       HIGHLIGHT(*next);
       strcpy(reason, m==2 ? english(164) : english(165));
          /*  take $\\sqrt $ of both sides : take $^n\\sqrt $ of both sides  */
       return 0;
     }
  if(ZERO(right))
      /* return a MULTIPLICITY term, but only if nthroot_aux succeeded */
     { if(err)
           { newleft = m==2 ? make_sqrt(left) : make_root(arg,left);
             *next = equation(newleft,zero);
           }
       else
           { *next = make_term(MULTIPLICITY,2);
             ARGREP(*next,0,equation(newleft,zero));
             ARGREP(*next,1,arg);
           }
     }
  else if(ZERO(left)) /* return a MULTIPLICITY term if nthroot_aux succeeded*/
     { if(err2)
          { newright = m==2? make_sqrt(right) : make_root(arg,right);
            *next = equation(zero,newright);
          }
       else
          { *next = make_term(MULTIPLICITY,2);
            ARGREP(*next,0,equation(zero,newright));
            ARGREP(*next,1,arg);
          }
     }
  else if (!err)  /*  example:  x^2 = 4,  *next = OR(x=2,x=-2)  */
     { if(err2)
          { newright = (m==2 ? make_sqrt(right) : make_root(arg,right));
            temp = domain(newright);
            if(FUNCTOR(temp) == '=')
               { errbuf(0, english(1586));
                 /* This equation may or may not have solutions,
                    depending on the values of the parameters. */
                 return 1;  /* e.g. if *ans = (-a^2)^(1/2)  */
               }
            err2 = check1(domain(newright));
            if(err2)
               { if(!get_complex()) /* provide useful feedback */
                    { errbuf(0,english(163)); /* Can't take even root of negative number. */
                      /* obsolete: complex_visible = 1; */
                    }
                 return 1;
               }
          }
       if(m==2)
          *next = or(equation(newleft,newright),equation(newleft,tnegate(newright)));
            /* this allows  or(5=\sqrt x,5=-\sqrt x); later the second
               (impossible) equation will be rejected.   */
       else if(get_complex())
          { term temp;
            err3 = rootofunity(arg,&temp);
            if(err3)
               return 1;
            *next = equation(newleft, product(temp,newright));
          }
       else   /* if !complex */
          { err3 = infer(odd(arg));
            if(!err3)
                *next = equation(newleft,newright);
            else
               { err3 = infer(even(arg));
                 temp = domain(newright);
                 if(FUNCTOR(temp) == '=')
                    { errbuf(0, english(1586));
                      /* This equation may or may not have solutions,
                      depending on the values of the parameters. */
                      return 1;  /* e.g. if *ans = (-a^2)^(1/2)  */
                    }
                 if(!err3)
                    { err3 = check1(temp);
                      if(!err3)
                         *next = or(equation(newleft,newright),equation(newleft,tnegate(newright)));
                      else
                         return 1;
                    }
                else
                   return 1;
               }
          }
     }
  else if (!err2)
     { if(err)
          { newleft = (m==2 ? make_sqrt(left) : make_root(arg,left));
            temp = domain(newleft);
            if(FUNCTOR(temp) == '=')
               { errbuf(0, english(1586));
                 /* This equation may or may not have solutions,
                    depending on the values of the parameters. */
                 return 1;  /* e.g. if *ans = (-a^2)^(1/2)  */
               }
            err = check1(temp);
            if(err)
               return 1;
          }
       if(m==2)
          *next = or(equation(newleft,newright),equation(tnegate(newleft),newright));
       else if(get_complex())
          { term temp;
            err3 = rootofunity(arg,&temp);
            if(err3)
               return 1;
            *next = equation(product(temp,newleft),newright);
          }
       else  /* if !complex */
          { err3 = infer(odd(arg));
            if(!err3)
                *next = equation(newleft,newright);
            else
               { err3 = infer(even(arg));
                 if(!err3)
                    { temp = domain(newleft);
                      if(FUNCTOR(temp) == '=')
                         { errbuf(0, english(1586));
                           /* This equation may or may not have solutions,
                           depending on the values of the parameters. */
                           return 1;  /* e.g. if *ans = (-a^2)^(1/2)  */
                         }
                      err3 = check1(temp);
                      if(!err3)
                         *next = or(equation(newleft,newright),equation(tnegate(newleft),newright));
                      else
                         { errbuf(0,english(163));
                           /* obsolete: complex_visible = 1; */
                           return 1;
                         }
                    }
                 else
                    return 1;
               }
          }
     }
  else  /* if (err && err2), so we get roots on both sides */
     { newright = (m==2 ? make_sqrt(right) : make_root(arg,right));
       temp = domain(newright);
       if(FUNCTOR(temp) == '=')
          { errbuf(0, english(1586));
            /* This equation may or may not have solutions,
            depending on the values of the parameters. */
            return 1;  /* e.g. if *ans = (-a^2)^(1/2)  */
          }
       err2 = check1(temp);
       if(err2)
          return 1;
       newleft = (m==2 ? make_sqrt(left) : make_root(arg,left));
       temp = domain(newright);
       if(FUNCTOR(temp) == '=')
          { errbuf(0, english(1586));
            /* This equation may or may not have solutions,
               depending on the values of the parameters. */
            return 1;  /* e.g. if *ans = (-a^2)^(1/2)  */
          }
       err = check1(temp);
       if(err)
          return 1;
       *next = equation(newleft,newright);
     }
  HIGHLIGHT(*next);
  if(!get_complex() || m == 2)
     strcpy(reason, m==2 ? english(164) : english(165));
          /*  take \sqrt of both sides : take \sqrt of both sides  */
  else
     { SetShowStepOperation(demoivre);
       strcpy(reason,english(166));  /* de Moivre's theorem */
     }
#if 0
  if(inq_display_on() && !(FUNCTOR(left) == '^' && equals(ARG(1,left),two) && ZERO(right)))
    ; /* obsolete: complex_visible = 1;  show user whether complex roots are allowed or not */
 #endif
return 0;
}
/*__________________________________________________________________*/
int checkroot(term eqn, term arg, term *next, char *reason)
/* if eqn has the form x = c,  substitute c for x in the original
problem and see if it checks.  If not, reject that solution.
Operator succeeds (returns 0) if solution is rejected.  Return value 2
means the equation isn't solved yet so it's useless to check it.
Return value 1 on an equation means the solution checked.
Return value 3 means it couldn't be checked because some of the solutions
depend on parameters and with a different period than the original
equation; user needs to use periodicform.
because of bad parameters (return value 3 on one of the args).

Also works on an OR of equations, checking all simultaneously */

{ term left,right,test,problem;
  int currentline;
  char tempbuf[128];
  int complexflag;
  controldata cd;
  operation *opseq;
  dcomplex cv;
  double v;
  term  x = get_eigenvariable();
  int nextdefn = get_nextdefn();
  defn d;
  int substflag;
  int badparameterflag=0;
  int checkflag,err,i,linenumber;
  int notdone = 0;
  unsigned short k,n,f=FUNCTOR(eqn);
  term temp,u;
  operation lastop;
  void  *savenode;
  if(f == MULTIPLICITY)
     eqn = ARG(0,eqn);
  if(FUNCTOR(eqn) == '=' && CHECKED(eqn))
     { if(get_mathmode() != AUTOMODE)
          { strcpy(tempbuf, english(179));
             /* !Solution checks OK in original equation for */
            strcat(tempbuf,"$");
            strcat(tempbuf, atom_string(x));
            strcat(tempbuf,"$");
            strcat(tempbuf,".");
            errbuf(0,tempbuf);
          }
       return 1;   /* it's already been checked */
     }
  if(get_problemtype() == MINMAX)
     { /* the problem is not history(0) because that is typically f(x) = x^3 -x or some such.
          The equation arose at a later stage.  In minmax it's not necessary to check roots
          anyway.  */
       return 1;
     }
  else
     problem = history(0);
  currentline = get_currentline();
  if(currentline > 0)
     { get_controldata(&cd);
       opseq = cd.opseq;
       lastop = opseq[currentline];
       if( get_mathmode() == AUTOMODE &&
          (void  *) access_optable(lastop.men)[lastop.choice-1] == (void  *) checkroot
         )
           return 1;
        /* Last line was produced by rejecting some roots.  No point checking
        the same roots again.  Moreover, if we do we leave a confusing message
        that they all checked!  */
     }
  if(FUNCTOR(eqn)==OR)
     { n = ARITY(eqn);
       *next = make_term(OR,n);
       savenode = heapmax();
       k=0;
       badparameterflag = 0;
       for(i=0;i<n;i++)
         { u = ARG(i,eqn);
           if(CHECKED(u))
              checkflag = 1;
           else
              checkflag = checkroot(u,arg, &temp,reason);
           if(checkflag)  /* solution checked, or equation wasn't solved yet */
              { if(checkflag == 1)  /* it checked */
                   SETCHECKED(u);
                else if(checkflag == 3)
                   ++badparameterflag;
                else
                   ++notdone;

               /* If one does NOT check, the ones that DO check will get
                  marked in the next line this way.   If they ALL check
                  or are as yet unsolved, though, the operator will fail
                  and these marked terms will never be used. */

                ARGREP(*next, k,u);
                ++k;
              }
           reset_heap(savenode);
         }
       errbuf(0,"");  /* if one of the solutions checked, or had bad parameters,
                        a message beginning with ! was left,
                        which will get printed if we don't
                        wipe out the !  here. */
       if(k==n)  /* all solutions checked or weren't solved yet or had bad parameters */
          { term u;
            RELEASE(*next);
            if(notdone == n)
               return 1;  /* no solutions were solved yet */
            if(!notdone && !badparameterflag)
               strcpy(tempbuf,english(171));   /* !Solutions all check OK in original equation for */
            else if(badparameterflag)
               { errbuf(0, english(1387));
                 /* MathXpert is unable to check the solution. */
                 errbuf(1, english(1388));
                /* Whether a solution checks or not may depend on the value of the parameters. */
                 errbuf(2, english(1841));
                 errbuf(3, english(1842));
                 /* You can select one (or all) solutions and choose
                    'put solutions in periodic form'. */
                 return 3;
               }
            else
               strcpy(tempbuf, english(1150));
               /* !Solutions found so far check in original equation for */
            strcat(tempbuf,"$");
            strcat(tempbuf,atom_string(x));
            strcat(tempbuf,"$");
            strcat(tempbuf,".");
            errbuf(0,tempbuf);
            u = history(currentline);
            if(equals(eqn,u))
               SETCHECKED(*historyp(currentline));
            return 1;
          }
       if(k==0)
          { RELEASE(*next);
            *next = falseterm;
            HIGHLIGHT(*next);
            strcpy(tempbuf, english(172));
            /* !None of the solutions satisfy the original equation for */
            strcat(tempbuf,"$");
            strcat(tempbuf,atom_string(x));
            strcat(tempbuf,"$");
            strcat(tempbuf,".");
            commentbuf(0,tempbuf);
            strcpy(reason, english(173));  /* Reject all solutions */
            return 0;
          }
       if(k==1)
          { temp = ARG(0,*next);
            RELEASE(*next);
            *next = temp;
            SETCHECKED(*next);
            if(FUNCTOR(problem) != '=' && INEQUALITY(FUNCTOR(problem)))
               strcpy(tempbuf, english(1711));
               /* !Only one solution satisfies the original inequality for  */
            else
               strcpy(tempbuf, english(174));  /*  !Only one solution satisfies the original equation for */
            strcat(tempbuf,"$");
            strcat(tempbuf,atom_string(x));
            strcat(tempbuf,"$");
            strcat(tempbuf,".");
            commentbuf(0,tempbuf);
            strcpy(reason, english(175)); /* Check solutions */
            return 0;
          }
       SETFUNCTOR(*next,OR,k);
       strcpy(reason,english(175));  /* Check solutions */
       if(FUNCTOR(problem) != '=' && INEQUALITY(FUNCTOR(problem)))
          commentbuf(0, english(1712));  /*  !Keep only solutions that satisfy the original inequality. */
       else
          commentbuf(0, english(176)); /*  !Keep only solutions that satisfy the original equation. */
       return 0;
     }
  if(FUNCTOR(eqn) != '=')
     return 1;
  left = ARG(0,eqn);
  right = ARG(1,eqn);
  substflag = 0;  /* set if we must use subst instead of just deval */

  complexflag = get_complex() || contains(problem,'i') || contains(right,'i');
  f = FUNCTOR(problem);
  if(!INEQUALITY(f))
     { errbuf(0, english(177));
        /* Original problem not an equation or inequality */
       return 1;
     }
  if (! ISATOM(left))
     { errbuf(0, english(178));
        /* Equation not solved yet, can't check solutions. */
       return 2;
     }
  if (!equals(left,x))
     return 1;
  if(complexflag && complexnumerical(right))
     { err = ceval(right,&cv);
       if(err)
          return 1;
       REALDATA(x) = cv.r;
       IMAGDATA(x) = cv.i;
     }
  else if(seminumerical(right))
     { err = deval(right,&v);
       if(err)
          return 1;
       SETVALUE(x,v);
     }
  else
     substflag = 1;

  /* Now, if there has been a let-substitution, we don't want to go
  all the way back to history[0].  Was x introduced by a substitution? */

  for(i=nextdefn-1;i>=0;--i)
     { d = get_defn(i);
       if(d.reverse && common_variables(d.right,x))
           /* x may have been introduced by a reverse let_definition, e.g.
            by viete in solving cubic, say z = x - 2/3.  Then d.right = x-2/3
            and the original variable z is d.left. */
          { linenumber = d.line;
            break;
          }
       if(!d.reverse && equals(d.left,x))
          { linenumber = d.line;
            break;
          }
     }
  if(i < 0)
     linenumber = 0;
  copy(history(linenumber),&test);
  /* but 'test' may still not be the desired equation, it might be
     an OR of several equations, one of which is the desired one.
     Actually, we shouldn't reject a root if it satisfies ANY
     of the equations in 'test' that do contain the variable.  */

  if(FUNCTOR(test)== OR)
     { n = ARITY(test);
       for(i=0;i<n;i++)
          { if(!contains(ARG(i,test),FUNCTOR(x)))
               continue;
            err = checkroot_aux(ARG(i,test), substflag, complexflag,right, x);
            if(!err)
               break;  /* it checks */
            if(err == 2)
               ++badparameterflag;
          }
       if(i == n && !badparameterflag)  /* it didn't check in any of the equations */
          goto out;
     }
  else
     { err = checkroot_aux(test,substflag,complexflag,right,x);
       if(err == 2)
          ++badparameterflag;
       if(err && !badparameterflag)
          goto out;
     }
  if(badparameterflag)
     { errbuf(0, english(1387));
       /* MathXpert is unable to check the solution. */
       errbuf(1, english(1388));
       /* Whether a solution checks or not may depend on the value of the parameters. */
       errbuf(2, english(1841));
       errbuf(3, english(1842));
          /* You can select one (or all) solutions and choose
             \\it Put solutions in periodic form. */
       return 3;
     }
  else
     { strcpy(tempbuf, english(179));
            /* !Solution checks OK in original equation for */
            /* exclamation point gets this comment printed even when
               the operator is applied in auto mode */
       strcat(tempbuf,"$");
       strcat(tempbuf, atom_string(x));
       strcat(tempbuf,"$");
       strcat(tempbuf,".");
       errbuf(0,tempbuf);
     }
  u = history(currentline);
  if(equals(eqn,u))
     SETCHECKED(*historyp(currentline));
  return 1;  /* operator fails on purpose, solution checked  */
                  /* but don't return 2, because we DO want an error message. */
  out:       /* operator succeeds, solution rejected */
  *next = falseterm;
  strcpy(reason, english(180));  /* Check solution */
  strcpy(tempbuf,english(181));
     /* !Solution doesn't satisfy original equation for */
  strcat(tempbuf,"$");
  strcat(tempbuf,atom_string(x));
  strcat(tempbuf,"$");
  strcat(tempbuf,".");
  strcat(tempbuf,"$");
  commentbuf(0,tempbuf);
  return 0;
}

/*____________________________________________________________________*/

static int checkroot_aux(term test, int substflag, int complexflag, term right, term x)
/* test is an equation (or inequality), containing x;
check if x=right satisfies the equation (or inequality) test.  Return values
are as follows:

  0 means it passed the test.
  1 means it failed the test.
  2 means the test is inconclusive because there are integer parameters
    and the possibility could not be ruled out that some values are OK
    and some are not.

If substflag is nonzero, this is done by substituting right for x in test; otherwise
it's done using 'deval' or 'ceval', assuming that the value of x is the
previously computed value of the seminumerical or complexnumerical term
'right'. Complexflag tells (by being nonzero) to use ceval instead of deval.
If substflag is nonzero, then there are parameters in the equation, and
their values may be such that 'right' has no value.  In that case,
deval or ceval can't be used.  Substituting 'right' for x in test
yields an alleged identity (or inequality) in the parameters (not containing x),
and checking the root comes down to verifying this identity, which might
be true for some values of the parameters and undefined for others,
but if it's defined and false for some values of the parameters, we can
reject the root. (Maybe this isn't true if the equation is discontinuous,
but we'll worry about that later! There are no discontinuous equations supplied
with MathXpert.) However, accepting the root can only be done if the
identity (or inequality) can be verified, or at least not refuted and then
assumed.
*/
{ long kk;
  int savefactorflag2;
  int err, savedomainflag,savefunctionflag,savelogflag;
  double ans,error;
  double z;
  dcomplex ans3,w;
  term temp,u,v,s,dom;
  term *atomlist;
  int nvars;
  unsigned short f = FUNCTOR(test);
  short savenextassumption = get_nextassumption();
  if(!INEQUALITY(f))
     assert(0);
  if(ZERO(ARG(1,test)))
     u = tnegate(ARG(0,test));
  else if(ZERO(ARG(0,test)))
     u = ARG(1,test);
  else
     u = sum(ARG(1,test),tnegate(ARG(0,test)));
  if(f == '>' || f == GE)
     u = tnegate(u);
  /* Now u should be zero, positive, or nonnegative according
     as test is an equality, strict, or nonstrict inequality */
  if(!substflag)
     { if(!complexflag)
          { err = deval(u,&ans);
            if(err)
               return 1;   /* it doesn't check, one side of test isn't defined */
            error = fabs(ans);
          }
       else  /* check complex roots */
          { err = ceval(u,&ans3);
            if(err)
               return 1;  /* doesn't check */
            error = Cabs(ans3);
          }
       if(f == '=' && nearint(error,&kk) && kk==0)
          return 0;  /* solution checks */
       if(f == '=')
          return 1;   /* doesn't check, both sides defined and unequal */
       /* Now f is an inequality */
       if(f == '<' || f == '>')
          return ans > 0 ? 0 : 1;
       if(f == LE || f== GE)
          return ans >= 0 ? 0 : 1;
       if(f == NE)
          return ans != 0 ? 1 : 1;
     }
  /* Now substflag is nonzero: there are parameters */
  /* sin(x) = 1/\sqrt 2 for example comes here with x = \pi /4 + 2n\pi , x = 3\pi /4  2n\pi  */
  /* Note that on this example deval will fail on right but succeed on temp */
  /* Also of course if there are parameters in the original equation,
     you get here */
  subst(right,x,u,&temp);
  savedomainflag = get_polyvaldomainflag();
  savefunctionflag = get_polyvalfunctionflag();
  savefactorflag2 = get_polyvalfactorflag2();
  savelogflag = get_polyvallogflag();
  set_polyvalfactorflag2(0);
  set_polyvaldomainflag(1);
  set_polyvalfunctionflag(1);
  set_polyvallogflag(1);
  polyval(temp,&v);
  set_polyvaldomainflag(savedomainflag);
  set_polyvalfunctionflag(savefunctionflag);
  set_polyvalfactorflag2(savefactorflag2);
  set_polyvallogflag(savelogflag);
  if(f == '=' && ZERO(v))
     { set_nextassumption(savenextassumption);
       return 0;  /* root checks */
     }
   /* v == 0 is thus an identity possibly containing other variables,
      but NOT containing x, which is true iff this root checks (for
      equations; otherwise it's 0 < v or 0 <= v that should be true.)
      It may, of course, be undefined, for example the solutions may
      contain a sqrt with a parameter somewhere under the sqrt, and
      the original equation may require 0 <= x <= 2 to be defined,
      and then when we substitute back in for x,  the original
      equation may be defined for some values of the parameter and
      not for others.
         This latter possibility is particularly worrisome in the case
      of trig equations, where the original period is for example 4 pi
      and the solutions come out including e.g. pi/3 + 2npi; it can
      happen that for even n, it's a solution and for odd n, it's not.
      Example:  sin(u/2) = 1 - cos u, if you square the equation and
      then auto-solve, you get such a case.
  */
  nvars = integer_parameters(v,&atomlist);
  free2(atomlist);
  if(nvars)
     { set_nextassumption(savenextassumption);
       return 2;
     }
  /*  Now, there were no integer parameters, so we have a parametrized
  family x(alpha) of solutions.  Can  test(x(alpha)) be zero for some
  values of the parameters alpha and nonzero for other values?  Sure,
  for example  abs(x)-x, which can be expressed algebraically as sqrt(x^2)-x.
  */
  if(mvpoly2(right) ||
     (ARITY(right) == 1 && mvpoly2(ARG(0,right))) ||
     (FUNCTOR(right) == LOGB && mvpoly2(ARG(1,right))) ||
     (FUNCTOR(right) == ROOT && mvpoly2(ARG(1,right)))
    )
     { /* Then you can use deval as test(x(alpha)) is real analytic or a
          root, log, etc. of a real-analytic. */
       if(complexflag)
          { err = ceval(right,&w);
            if(!err)
               { REALDATA(x) = w.r;
                 IMAGDATA(x) = w.i;
               }
          }
       else
          { err = deval(right,&z);
            if(!err)
               SETVALUE(x,z);
          }
       if(!err)
          /* parameter(s) have values that permit right to be evaluated */
          { deval(v,&z);
            if(z != BADVAL && fabs(z) > VERYSMALL)
               { set_nextassumption(savenextassumption);
                 return 1;  /* you can reject this root */
               }
          }
       else
          { /* the parameter values are outside the domain of 'right'
               so you can't use deval/ceval with those parameter values */
            if(!complexflag)
               { err = set_good_values(right);  /* try to find better parameter values */
                 if(!err)
                    { deval(v,&z);
                      if(z != BADVAL && fabs(z) > VERYSMALL)
                         { set_nextassumption(savenextassumption);
                           return 1;
                         }
                    }
               }
          }
     }
  dom = domain(v);
  err = check1(dom);
  if(err)
     { set_nextassumption(savenextassumption);
       return 1;
     }
  switch(f)
     { case '=':
          err = zeroes(v,&s);
          if(err)
             s = equation(v,zero);
          err = check1(s);
          break;
       case '<':
          err =  check1(lessthan(zero,v));
          break;
       case LE:
          err = check1(le(zero,v));
          break;
       default:
          err = 1;  /* assert(0) */
     }
  if(err)
     { set_nextassumption(savenextassumption);
       return 1;
     }
  return 0;
}
/*__________________________________________________________________*/
int rejecteqn(term eqn, term arg, term *next, char *reason)
/* reject equations like sqrt x = -1 (if !complex) or \sqrt x = -i or e^x = -1
(if !complex) which have no solutions. */
/* This operator only gets some simple cases; mainly it's supposed to
reject SOME impossible equations whose left side begins with ROOT or SQRT,
so that afterwards we can apply powereqn safely.  In automode it is
called before powereqn;  in menumode, powereqn calls it first.   */
/* Now that input_check is better than it originally was, many of these
equations can't even be entered, for example x = sqrt(-1). */

{ term left,right,y,index;
  unsigned f,g;
  int err;
  int saveit;
  term dummy;
  if(FUNCTOR(eqn) == MULTIPLICITY)
     eqn = ARG(0,eqn); /* avoid getting 'No solution, multiplicity 2' */
  if(FUNCTOR(eqn) != '=')
     return 1;
  left = ARG(0,eqn);
  right = ARG(1,eqn);
  saveit = get_lpt_defnflag();
  set_lpt_defnflag(0);  /* don't unwind definitions in lpt */
  *next = falseterm;  /* if there's an answer, this is it */
  HIGHLIGHT(*next);
  strcpy(reason, english(1585));  /*  reject unsolvable eqn */
  /* This matches the menu text, and will be supplemented with a
     more informative second line.  There is a space at the end
     of english(1585). */
  strcat(reason,"     ");   // force it to appear on two lines by leaving five spaces
  if(seminumerical(eqn))   //  changed 7.6.05 from if(!depends(eqn,x))  /* example:  2 = 0  */
    { UNSET_ALREADY(eqn);  /* otherwise lpt won't touch it, and the ALREADY
                              bit can be set on a false numerical equation
                              since polyval doesn't reduce them to false.  */
      err = refute(eqn);
      if(!err)
         goto success;
    }
  f = FUNCTOR(left);
  g = FUNCTOR(right);
  if( !get_complex() &&
     (
      (f == ABSFUNCTOR && obviously_positive(tnegate(right))) || /* right is negative */
      (g == ABSFUNCTOR && obviously_positive(tnegate(left)))     /* left is negative */
     )
    )
     { strcat(reason,"$|x| > 0$ if $x > 0$");
       goto success;
     }
  /* following two lines deal with (x-5)(x-5) = 0 when the assumption list
     contains x != 5.  Then spliteqn will succeed producing false, and will call
     SetShowStepOperation(rejecteqn), so rejecteqn better succeed.
  */
  if((ZERO(right) && f == '*') || (ZERO(left) && g == '*'))
      { err = spliteqn(eqn,arg,&dummy,reason);
        if(!err && equals(dummy,falseterm))
           goto success;
        else if(!err)
           { ResetShowStep();
             clear_comment_buffer();
           }
      }
  if(ZERO(right) && f == CSC)
     { strcat(reason,english(1041)); /* csc u is never zero */
       goto success;
     }
  if(ZERO(right) && f == SEC)
     { strcat(reason,english(1042)); /* sec u is never zero */
       goto success;
     }
  if(f == '/' && ZERO(right))
     { /* reject 1/u = 0 */
       if(ZERO(ARG(0,left)))
          return 1;   /* 0/u = 0 should not be rejected */
       if(OBJECT(ARG(0,left)))
          { strcpy(reason,english(182));  /*  1/u can't be zero */
            goto success;
          }
       else if(!get_complex() && obviously_positive(ARG(0,left)))
          { strcpy(reason,english(1590));  /* Numerator can't be zero */
            goto success;
          }
       else if(get_mathmode() != AUTOMODE && !refute(equation(ARG(0,left),zero)))
          { strcpy(reason,english(1590));  /* Numerator can't be zero */
            goto success;
          }
     }
  if(f == '^' && ZERO(right))
     { if(equals(ARG(0,left),eulere))
          { strcpy(reason,english(208));  /* e^x is never zero */
            goto success;
           }
       if(obviously_positive(ARG(0,left)))
          { strcpy(reason, english(207));  /* a^x not zero if a>0 */
            goto success;   /* e.g. e^x != 0 */
          }
     }
  if(g == '^' && ZERO(left))
     { if(equals(ARG(0,right),eulere))
          { strcpy(reason,english(208));  /* e^x is never zero */
            goto success;
          }
       if(obviously_positive(ARG(0,right)))
          { strcat(reason,english(207));  /* a^x not zero if a>0 */
            goto success;   /* e.g. e^x != 0 */
          }
     }
  if(f == '^' && !get_complex())
     { if( !infer(le(right,zero)))       /* right <= 0 */
          { if(equals(ARG(0,left),eulere))
               { strcat(reason,english(209));  /* e^x > 0 */
                 goto success;
               }
            if(INTEGERP(ARG(1,left)) && ISEVEN(ARG(1,left)) &&
               obviously_positive(tnegate(right))  /* right < 0 */
              )
               { strcat(reason, "$x^(2n) > 0$ if $x > 0$");
                 goto success;
               }
            if(RATIONALP(ARG(1,left)) && ISEVEN(ARG(1,ARG(1,left))) &&
                obviously_positive(tnegate(right))  /* right < 0 */
              )
               { strcat(reason, "$x^(2n) > 0 if $x > 0$");
                 goto success;
               }
            if(obviously_positive(ARG(0,left)))
               { strcpy(reason, english(210));  /* a^x > 0 if a>0 */
                 goto success;   /* e.g. e^x != 0 */
               }
          }
     }
  if(g == '^' && !get_complex())
     { if(!infer(le(left,zero))) /* left <= 0 */
          { if(equals(ARG(0,right),eulere))
               { strcat(reason,english(209));  /* e^x > 0 */
                 goto success;
               }
            if(INTEGERP(ARG(1,right)) && ISEVEN(ARG(1,right)) &&
               obviously_positive(tnegate(left))
              )
               { strcat(reason, equals(ARG(1,right),two) ? "$x^2 \\ge 0$" : "$x^(2n) \\ge 0$");
                 goto success;
               }
            if(RATIONALP(ARG(1,right)) && ISEVEN(ARG(1,ARG(1,right))) &&
                 obviously_positive(tnegate(left))  /* left < 0 */
               )
               { strcat(reason, "$x^(2n) \\ge 0$");
                 goto success;
               }

            if(obviously_positive(ARG(0,right)))
               { strcat(reason,english(210));  /* a^x>0 if a>0 */
                 goto success;   /* e.g. e^x != 0 */
               }
          }
     }
  if(!get_complex() && (f == '^' || g == '^' ))
     { y = f == '^'  ? right : left;
       index = f == '^' ? ARG(1,left) : ARG(1,right);
       if(isoddnumber(index))
          goto fail; /* do not reject */
       if(iseven(index))
          goto fail;  /* uncertain */
       /* Now index is even */
       if(obviously_positive(tnegate(y)))  /* y < 0 */
          goto success;  /* reject */
       else
          goto fail;  /* do not reject */
     }
  if((!get_complex() && f == SQRT) || g == SQRT )
     { y = (f == SQRT ? right : left);
       if(obviously_positive(tnegate(y)))
          { strcat(reason,"$\\sqrt x \\ge 0$");
            goto success;  /* reject */
          }
       goto fail;  /* uncertain or ok */
     }
  if((!get_complex() && f == ROOT) || g == ROOT )
     { y = (f == ROOT ? right : left);
       if(iseven(ARG(0,f== ROOT ? left: right)))
          { if(obviously_positive(tnegate(y)))  /* y < 0 */
               { strcat(reason,"$sqrt(x) \\ge 0$");
                 goto success; /* reject */
               }
          }
       goto fail;  /* uncertain or ok */
     }
  if(f == SQRT || g == SQRT )  /* && complex */
     { y = (f == SQRT ? right : left);
       err = rejectcomplexroot(two,y);
       if(err == -1)
          { commentbuf(0, english(183));
              /* Value not in range of complex \sqrt  function */
            goto success;  /* reject */
          }
       goto fail;  /* uncertain or ok */
     }
  if(f == ROOT || g == ROOT )
     { y = (f == ROOT ? right : left);
       err = rejectcomplexroot(ARG(0,(f==ROOT ? left : right)),y);
       if(err == -1)
          { commentbuf(0, english(184));
             /* Value not in range of complex root function */
            goto success;  /* reject */
          }
       goto fail;  /* uncertain or ok */
     }
  if(immediate(eqn) == -1)  /* it contradicts an assumption */
     { commentbuf(0,english(467));
         /* !Equation contradicts assumptions */
       goto success;  /* reject */
     }
  fail:
    set_lpt_defnflag(saveit);
    return 1;
  success:
    set_lpt_defnflag(saveit);
    return 0;
}
/*__________________________________________________________________*/
static int rejectrealroot(term index, term right)
/* return 0 if right is an index-th real root */
/* return -1 if right is definitely not an indexth-root */
/* return 1 if uncertain, e.g. if right is so complicated that
the prover would take too long, e.g. right = sec x tan x; */

{ int err;
  term p;
  if(isoddnumber(index))
     return 0;
  if(!iseven(index))
     return 1;  /* too complicated */
  if(!mvpoly(right))
     return 1;  /* would take too long */
  p = lpt(le(zero,right));
  err = check_literally(p);
  if(!err)
     return 0;
  if(err==1)
     { commentbuf(0,
                   equals(index,two) ? english(186) : english(187)
                 );
       /* Square (or even) roots must be nonnegative */
       return -1;
     }
  return 1;
}
/*__________________________________________________________________*/
static int rejectcomplexroot(term index, term right)
/* return 0 if right is an index-th complex root, i.e. has argument
between 0 and 2pi/index  */
/* return -1 if right is definitely not an indexth-root */
/* return 1 if uncertain; this happens in many cases when a more thorough
   analysis would reject or accept. */
/* index must be a (term representing a) positive integer */
{ int err, err2;
  dcomplex v;
  err = ceval(right,&v);
  if(!err && v.i == 0.0 && v.r >= 0.0)
     return 0;   /* right was a nonnegative real */
  err2 = immediate(le(zero,right));
  if(err2 != 1)
     return 0;  /* right was a nonnegative real by assumption */
  if( (!err && v.i == 0.0 )  /* and v.r is negative */
      || immediate(lessthan(right,zero))==1
    )
     { commentbuf(0, english(187)); /* Roots can't be negative. */
       return -1;
     }
  if(!err && v.i < 0)
     { commentbuf(0,english(188));  /* Roots must have non-negative imaginary part. */
       return -1;
     }
  if(equals(index,two))
     { if( (!err && v.i > 0.0) || immediate(lessthan(zero,im(right)))==1)
          return 0;
     }
  if(equals(index,four))
     {  if ( (!err && v.i > 0.0 && v.r > 0.0)
             || (immediate(lessthan(zero,re(right)))==1 &&
                 immediate(lessthan(zero,re(left)))==1
                )
           )
            return 0;
     }
  return 1;
}
/*__________________________________________________________________*/
static int  take_log(term t, term *ans)
/* set *ans = log(t); but in case t = 10^u  set *ans = u;
   If t can't be checked positive, return 1; if it can return 0. */
{ int err;
  if(FUNCTOR(t) == '^' && equals(ARG(0,t),ten))
     { *ans = ARG(1,t);
       return 0;
     }
  if(OBJECT(t) && TYPE(t) == INTEGER)
     { long m = INTDATA(t);
       switch(m)
          { case 1:  *ans = zero;
                     return 0;
            case 10: *ans = one;
                     return 0;
            case 100: *ans = two;
                      return 0;
            case 1000: *ans = three;
                       return 0;
            case 10000: *ans = four;
                        return 0;
          }
     }
  if(OBJECT(t))
     { *ans = log1(t);
       return 0;
     }
  err = check1(lessthan(zero,t));
  if(!err)
     { *ans = log1(t);
       return 0;
     }
  errbuf(0,english(1155));
     /* Can't take log of a non-positive number */
  return 1;
}
/*__________________________________________________________________*/
static int take_ln(term t, term *ans)
/* set *ans = ln(t); but in case t = e^u  set *ans = u;
   If t can't be checked positive, return 1; if it can return 0. */
{ int err;
  if(FUNCTOR(t) == '^' && equals(ARG(0,t),eulere))
     { *ans = ARG(1,t);
       return 0;
     }
  if(ONE(t))
     { *ans = zero;
       return 0;
     }
  if(equals(t,eulere))
     { *ans = one;
       return 0;
     }
  if(OBJECT(t))
     { *ans = ln1(t);
       return 0;
     }
  err = check1(lessthan(zero,t));
  if(!err)
     { *ans = ln1(t);
       return 0;
     }
  errbuf(0,english(688));
     /* Can't take ln of a non-positive number */
  return 1;
}
/*__________________________________________________________________*/
int logeqn(term eqn, term arg, term *next, char *reason)
/* Take log of both sides of an equation */
{ term left,right,newleft,newright;
  int err;
  if(FUNCTOR(eqn) != '=')
     return 1;
  left = ARG(0,eqn);
  right = ARG(1,eqn);
  err = take_log(left,&newleft);
  if(err)
     return 1;
  err = take_log(right,&newright);
  if(err)
    return 1;
  *next = equation(newleft,newright);
  HIGHLIGHT(*next);
  strcpy(reason, english(1153));
    /* log of both sides */
    /* 'Take log of both sides' would be one character too long */
  return 0;
}
/*__________________________________________________________________*/
int lneqn(term eqn, term arg, term *next, char *reason)
/* Take log of both sides of an equation */
{ term left,right,newleft,newright;
  int err;
  if(FUNCTOR(eqn) != '=')
     return 1;
  left = ARG(0,eqn);
  right = ARG(1,eqn);
  err = take_ln(left,&newleft);
  if(err)
     return 1;
  err = take_ln(right,&newright);
  if(err)
    return 1;
  *next = equation(newleft,newright);
  HIGHLIGHT(*next);
  strcpy(reason, english(1154));
    /* Take ln of both sides */
  return 0;
}
/*__________________________________________________________________*/
int logbeqn(term eqn, term arg, term *next, char *reason)
/* if a^u = a^v then u=v  */

/* Also on equations like 5^(...) = 25, it factors the right
side and protects it so logbeqn will be used properly at the
next step */

{ term left,right,u,v;
  int err,err2;
  unsigned nfactors,nfactors2;
  term factored,factored2,newleft,base;
  unsigned short path[3];
  if(FUNCTOR(eqn) != '=')
     return 1;
  left = ARG(0,eqn);
  right = ARG(1,eqn);
  if(FUNCTOR(left) == '^' && RATIONALP(ARG(0,left)) &&
     RATIONALP(right) && !ZERO(right) &&
     get_mathmode() == AUTOMODE
    )
     /* example:  (4/5)^(...) = 64/125; */
     { u = ARG(0,left);
       value(make_power(u,two),&v);
       if(equals(v,right))
          { *next = equation(left,make_power(u,two));
            strcpy(reason, english(1850));  /* write as square */
            path[0] = '=';
            path[1] = 2;
            path[2] = 0;
            set_pathtail(path);
            SetShowStepOperation(writenumberassquare);
            return 0;
          }
       value(make_power(u,three),&v);
       if(equals(v,right))
          { *next = equation(left,make_power(u,three));
            path[0] = '=';
            path[1] = 2;
            path[2] = 0;
            set_pathtail(path);
            SetShowStepOperation(writenumberascube);
            return 0;
          }
     }
  if(FUNCTOR(left) == '^' && INTEGERP(ARG(0,left)) &&
     INTEGERP(right) && !ZERO(right) &&
     get_mathmode() == AUTOMODE
    )
     /* examples:  5^(...) = 25;  change 25 to 5^2 with reason "write as square";
                   8^(...) = 64;  do NOT write 8 and 64 as powers of 2,
                                  rather write 64 - 8^2
                   8^(...) = 128; then 8 and 128 have to be written as powers of 2,
                                  using "factor integer".
     */
     { u = ARG(0,left);
       value(make_power(u,two),&v);
       if(equals(v,right))
          { *next = equation(left,make_power(u,two));
            strcpy(reason, english(1850));  /* write as square */
            path[0] = '=';
            path[1] = 2;
            path[2] = 0;
            set_pathtail(path);
            SetShowStepOperation(writenumberassquare);
            return 0;
          }
       value(make_power(u,three),&v);
       if(equals(v,right))
          { *next = equation(left,make_power(u,three));
            path[0] = '=';
            path[1] = 2;
            path[2] = 0;
            set_pathtail(path);
            SetShowStepOperation(writenumberascube);
            return 0;
          }
       err2 = factor_integer(u,&nfactors2,&factored2);
       if((err2 && err2 != 2) || nfactors2 > 1)  /* err2 == 2 means it's prime */
          return 1;
       if(err2 != 2 && FUNCTOR(factored2) == '^')
          { base = ARG(0,factored2);
            HIGHLIGHT(factored2);
            if(FRACTION(ARG(1,left)))
               PROTECT(factored2);
            /* if applied without the condition that the exponent be a fraction,
               this protection blocks solving 8^(3x-2) = 64 after the 8
               becomes 2^3, because autosimp won't go into (2^3)^(3x-2) if the
               base (2^3) is protected and the exponent isn't a fraction. */
            newleft = make_power(factored2,ARG(1,left));
          }
       else
          { base = ARG(0,left);
            newleft = left;
          }
       err = factor_integer(right,&nfactors,&factored);
       if(err || nfactors != 1 ||
          FUNCTOR(factored) != '^' ||
          !equals(ARG(0,factored),base)
         )
          return 1;
       HIGHLIGHT(factored);
       if(FRACTION(ARG(1,left)))  /* see above */
          PROTECT(factored);
       *next = equation(newleft,factored);
       strcpy(reason, english(255));  /* factor integer */
       path[0] = '=';
       path[1] = 2;
       path[2] = 0;
       set_pathtail(path);
       SetShowStepOperation(factorinteger);
       return 0;
     }
  /* Not necessary to put the same in for  25 = 5^(...) because
     automode will switch the sides first anyway
  */
  if(FUNCTOR(left) != '^' || FUNCTOR(right) != '^')
     return 1;
  if(!equals(ARG(0,left),ARG(0,right)))
     return 1;
  err = infer(nonzero(ARG(0,left)));
  if(err)
     { errbuf(0,english(1686));
       /* Cannot eliminate the possibility that the base is zero. */
       return 1;
     }
  err = infer(ne(ARG(0,left),one));
  if(err)
     { errbuf(0,english(1687));
       /* Cannot eliminate the possibility that the base is one. */
       return 1;
     }

  *next = equation(ARG(1,left),ARG(1,right));
  HIGHLIGHT(*next);
  strcpy(reason, english(1354)); /* if a^u = a^v then u=v */
  return 0;
}
/*____________________________________________________________________*/
static int set_good_values(term t)
/* Attempt to find values of the variable in t that will make
t defined.  Set the values of those variables to those values
so that deval will make t defined. Return 0 for success,
1 for failure.
   At present this can only succeed if there is just one
variable (parameter) in t; and all it does is try several
hundred values between -10 and 10 and then several more
between -100 and 100.  Nevertheless this will
handle a lot of examples; equations that have a parameter at all
tend to have just ONE parameter, and expressions in problems
tend to be defined for small values if at all.
*/

{ term *atomlist;
  double z,w;
  int nvars;
  term c;  /* the parameter whose value will be set */
  nvars = variablesin(t,&atomlist);
  if(nvars == 0)
     { free2(atomlist);
       deval(t,&z);
       return z == BADVAL ? 1 : 0;
     }
  c = atomlist[0];
  free2(atomlist);
  if(nvars > 1)
     return 1; /* failure */
  for(w = -10.0; w <= 10.0; w += 0.1)
     { SETVALUE(c,w);
       deval(t,&z);
       if(z != BADVAL)
           return 0;
     }
  /* Try a larger range */
  for(w = -99.9; w <= 100.0; w += 1.0)
     { SETVALUE(c,w);
       deval(t,&z);
       if(z != BADVAL)
          return 0;
     }
  return 1;
}

/*_________________________________________________________________________*/
static int same_sign(term left, term right)
/* return 0 if left and right have the same sign, i.e.
left * right >= 0.  Return 1 if this can be refuted.
Return 2 if it can neither be proved nor refuted.
Don't actually call the prover because otherwise we
get out-of-space errors, when lpt calls reduce_ineq
which calls ssolve which calls square_eqn; if square_eqn
calls the prover again trouble results, although it
isn't strictly circular.
*/
{ int leftsign, rightsign, err;
  term u,cancelled;
  if(ZERO(left) || ZERO(right))
     return 0;
  if(obviously_nonnegative(left))
     leftsign = 1;
  else if(obviously_nonnegative(strongnegate(left)))
     leftsign = -1;
  else
     leftsign = 0;
  if(obviously_nonnegative(right))
     rightsign = 1;
  else if(obviously_nonnegative(strongnegate(right)))
     rightsign = -1;
  else
     rightsign = 0;
  if(leftsign * rightsign > 0)
     return 0;
  if(leftsign * rightsign < 0)
     return 1;
  /* Now leftsign or rightsign, or both, is zero. */
  err = cancel(left,right,&cancelled,&u);
  if(!err)
     { if(obviously_nonnegative(u))
          return 0;
       if(obviously_nonnegative(strongnegate(u)))
          return 1;
       return 0;
     }
  polyval(product(left,right),&u);
  if(obviously_nonnegative(u))
     return 0;
  if(obviously_nonnegative(strongnegate(u)))
     return 1;
  return 2;
}

/*_____________________________________________________________________*/
int pseudosquare(term t, term arg, term *next, char *reason)
/* a = -b becomes a^2 = -b^2 if a,b >= 0 */
{ term u,v;
  if(FUNCTOR(t) != '=')
     return 1;
  u = ARG(0,t);
  v = ARG(1,t);
  if(
     (obviously_nonnegative(u) && obviously_nonnegative(strongnegate(v))) ||
     (obviously_nonnegative(v) && obviously_nonnegative(strongnegate(u)))
    )
      {  *next = equation(square(u),tnegate(square(v)));
         HIGHLIGHT(*next);
         strcpy(reason, english(1901));
         /* a=-b becomes a^2=-b^2  if a,b  \ge  0 */
         set_checksolutionsflag(1);
         return 0;
      }
  return 1;
}
/*_____________________________________________________________________*/
int pseudosquare2(term t, term arg, term *next, char *reason)
/* a = -b becomes a=0 if a,b >= 0 */
{ term u,v;
  if(FUNCTOR(t) != '=')
     return 1;
  u = ARG(0,t);
  v = ARG(1,t);
  if(
     (obviously_nonnegative(u) && obviously_nonnegative(strongnegate(v))) ||
     (obviously_nonnegative(v) && obviously_nonnegative(strongnegate(u)))
    )
      {  *next = equation(u,zero);
         HIGHLIGHT(*next);
         strcpy(reason, english(1902));
         /* a=-b becomes a=0     if a,b  \ge  0 */
         set_checksolutionsflag(1);
         return 0;
      }
  return 1;
}
/*_____________________________________________________________________*/
int pseudosquare3(term t, term arg, term *next, char *reason)
/* a = -b becomes b=0 if a,b >= 0 */
{ term u,v;
  if(FUNCTOR(t) != '=')
     return 1;
  u = ARG(0,t);
  v = ARG(1,t);
  if(
     (obviously_nonnegative(u) && obviously_nonnegative(strongnegate(v))) ||
     (obviously_nonnegative(v) && obviously_nonnegative(strongnegate(u)))
    )
      {  *next = equation(strongnegate(v),zero);
         HIGHLIGHT(*next);
         strcpy(reason, english(1903));
         /* a=-b becomes b=0     if a,b \ge 0 */
         set_checksolutionsflag(1);
         return 0;
      }
  return 1;
}

Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists