Sindbad~EG File Manager

/* M. Beeson, for Mathpert */
/* Last modified 11.12.98   */
/* 1.25.06 modified make_constraints to use assumptions */

/*  Constraint generation and solving, used by Mathpert's theorem-prover
to correctly deduce the domains of definite integrals in which the
integrand contains a trig function, so its domain is expressed by a formula
such as  (2n pi - pi/2) < x < (2n pi + pi/2) involving an existential variable
n.  The prover gets  a <= x <= b in the binders list and must (try to ) infer or
refute exists(n, domain(u)).  */

/* original date before 7.1.94
   last modified 6.14.98
*/

#include <assert.h>
#include <stdlib.h>  /* NULL */
#include <math.h>
#include "globals.h"
#include "dcomplex.h"
#include "prover.h"
#include "functors.h"
#include "mplimits.h"
#include "algaux.h"
#include "order.h"
#include "eqn.h"
#include "deval.h"
#include "binders.h"

static int resolve_constraints(term *,int);
static void make_constraint(term, term,int);
static void make_constraints(term,int);
static termlist *constraints;
static termlist *lastconstraint;
static void add_constraint(term);

/*_____________________________________________________________________*/
void init_constraints(void)
/* called outside prover.dll to initialize constraints */
{ constraints = lastconstraint = NULL;
;
}
/*_____________________________________________________________________*/
static void make_constraints(term t, int whichvar)
/* traverse the binders list calling make_constraint(p,t, whichvar)
for every p in the binders list; also use the assumptions. */
/* Return the number of new constraints generated */
{ int n = get_nextassumption();
  int i;
  term p;
  termlist *marker;
  termlist *binders = get_binders();
  for(marker=binders;marker!=NULL;marker=marker->next)
      make_constraint(marker->data,t,whichvar);
  for(i=0;i<n;i++)
      { p = get_assumption(i);
        if(contains(p,FUNCTOR(get_varlist()[whichvar])))
           continue;
        if(interval_as_and(p) )
           { make_constraint(ARG(0,p),t,whichvar);
             make_constraint(ARG(1,p),t,whichvar);
           }
        else if(INEQUALITY(FUNCTOR(p)))
           make_constraint(p,t,whichvar);
      }
}
/*_____________________________________________________________________*/
static void make_constraint(term p, term t, int whichvar)
/*  if t is an inequality involving an existential
variable n = varlist[whichvar], and p is another inequality
(from the binder list or assumptions), which does
not contain n, generate a constraint if posssible according to these
rules:  if p is a < b and t is u < b generate u <= a
        if p is a < b and t is a < v generate b <= v
    and similarly for \le  in place of < in the four positions on the left.
The constraints that are generated are stored in the constraints list.
*/

{ unsigned short f = FUNCTOR(p);
  unsigned short g = FUNCTOR(t);
  unsigned short h;
  term a,b,u,v,constraint;
  term *varlist = get_varlist();
  int nvariables = get_nvariables();
  term x = varlist[whichvar];
  assert(whichvar < nvariables);
  if(f != '<' && f != LE)
     return;
  if(g != '<' && g != LE)
     return;
  if(!contains(t,FUNCTOR(x)))
     return;
  a = ARG(0,p);
  b = ARG(1,p);
  u = ARG(0,t);
  v = ARG(1,t);
  h = (unsigned short) (f == LE && g == '<' ? '<' : LE);
  if(equals(b,v) && !contains(b,FUNCTOR(x)))
     constraint =  h == LE ?  le(u,a) : lessthan(u,a);
  else if(equals(a,u) && !contains(a,FUNCTOR(x)))
     constraint =  h == LE ?  le(b,v) : lessthan(b,v);
  else
     return;
  add_constraint(constraint);
}

/*_____________________________________________________________________*/
static int resolve_constraints(term *ans, int whichvar)
/*  the constraints list and assumptions may contain inequalities involving an
existential variable.  Are these inequalities consistent?  If not
set *ans= falseterm and return 0.
Is there a value of the existential variable
that works?  If so return  an equation such as 'n = 5'  in *ans,
and return 0 as the official return value.
If the process is inconclusive return 1.
 */

/*  Example:  computing the domain of integral(sec x tan x, x, 0, pi_term/3)
generates first the binders 0 <= x, x <= pi_term/3; then the assumptions
(2n-1)\pi /2 < x < (2n+1)\pi /2;  then infer_literally generates the
constraints   (2n-1)\pi /2 <= 0 and  \pi /3 <= (2n+1)\pi /2.  Now
resolve_constraints must solve these inequalities for n, getting
n <= 1/2 and n >= -1/6, and then find n=0 to solve the two inequalities.
(Had it been \pi  instead of \pi /3 in the upper limit, we would get
n <= 1/2 and n >= 1/2, which has no solution, since n: int.)
Finally it must eliminate these constraints from the binders list.  */

