Sindbad~EG File Manager

/*
M. Beeson, for Mathpert
Original date 9.27.92
last modified 8.15.98
9.3.07 modified eliminate to swap xmin and xmax if necessary, rather than presuming a < b.
9.6.07 modified eliminate in case a or b is not seminumerical
*/


#include <string.h>
#include <assert.h>
#include <math.h>
#include "globals.h"
#include "graphstr.h"
#include "mpdoc.h"
#include "prover.h"
#include "sing.h"      /* get_sing */
#include "deval.h"
#include "elim.h"
#include "ssolve.h"

#include "display1.h"
#include "bigrect.h"
#include "lterm.h"  /* interval_as_and */

int elim2(term t, term x, term a, term b, term *ans);
/*___________________________________________________________________*/
int eliminate(term t, term x, term a, term b, term *ans)
/* Assumes a and b are seminumerical; if they are not it just returns 1.
Eliminate an existential parameter from t, returning an equation or
OR of equations not involving the existential parameter, enumerating
all possible values of t that lie between a and b (inclusive).  Return
0 for success, nonzero for failure.   x is the eigenvariable.   If a 
and b are seminumerical, it uses their numerical values to do this.
*/
{ double xmin,xmax,z;
  double *outarray;
  term u,c;
  long kk;
  term *restrictions;
  int dimrestrictions;
  int err,i,mm;
  int nextassumption;
  unsigned short m,f;
  err = deval(a,&xmin);
  if(err)
     return 1;
  err = deval(b,&xmax);
  if(err)
     return 1;
  if(xmin > xmax)
     { double temp = xmax;
       xmax = xmin;
       xmin = temp;
     }
  /* We will use get_sing, originally written for finding singularities.
     It needs a list of any restrictions on the integer parameter */
  nextassumption = get_nextassumption();
  assert(nextassumption >= 0);
    /* it's a crash if you call this while nextassumption has been
       temporarily set to -1  */
  if(nextassumption == 0)
     { restrictions = NULL;
       dimrestrictions = 0;
     }
  else  /* put all inequalities in the assumptions list into 'restrictions' */
     { restrictions = callocate(2*nextassumption,sizeof(term));
          /* factor of 2 because some of the assumptions may be
             interval_as_and terms that give rise to two restrictions */
       if(restrictions==NULL)
          { nospace();
            return 1;
          }
       dimrestrictions = 0;
       for(i=0;i<nextassumption;i++)
          { u = get_assumption(i);
            f = FUNCTOR(u);
            if(interval_as_and(u))
               { restrictions[dimrestrictions] = ARG(0,u);
                 restrictions[dimrestrictions+1] = ARG(1,u);
                 dimrestrictions += 2;
               }
            else if(INEQUALITY(f))
               { restrictions[dimrestrictions] = u;
                 ++dimrestrictions;
               }
          }
     }
  err = get_sing(xmin,xmax,x,&t,1,restrictions,dimrestrictions,&outarray,&mm);
  if(restrictions)
     free2(restrictions);
  if(err)
     return 1;
  if(mm==0)  /* no solutions in the interval */
     { /* outarray hasn't been allocated, so don't free it */
       *ans = falseterm;
       return 0;
     }
  if(mm > 100)  /* 100 is arbitrary here */
     { free2(outarray);
       return 2;
     }
  m = (unsigned short)mm;
  *ans = make_term(OR,m);  /* even if m == 1 */
  for(i=0;i<m;i++)
     { z = outarray[i];
       if(i==0 && fabs((z-xmin)/(xmax-xmin)) < VERYSMALL)
          /* z is really the left endpoint except for roundoff error */
          ARGREP(*ans,i,equation(x,a));
       else if(i==m-1 && fabs((z-xmax)/(xmax-xmin)) < VERYSMALL)
          /* z is really the right endpoint except for roundoff error */
          ARGREP(*ans,i,equation(x,b));
       else if(nearint(12*z/PI_DECIMAL,&kk))
          {  /* z is kk * pi/12; let c be kk/12 in lowest terms */
            int sign = 1;
            if(kk < 0)
               { kk = -kk;
                 sign = -1;
               }
            if(kk % 12 == 0)
               c = kk==12 ? pi_term : product(make_int(kk/12),pi_term);
            else if(kk % 6 == 0)
               c = kk==6 ?  make_fraction(pi_term,two) :
                            product(make_fraction(make_int(kk/6),two),pi_term);
            else if(kk % 3 == 0)
               c = kk==3 ? make_fraction(pi_term,four) :
                           product(make_fraction(make_int(kk/3),four),pi_term);
            else if(kk % 2 == 0)
               c = kk==2 ? make_fraction(pi_term,six) :
                           product(make_fraction(make_int(kk/2),six),pi_term);
            else
               c = product(make_fraction(make_int(kk),make_int(12)),pi_term);
            if(sign == -1)
               c = tnegate(c);
            ARGREP(*ans,i,equation(x,c));
          }
       else
          ARGREP(*ans,i,equation(x,make_double(z)));
     }
  free2(outarray);
  if(m==1)
     { term temp = ARG(0,*ans);
       RELEASE(*ans);
       *ans = temp;
     }
  if(FUNCTOR(*ans)== '=' && CHECKED(t))
     SETCHECKED(*ans);
  if(FUNCTOR(*ans) == OR && CHECKED(t))
     { for(i=0;i<ARITY(*ans);i++)
          SETCHECKED(ARG(i,*ans));
     }
  return 0;
}
/*___________________________________________________*/
term lnegate(term t)
/* Return the strong logical negation of t.
   If t is an OR of equations, return an AND of NE terms, etc.
*/
{ unsigned short n;
  int i;
  term ans;
  unsigned short f = FUNCTOR(t);
  switch(f)
     { case '=':
          return ne(ARG(0,t),ARG(1,t));
       case NE:
          return equation(ARG(0,t),ARG(1,t));
       case '<':
          return le(ARG(1,t),ARG(0,t));
       case LE:
          return lessthan(ARG(1,t),ARG(0,t));
       case '>':
          return le(ARG(0,t),ARG(1,t));
       case GE:
          return lessthan(ARG(0,t),ARG(1,t));
     }
  if(f == OR || f == AND)
     { n = ARITY(t);
       if(f == OR)
          ans = make_term(AND,n);
       else
          ans = make_term(OR,n);
       for(i=0;i<n;i++)
          ARGREP(ans,i,lnegate(ARG(i,t)));
       return ans;
     }
  if(f == IMPLIES)
     return and(ARG(0,t),lnegate(ARG(1,t)));
  if(f == NOT)
     return ARG(0,t);
  ans = make_term(NOT,1);
  ARGREP(ans,0,t);
  return ans;
}

