Sindbad~EG File Manager

/* Algorithm for determining the number of zeroes of polynomial
P which make another polynomial Q positive.
Author:  M. Beeson, for Mathpert
Original date: 8.16.93
Last modified 6.14.98
Reference:  Coste and Roy, J. Symbolic Computation 5 (1988) 121-129
5.5.13 made nu static
9.25.14  initialized parity=0 in nu
*/

/* These functions assume the coefficients are seminumerical, so
they can be numerically evaluated by deval */

#include <assert.h>
#include <math.h>
#include "globals.h"
#include "polynoms.h"
#include "sturm.h"
#include "deval.h"

static int overflow_error;
/* even though the coefficients are presumed evaluable, the
evaluation could in principle cause overflow. */
static int numerize(POLYnomial p, POLYnomial *ans);
static int nu(POLYnomial r, POLYnomial q);
/*_________________________________________________________________*/
int gsturm(POLYnomial r, POLYnomial q, term *ans)
/* compute the generalized Sturm sequence associated with r and q,
vix, P(0) = r, P(1) = q, P(i+1) = - P(i-1) mod P(i), stopping with
the last nonzero one P(i), and returning *ans as an AND of these
terms.  The use of AND as the functor of *ans is arbitrary.
For efficiency, pseudodiv is used, to prevent the accumulation of
complicated denominators, and so the sequence is really defined by
the above equation only up to some positive constant.  We only use
it to compute sign changes anyway, so this is OK.
The function allocates space for *ans, and makes no attempt to clean
up memory.  This function can use a lot of memory, so functions calling
it should first call heapmax() and afterwards reset_heap.
If there is an error evaluating a coefficient, it returns 1,
else it returns 0 for success.
*/

{ unsigned short degR = DEGREE(r);
  unsigned short degQ = DEGREE(q);
  unsigned short n;
  POLYnomial quo,rem;
  term c;
  double z;
  int i,err;
  POLYnomial numR, numQ;
  /* In case the coefficients contain algebraic numbers the computations
     easily run Mathpert out of memory. Therefore replace such numbers
     by their decimal values. */
  err = numerize(r,&numR);
  if(err)
     return 1;
  err = numerize(q,&numQ);
  if(err)
     return 1;
  r = numR;
  q = numQ;
  n =  (unsigned short) (degR > degQ ? degQ+2 : degR+3);
    /* max length of the generalized Sturm sequence */
  *ans = make_term(AND,n);
  ARGREP(*ans,0,r);
  ARGREP(*ans,1,q);
  for(i=0; ;i++)  /* exit when next term is zero */
     { pseudodiv(ARG(i,*ans), ARG(i+1,*ans),&quo,&rem,&c);
       if(DEGREE(rem) == 0 && ZERO(LEADING(rem)))
          { SETFUNCTOR(*ans,AND,(unsigned short) (i+2));
            return 0;
          }
       deval(c,&z);
       assert(i+2 < n);
       if(z == BADVAL)
          /* possible in theory I guess */
            return 1;
       if(z > 0.0) /* the actual remainder is rem/c, so we have
                      to insert another negation if c is negative */
          ARGREP(*ans,i+2,polyneg(rem));
          /* remember the formula is P(i+1) = - P(i-1) mod P(i);
             the polyneg here takes care of the minus sign */
       else
          { assert(z < 0.0);
            ARGREP(*ans,i+2,rem);
          }
       if(DEGREE(rem) == 0)
          { /* This term is constant, so it's the last one; no point
               actually carrying out another pseudodiv to get zero
               remainder. */
            SETFUNCTOR(*ans,AND,(unsigned short)(i+3));
            return 0;
          }
     }
}

/*_________________________________________________________________*/

static int nu(POLYnomial r, POLYnomial q)
/* changes of sign of the generalized sturm sequence of r and q at
-infinity, minus the changes of sign at infinity */
/* gsturm could use a LOT of memory; this function resets the
heap before exiting so the net memory used is zero. */
/* If there is an error evaluating a coefficient, it sets
overflow_error */

{ term ans,c;
  POLYnomial u;
  int err, deg;
  int count1=0; /* for the sign changes at -infinity */
  int count2=0; /* for the sign changes at +infinity */
  int sign = 0; /* sign of the coefficient of last term considered */
  int parity=0;   /* was the power of the last nonzero term odd (parity 1)
                   or even (parity zero)? */
  double z;
  void  *savenode = heapmax();
  unsigned short i,n;
  err = gsturm(r,q,&ans);
  if(err)
     { overflow_error = 1;
       reset_heap(savenode);
       return 0;
     }
  n = ARITY(ans);  /* length of the generalized Sturm sequence */
  for(i=0;i<n;i++)
     { u = ARG(i,ans);
       deg = DEGREE(u);
       c = LEADING(u);
       if(ZERO(c))
          continue;
       deval(c,&z);
       if(fabs(z) < VERYSMALL)
          continue;
       if(z == BADVAL)
          { overflow_error = 1;
            reset_heap(savenode);
            return 0;
          }
       if(sign == 0)
          { sign = z > 0.0 ? 1 : -1 ;
            parity = (deg & 1);
            continue;
          }
       if(sign < 0 && z > 0.0)    /* last one neg, this one pos */
          { ++count2;             /* so it counts at +infinity  */
            if((deg & 1) == parity)   /* and at -infinity if parities match */
              ++count1;
            sign = 1;
          }
       else if(sign > 0 && z < 0.0)  /* last one pos, this one neg */
          { ++count2;                /* so it counts at +infinity  */
            if((deg & 1) == parity)      /* and at -infinity if parities match */
              ++count1;
            sign = -1;
          }
       else if( (sign < 0 && z < 0.0)     /* both negative */
                || (sign > 0 && z > 0.0)  /* or both positive */
              )
          { if((deg & 1) != parity)
               ++count1;    /* counts at -infinity if parity changed */
          }
       parity = (deg & 1);
     }
  reset_heap(savenode);
  return count1 - count2;
}
/*_________________________________________________________________*/
int sylvester(POLYnomial P, POLYnomial Q, unsigned *cpos, unsigned *cneg)
/* Assuming that gcd(P,Q) is 1, compute the number of roots of P that
make Q positive, and the number of roots of P that make Q negative */
/* This algorithm was invented by Sylvester in 1853.  */
/* Return 0 for success, 1 in case of deval error or P identically zero. */

