Sindbad~EG File Manager

/* M. Beeson, for use in Mathpert's prover */
/*  interval_implication is needed so addundefinedpoints will work
    right in minmax problems.  It's called by lpt to simplify
    inequalities.  */

/*
Original date 8.13.93
 modified 8.30.98
 5.5.13 made interval_implication static
 12.11.23 added include lterm.h and display1.h and bigrect.h
*/

#include <assert.h>
#include <math.h>
#include "globals.h"
#include "deval.h"
#include "polynoms.h"
#include "sturm.h"
#include "algaux.h"
#include "prover.h"
#include "pvalaux.h"  /* strongnegate */
#include "display1.h"
#include "bigrect.h"
#include "lterm.h"  /* interval_as_and */

static int interval_implication(term u, term t, term *ans);
static int interval_implication(term u, term t, term *ans);

/*________________________________________________________________________*/
static int interval_implication(term u, term t, term *ans)
/* u is an interval_as_and, t is an inequality (< or LE, not an equation).
Return *ans as a simplified form of t using u as an assumption.
Return 0 for success, 1 for failure to simplify t.
   It is not guaranteed that *ans is different from t.
*/

/* Examples:
    -1 \le  x \le  2 => x^2 < 9 ; here t is x^2 < 9 and *ans = true
    -3 < x \le  3 => x^2 < 9   isn't quite true;  we get  x!=3 returned in *ans
    -1 \le  x \le  2 => 9 < x^2   gives *ans= falseterm
    -1 \le  x \le  3 => 9 \le  x^2   gives  x=3 returned in *ans
*/