/*___________________________________________________________________________*/
int elim2(term t, term x, term a, term b, term *ans)
/* It is assumed that either a is seminumerical and b is not, and b does not contain x,
or both and b are not seminumerical and do not contain x.
   It is assumed that t is an equation x = f(n) where f is monotone increasing in n,
and does not contain x.  
   The return value is  a term dom, such that if dom is assumed, then there are no possible 
values of f(n) between a and b.  Example:  eliminate(zerovals(SIN), t, pi_term/2, x,&ans)
should return   0 < x < pi.   (And of course dom should be
the weakest possible such assumption.)   If neither a nor b is 
seminumerical then, if the possible values of t are equally space as 
they are in the example,  the answer will not actually eliminated the 
existential variable.  For example eliminate(zerovals(SIN), t, x,y, &ans)
should return  n pi <= x  && x <=y &&  y <= (n+1)pi.
   If t is too complicated, return false in ans, and 1 for the return value.
Return value of 0 means success.   
   As of Sept. 6, 2007,  t will always be zerovals(SIN) or zerovals(COS),
but that is not assumed. 
*/
{  term *atomlist;
   term n,solved,lo,hi,K,J;
   int err;
   double z;
   long k;
   int nvars = variablesin(ARG(1,t),&atomlist);
   /* atomlist should now just contain the single existential variable. */
   if(nvars > 1)
       { *ans = falseterm;
         return 1;
       }
   n = atomlist[0];
   free2(atomlist);
   /* Now we have the existential variable n */
   /* Hopefully t has the form x = f(n) for some increasing f,  e.g. x = n pi or x = n pi/2 + pi/2, etc. */
   if(FUNCTOR(t) != '=' || !equals(ARG(0,t),x) || contains(ARG(1,t),FUNCTOR(x)) || 
      contains(a,FUNCTOR(x)) || contains(b,FUNCTOR(x))
     )
       { *ans = falseterm;
         return 1;
       }
   if(!seminumerical(a))
       { /* then ans should be f(n) < a <= b < f(n+1) */
         K = ARG(1,t);
         subst(sum(n,one),n,K,&J);
         *ans = and3(lessthan(K,a), le(a,b),lessthan(b,J));
         return 0;
       }
   /* find the value k of n such that  f(n) <= a <= f(n+1) */
   err = ssolve(equation(a,ARG(1,t)),n, &solved);
   if(err) 
      { *ans = falseterm;
        return 1;
      }
   /* the desired value of n is the floor of the solution */ 
   deval(ARG(1,solved),&z);
   z = floor(z);
   nearint(z,&k);
   /* The lower and upper values of b desired are f(k) and f(k+1) */
   K = make_int(k);
   J = make_int(k+1);
   subst(K,n,ARG(1,t),&lo);
   subst(J,n,ARG(1,t),&hi);
   *ans = lpt(and(le(lo,b),le(b,hi)));  /* return the closed interval */
   return 0;
}