{ int nu1,nu2,err,pos,neg;
  POLYnomial qpprime,pprime;
  pprime = polyderiv(P);
  if(DEGREE(P) == 0 && !ISZERO(LEADING(P)))
     { *cpos = *cneg = 0;
       return 0;  /* constant polynomial has no roots */
     }
  if(DEGREE(P) == 0)
     return 1;   /* erroneous input */
  overflow_error = 0;
  nu1 = nu(P,pprime);
  if(overflow_error)
     return 1;
  err = polymult(Q,pprime,&qpprime);
  if(err)
     return 1;
  nu2 = nu(P,qpprime);
  if(overflow_error)
     return 1;
  pos = (nu1 + nu2)/2;  /* it has to be an integer */
  neg = (nu1 - nu2)/2;
  assert(pos >= 0);
  assert(neg >= 0);
  *cpos = pos;  /* these are unsigned */
  *cneg = neg;
  return 0;
}

/*_________________________________________________________________*/
int coste_roy(POLYnomial P, POLYnomial Q, unsigned *cpos, unsigned *cneg)
/* compute the number of roots of P that make Q positive, and the
number of roots of P that make Q negative, without assuming gcd(P,Q)=1 */
/* Return -1 for evaluation error or P identically zero, 0 for success */
{ POLYnomial g;
  POLYnomial s,rem;
  term cc;
  double z;
  int err;
  if(DEGREE(P) == 0 && !ISZERO(LEADING(P)))
     { *cpos = *cneg = 0;
       return 0;
     }
  if(DEGREE(P) == 0)
     return 1;   /* P identically 0, erroneous input */
  g = polynomial_gcd(P,Q);
  if(DEGREE(g) == 0)
     return sylvester(P,Q,cpos,cneg);
  pseudodiv(P,g,&s,&rem,&cc);
  err= deval(cc,&z);
  if(err)
     return 1;
  if(z < 0.0)
     s = polyneg(s);
  return sylvester(s,Q,cpos,cneg);
}
/*_________________________________________________________________*/
int nroots(POLYnomial P)
/* return the number of real roots of P,
   or -1 for overflow error in computing the coefficients, or
   for P identically zero. */

{ int nu1;
  if(DEGREE(P) == 0 && !ISZERO(LEADING(P)))
     return 0;  /* constant poly has no roots */
  if(DEGREE(P) == 0)
     return -1;   /* P identically 0, erroneous input */
  nu1 = nu(P, polyderiv(P));
  if(overflow_error)
     return 1;
  return nu1;
}

/*_________________________________________________________________*/
int nroots_interval(POLYnomial P, term a, term b)
/* a and b are seminumerical terms with a < b;
return the number of roots of P in the open interval (a,b),
whether or not P is zero at a or b.  The coefficients
of P are assumed to be seminumerical.   Return -1
in case of evaluation error or P identically zero. */

{ POLYnomial Q = make_term(POLY,3);  /*  (x-a)(x-b)  */
  term c1 = tnegate(sum(a,b));
  term c2 = signedproduct(a,b);
  term temp;
  int err;
  unsigned cpos,cneg;
  if(DEGREE(P) == 0 && !ISZERO(LEADING(P)))
     return 0;  /* constant poly has no roots */
  if(DEGREE(P) == 0)
     return -1;   /* P identically 0, erroneous input */
  err = value(c1,&temp);
  if(err)
     temp = c1;
  ARGREP(Q,1,temp);
  err = value(c2,&temp);
  if(err)
     temp = c2;
  ARGREP(Q,0,temp);
  ARGREP(Q,2,one);
  err = coste_roy(P,Q,&cpos,&cneg);
  if(err)
     return -1;
  return cneg;
}

/*____________________________________________________________________*/
static int numerize(POLYnomial p, POLYnomial *ans)
/* evaluate coefficients of p to decimals unless they are
already integers.  If there is a non-seminumerical coefficient
or a coefficient on which deval fails, return 1.  Otherwise
put the result in *ans and return 0.
*/
{ unsigned short i,n = ARITY(p);
  double z;
  long k;
  term u;
  *ans = make_term(POLY,n);
  for(i=0;i<n;i++)
     { u = ARG(i,p);
       if(ISINTEGER(u) ||
          (NEGATIVE(u) && ISINTEGER(ARG(0,u)))
         )
          /* also bignums get converted to doubles. */
          { ARGREP(*ans,i,u);
            continue;
          }
       if(!seminumerical(u))
          return 1;
       deval(u,&z);
       if(z == BADVAL)
          return 1;
       if(fabs(z) < VERYSMALL)
          { ARGREP(*ans,i,zero);
            continue;
          }
       if(fabs(z) < 0.0)
          { if(nearint(-z,&k))
               { ARGREP(*ans,i,tnegate(make_int(k)));
                 continue;
               }
            ARGREP(*ans,i,tnegate(make_double(-z)));
            continue;
          }
       if(nearint(z,&k))
          ARGREP(*ans,i,make_int(k));
       else
          ARGREP(*ans,i,make_double(z));
     }
  return 0;
}