{ term a = ARG(0,ARG(0,u));
  term b = ARG(1,ARG(1,u));
  term x = ARG(1,ARG(0,u));
  term p;
  POLYnomial q;
  unsigned f = FUNCTOR(ARG(0,u));
  unsigned g = FUNCTOR(ARG(1,u));
  unsigned h = FUNCTOR(t);
  term uu = ARG(0,t);
  term vv = ARG(1,t);
  term *atomlist;
  int natoms,err;
  double saveit,aval,bval,leftval,rightval,midval;
  if(h != LE && h != '<' && h != NE)
     return 1;
  if(!ISATOM(x))
     return 1;
  if(!contains(t,FUNCTOR(x)))
     return 1;
  natoms = atomsin(t,&atomlist);
  if(natoms > 1 || !equals(atomlist[0],x))
     { free2(atomlist);
       return 1;
     }
  if(!ZERO(uu))
     polyval(sum(vv,strongnegate(uu)),&p);
  else
     p = uu;

  /* Now the task is to (prove or) reduce the proposition
     that p is positive (or non-negative or nonzero) */

  if(!seminumerical(a) || !seminumerical(b))
     return 1;
  deval(a,&aval);
  if(aval == BADVAL)
     return 1;
  deval(b,&bval);
  if(bval == BADVAL)
     return 1;
  saveit = VALUE(x);
  if(bval < aval)
     { /* false implies anything */
       *ans = trueterm;
       return 0;
     }
  SETVALUE(x,aval);
  deval(p,&leftval);
  if(leftval == BADVAL)
     { SETVALUE(x,saveit);
       return 1;
     }
  if(fabs(bval-aval) < VERYSMALL)
     { if(f == '<' && g == '<')  /* u is false then */
          { *ans = trueterm;
            return 0;
          }
       if(h == '<' && leftval > 0.0)
          { *ans = trueterm;
            return 0;
          }
       if(h == LE  && leftval > -VERYSMALL)
          { *ans = trueterm;
            return 0;
          }
       *ans = falseterm;
       return 0;
     }
  SETVALUE(x,bval);
  deval(p,&rightval);
  if(rightval == BADVAL)
     { SETVALUE(x,saveit);
       return 1;
     }
  if(leftval * rightval < 0)
    /* The sign will come out right even if there is overflow in the
       multiplication */
    /* p changes sign on the interval */
     { SETVALUE(x,saveit);
       return 1;
     }

  /* Now for the heart of the matter:  does p have a zero in (a,b),
     or doesn't it?   */
  err = makepoly(p,x,&q);
  if(err)
     return 1;  /* can't handle non-polynomials at all, unfortunately */
  err = nroots_interval(q,a,b);
  if(err)
     return 1;  /* it does have a root, or there was a deval error */
  /* Now it DOESN'T have a zero in (a,b) */
  SETVALUE(x,saveit);
  if(h == NE && f == '<' && g == '<')
     { *ans = trueterm;
        return 0;  /* we don't care about the sign of p on the interval */
     }
  if(fabs(leftval) < VERYSMALL || fabs(rightval) < VERYSMALL)
     {  /* is p positive or negative on (a,b) ? */
       if(fabs(leftval) < VERYSMALL && fabs(rightval) < VERYSMALL)
        /* zero at both ends */
          { if(h == NE)
               { *ans = (f == '<' && g == '<') ? trueterm :
                         f == '<' ? lessthan(a,x) :
                         g == '<' ? lessthan(x,b) :
                         and(lessthan(a,x),lessthan(x,b));
                 return 0;
               }
            SETVALUE(x, (aval + bval)/2.0);
            deval(p,&midval);
            SETVALUE(x,saveit);
            if(midval == BADVAL)
               return 1;
            if(h == '<' && midval > 0.0)
               { *ans =  (f == '<' && g == '<') ? trueterm:
                         f == '<' ? lessthan(a,x):
                         g == '<' ? lessthan(x,b):
                         and(lessthan(a,x),lessthan(x,b));
                 return 0;
               }
            if(h == '<' && midval < 0.0)
               { *ans = falseterm;
                 return 0;
               }
            assert(midval != 0.0);  /* there is no root in (a,b) */
            if(h == LE && midval > 0.0)
               { *ans = trueterm;
                 return 0;
               }
            if(h == LE)
               { *ans = (f == '<' && g == '<') ? trueterm:
                         f == '<' ? equation(x,b) :
                         g == '<' ? equation(x,a):
                         or(equation(x,a),equation(x,b));
                 return 0;
               }
          }
       if(fabs(leftval) < VERYSMALL)
          { /*  p is zero at a but not at b  */
            if(h == NE)
               { *ans = f == '<' ? trueterm : lessthan(a,x);
                 return 0;
               }
            if(rightval > 0.0)
               { if(f == '<' || h == LE)
                    { *ans =  trueterm;
                      return 0;
                    }
                 *ans = lessthan(a,x);
                 return 0;
               }
            if(rightval < 0.0)   /* negative */
               { if(f == LE && h == LE)
                    { *ans = equation(x,a);
                      return 0;
                    }
                 *ans = falseterm;
                 return 0;
               }
          }
       if(fabs(rightval) < VERYSMALL)
          { /*  p is zero at b but not at a  */
            if(h == NE)
               { *ans = g == '<' ? trueterm : lessthan(x,b);
                 return 0;
               }
            if(leftval > 0.0)
               { if(g == '<' || h == LE)
                    { *ans = trueterm;
                      return 0;
                    }
                 *ans = le(x,b);
                 return 0;
               }
            if(leftval < 0.0)
               { if(g == LE && h == LE)
                    { *ans = equation(x,b);
                       return 0;
                    }
                 *ans = falseterm;
                 return 0;
               }
          }
     }
  if(leftval < 0 && h != NE)  /* p is negative on (a,b) */
     *ans = falseterm;
  else  /* p is positive on (a,b), or h == NE */
     *ans = trueterm;
  return 0;
}
/*______________________________________________________________*/
int sturm_reduce(term t, term *ans)
/* t is an inequality.  Reduce t using the assumptions to a simpler
form using Sturm's theorem and related algorithms of
Sylvester and Coste-Roy, see sturm.c */
{ int i,err;
  term u;
  int nextassumption = get_nextassumption();
  assert(INEQUALITY(FUNCTOR(t)));
  for(i=0;i<nextassumption;i++)
     { u = get_assumption(i);
       if(!interval_as_and(u) || PROVISIONAL(u))
          continue;
       err = interval_implication(u,t,ans);
       if(!err && !equals(*ans,t))
          return 0;
     }
  return 1;
}