{ int err;
  unsigned short count,k;
  term temp,n,u;
  termlist *marker = constraints;
  term *varlist = get_varlist();
  int nvariables = get_nvariables();
  term x = varlist[whichvar];
  eqnsolver ssolve;
  assert(whichvar < nvariables);
  if(marker==NULL)
     { *ans = trueterm;
       return 0;
     }
  /* Now check if x occurs in two different constraints */
  count = 0;
  for(marker=constraints; marker != NULL; marker=marker->next)
      { if(contains(marker->data,FUNCTOR(x)))
           ++count;
      }
  if(count < 2)
     return 1;
  u = make_term(AND,count);
  k = 0;
  ssolve = get_solver();
  for(marker=constraints; marker != NULL; marker=marker->next)
     { err = ssolve(marker->data,x,&temp);
       if(!err)
          { ARGREP(u,k,temp);
            ++k;
          }
     }
  SETFUNCTOR(u,AND,k);
  if(k < 2)
     { RELEASE(u);
       return 1;  /* can't do anything */
     }
 /* Now all the terms in constraints have been solved for x, and
    the solved inequalities put in u  */
  *ans = lpt(u);
  if(equals(*ans,falseterm) || equals(*ans,trueterm))
     return 0;
  /* Now *ans may be something like  -1/2 <= n  && n <= 1/2  */
  if(TYPE(x) == INTEGER && interval_as_and(*ans))
     { term a = ARG(0,ARG(0,*ans));
       term b = ARG(1,ARG(1,*ans));
       /* a and b are the endpoints of the interval */
       /* One of a or b may be an integer itself */
       if(INTEGERP(a) && FUNCTOR(ARG(0,*ans)) == LE)
          n = a;
       else if(INTEGERP(b) && FUNCTOR(ARG(1,*ans)) == LE)
          n = b;
       else  /* neither a nor b is an integer, or the interval is open
                at the integer end(s) */
          { double z,w, mid;
            long kk;
            err = deval(a,&z);
            if(err)
               return 1;
            err = deval(b,&w);
            if(err)
               return 1;
            mid = floor(w);
            if(floor(z) == mid)
               { *ans = falseterm;
                 return 0;
               }
            if(!nearint(w,&kk))
               { /* bignum required, forget it */
                 return 1;
               }
            n = make_int(kk);
          }
       /* Now we have a satisfactory value of n */

       *ans = equation(x,n);
       return 0;
     }
  return 1;  /* inconclusive */
}
/*________________________________________________________________*/

void add_constraint(term p)
/* add p to the end of the constraints list */
/* lastconstraint always points to the last node,
or to NULL if there is no node */
{ termlist *oldlast = lastconstraint;
  lastconstraint = mallocate(sizeof(termlist));  /* create a new last node */
     { if(lastconstraint == NULL)
          nospace();
     }
  lastconstraint->prev = oldlast;        /* set the back-pointer */
  lastconstraint->data = p;              /* fill it */
  lastconstraint->next = NULL;
  if(oldlast == NULL)
     constraints = lastconstraint;
  else
     oldlast->next = lastconstraint;    /* set the previous forward pointer */
}

/*_____________________________________________________________________*/
int infer_by_constraints(term t, int whichvar)
/* see make_constraint for documentation of the method */
/* varlist[whichvar] is assumed to be an EXISTENTIAL variable contained in t */
/* t is assumed to be a conjunction */
/* Return value is 0 for successful inference, 1 for refutation,
2 for inconclusive attempt */

{ term s;
  int i,err;
  unsigned short n;
  termlist *savelast = lastconstraint;
  termlist *savefirst = constraints;
  assert(FUNCTOR(t) == AND);
  n = ARITY(t);
  for(i=0;i<n;i++)
     make_constraints(ARG(i,t),whichvar);
  if((void  *) lastconstraint == (void  *) savelast)
     /* No new constraints were generated */
     return 2;  /* inconclusive */
  if(savefirst != NULL)
     constraints = savefirst;
  err = resolve_constraints(&s,whichvar);
  constraints = savefirst;
  lastconstraint = savelast;
  if(lastconstraint != NULL)
     lastconstraint ->next = NULL;
  if(err)
     return err;
  if(equals(s,falseterm))
     return 1;       /* constraints can't be resolved  */
                     /* e.g.  integral(tan x, x, 0, pi_term)  */
  if(equals(s,trueterm))
     return 0;
  assert(FUNCTOR(s) == '=' && ISATOM(ARG(0,s)));
  /* s has the form x = a for some existential variable x */
  assume(s);
  simplify_assumptions(t);
  return 0;
}