Sindbad~EG File Manager

/*
M. Beeson, for Mathpert
Original date 9.27.92
last modified 8.15.98
*/


#include <string.h>
#include <assert.h>
#include <math.h>
#define PROVER_DLL
#include "globals.h"
#include "graphstr.h"
#include "document.h"
#include "prover.h"
#include "sing.h"      /* get_sing */
#include "deval.h"
#include "elim.h"

/*___________________________________________________________________*/
MEXPORT_PROVER  int eliminate(term t, term x, term a, term b, term *ans)
/* 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.  Presumes a < b.  x is the eigenvariable.
*/
{ 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;
  /* 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 = false;
       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 : product(make_int(kk/12),pi);
            else if(kk % 6 == 0)
               c = kk==6 ?  make_fraction(pi,two) :
                            product(make_fraction(make_int(kk/6),two),pi);
            else if(kk % 3 == 0)
               c = kk==3 ? make_fraction(pi,four) :
                           product(make_fraction(make_int(kk/3),four),pi);
            else if(kk % 2 == 0)
               c = kk==2 ? make_fraction(pi,six) :
                           product(make_fraction(make_int(kk/2),six),pi);
            else
               c = product(make_fraction(make_int(kk),make_int(12)),pi);
            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;
}