Sindbad~EG File Manager
/* polynomial arithmetic */
/*
array-representation polynomial manipulation for Mathpert
M. Beeson
Original date 3.19.91
3.25.99 last modification in 1999
3.8.01 improved special_product
3.20.06 removed include heap.h as it's indirectly included from globals.h
9.2.07 removed second arg from calls to contentfactor_pval
4.23.13 corrected for-loop at line 284
12.4.14 modified polynomial_gcd to call heapmax() and save_and_reset().
12.7.14 added code to cancelgcd_aux near the end
12.8.14 added code at end of polymult to kill initial zeroes.
3.18.23 added assertion at line 928
*/
#include <assert.h>
#include <math.h>
#include "globals.h"
#include "ops.h"
#include "probtype.h"
#include "polynoms.h"
#include "order.h"
#include "cancel.h"
#include "algaux.h"
#include "simpsums.h"
#include "eqn.h"
#include "prover.h" /* noccurs */
#include "trigdom.h" /* express_trigrat */
#include "trigpoly.h" /* trigrational */
#include "reset.h" /* save_and_reset */
#include "pvalaux.h" /* content_factor */
#include "sqrtaux.h" /* sqrt_aux */
#include "deval.h" /* seminumerical */
static term make_monomial(term, int, term);
static void subresultant_gcd(POLYnomial u, POLYnomial v, POLYnomial *ans);
static int twopolys(term u, term v, term *x, POLYnomial *u1, POLYnomial *v1, POLYnomial *ans);
static int twotrigpolys(term u, term v, term *x, POLYnomial *u1, POLYnomial *v1, POLYnomial *ans);
static term gcdvar; /* used to pass something from polygcd to pp */
static POLYnomial polystrongneg(POLYnomial);
static term specialproduct(term a, term b);
static int polyform2(term t, term x, POLYnomial *ans);
static int difsq(term u, int *j);
term special_negate(term t);
#define ZEROPOLY(p) (FUNCTOR(p) == POLY && ARITY(p) == 1 && ZERO(ARG(0,p)))
#define UNITPOLY(p) (FUNCTOR(p) == POLY && ARITY(p) == 1 && ONE(ARG(0,p)))
/*_________________________________________________________________*/
static void addmonom(term a, term b, term *ans)
/* add numerically if possible, else use at from algaux.c
and collect terms if result isn't numerical */
{ term temp,temp2;
int err;
if(ZERO(a))
{ *ans = b;
return;
}
if(ZERO(b))
{ *ans = a;
return;
}
if(NEGATIVE(b) && equals(a,ARG(0,b)))
{ *ans = zero;
return;
}
if(NEGATIVE(a) && equals(b,ARG(0,a)))
{ *ans = zero;
return;
}
if(equals(a,b))
{ temp = product(two,a);
err = value(temp,ans);
if(err != 0 && err != 2)
*ans = temp;
return;
}
at(a,b,&temp);
if(numerical(temp))
{ err = value(temp,&temp2);
if(err==0 || err==2)
{ RELEASE(temp); /* allocated by at */
*ans = temp2;
return;
}
else
{ *ans = temp; /* don't call polyval on numerical terms */
SET_ALREADYARITH(*ans);
SET_ALREADY(*ans);
return;
}
}
polyval(temp,ans);
return;
}
/*_________________________________________________________________*/
static void multmonom(term a, term b, term *ans)
/* multiply numerically if possible, or for monomials of the same
base, add the exponents, or
else use mt from algaux.c */
{ term temp,temp2,base,exp;
int err;
if(ONE(a))
{ *ans = b;
return;
}
if(ONE(b))
{ *ans = a;
return;
}
if(ZERO(a) || ZERO(b))
{ *ans = zero;
return;
}
if(FRACTION(a) && equals(ARG(1,a),b))
{ *ans = ARG(0,a);
return;
}
if(FRACTION(b) && equals(ARG(1,b),a))
{ *ans = ARG(0,b);
return;
}
if(FUNCTOR(a) == '-' && FUNCTOR(b) == '-')
{ multmonom(ARG(0,a),ARG(0,b),ans);
return;
}
if(FUNCTOR(a) == '-' )
{ multmonom(ARG(0,a),b,&temp);
tneg(temp,ans);
return;
}
if(FUNCTOR(b) == '-' )
{ multmonom(a,ARG(0,b),&temp);
tneg(temp,ans);
return;
}
if(FUNCTOR(a) == '^' && FUNCTOR(b) == '^' && equals(ARG(0,a),ARG(0,b)))
{ base = ARG(0,a);
at(ARG(1,a),ARG(1,b),&exp);
}
else if(FUNCTOR(a) == '^' && equals(ARG(0,a),b))
{ base = b;
at(ARG(1,a),one,&exp);
}
else if(FUNCTOR(b) == '^' && equals(ARG(0,b),a))
{ base = a;
at(one,ARG(1,b),&exp);
}
else if(equals(a,b))
{ temp = make_power(a,two);
err = value(temp,&temp2);
if(err==0 || err == 2)
*ans = temp2;
else
*ans = temp;
return;
}
else
{ mt(a,b,&temp);
if(FUNCTOR(temp) == '*')
{ if(ARITY(temp) == 2 && NUMBER(ARG(0,temp)) && NUMBER(ARG(1,temp)))
{ err = value(temp,ans);
if(err != 0 && err != 2)
*ans = temp;
}
else
{ err = polyval(temp,ans);
if(err)
*ans = temp;
else
RELEASE(temp); /* mt allocated the args */
}
}
else
*ans = temp;
return;
}
err = value(exp,&temp2);
if(err == 0 || err == 2)
exp = temp2;
if(ONE(temp2))
*ans = base;
else
*ans = make_power(base,exp);
return;
}
/*_________________________________________________________________*/
int makepoly(term t, term x, POLYnomial *ans)
/* given a term t, and variable x, if possible write t as a polynomial
in x, returning in *ans a term with functor POLY whose args are the
coefficients, so t = sum of ARG(i,*ans) *x^i, and ARITY(*ans) is
one more than the degree of t. (Of course the highest coefficient
might be equal to zero, but it won't be literally zero.) Polynomials
of degree 32K or more will not be accepted.
makepoly is not supposed to do simplification. It only
converts terms from ordinary form to POLY form, inserting zero
for missing coefficients. That is, it produces polynomials in
"array representation" instead of term representation, so that
x^100 will require 101 coefficient terms instead of one.
The input term must be a sum of monomials
in x. It need not be an mvpoly, however-- factors not containing x can
be arbitrary. A term like ax + bx is acceptable; the result will be
to put (a+b) in for the coefficient of x.
Note that x has to be a variable-- you can't use this to write
t as a polynomial in (x^2 + 3) for instance.
Zero return value is success.
Return value 1 is some summand not a monomial (even with negative exponent)
or out of space (nospace is called first, but then makepoly returns 1)
Return value 2 is degree more than 32 K
Return value 3 is negative exponent in some monomial
*/
{ unsigned short n = ARITY(t);
unsigned short f = FUNCTOR(t);
term scratch, temp;
int i,err;
long max;
long *degrees; /* hold degrees of the monomials */
if(!ISATOM(x))
assert(0);
if(!contains(t,FUNCTOR(x))) /* save time and especially space on numerical terms */
{ *ans = make_term(POLY,1);
ARGREP(*ans,0,t);
return 0;
}
if(f == '+')
{ /* put monomials in scratch */
int saveit = get_polyvalfactorflag();
scratch = make_term('+',n);
degrees = (long *) callocate(n,sizeof(long));
if(!degrees)
{ nospace();
return 1;
}
set_polyvalfactorflag(0);
for(i=0;i<n; i++)
{ if(ZERO(ARG(i,t)))
{ ARGREP(scratch,i,zero); /* ignore zero terms */
degrees[i] = 0;
continue;
}
err = monomial_form(ARG(i,t),x,degrees+i,ARGPTR(scratch)+i);
if(err || degrees[i] < 0) /* illegal input */
{ free2(degrees);
RELEASE(scratch);
return (err ? 1 : 3);
}
}
/* determine degree of *ans */
max = 0;
for(i=0;i<n;i++)
{ if(max < degrees[i])
max = degrees[i];
}
/* now max is the degree */
if(max >> 15)
return 2; /* degree more than 32K not allowed */
if(max == 0)
return 1; /* it may seem that this can't happen because
t does contain x, but it may be a bound
occurrence, e.g. we get here with 2 + lim(x->0,x).
Now a logician might count that as a constant
polynomial in x, but in Mathpert, this double use
of a variable isn't allowed, so this doesn't count
as a polynomial in x. */
*ans = make_term(POLY,(unsigned short) (max+1));
for(i=0;i<=max;i++) /* initialize *ans to the zero poly */
ARGREP(*ans,i,zero);
for(i=0;i<n;i++)
{ at(ARG((unsigned)(degrees[i]),*ans),ARG(i,scratch),&temp);
/* at is in algaux.c; it adds two terms symbolically */
if(NUMBER(temp))
ARGREP(*ans,(unsigned)(degrees[i]),temp);
else
polyval(temp,ARGPTR(*ans) + (unsigned)(degrees[i]));
}
RELEASE(scratch);
free2(degrees);
/* and the simplification may have reduced the degree, so we
need to check that: */
for(i= (unsigned short) max; i>=0 && ZERO(ARG(i,*ans));i--)
;
if(i<0)
SETFUNCTOR(*ans,POLY,1);
else if(i<max)
SETFUNCTOR(*ans,POLY,i+1);
set_polyvalfactorflag(saveit);
return 0;
}
/* Now t is a monomial or illegal input */
err = monomial_form(t,x,&max,&temp);
if(err)
return 1;
if(max >= MAXDEGREE)
return 1; /* don't try to make a polynomial of degree; if max is
large enough this could cause an immediate out-of-space error, and
anyway polynomial arithmetic requires degrees < MAXDEGREE */
*ans = make_term(POLY,(unsigned short)(max+1));
for(i=0;i<max;i++) /* initialize *ans to the zero poly */
ARGREP(*ans,i,zero);
ARGREP(*ans,(unsigned short) max,temp);
return 0;
}
/*___________________________________________________________________*/
int changetopoly(term t, term *x, POLYnomial *ans)
/* convert term t to polynomial form in x, where x is
-- the eigenvariable, if it occurs in t and t is a polynomial in it;
-- otherwise the first in varlist that occurs in t such that
t is a polynomial in x */
/* return 0 for success, 1 for failure */
{ int i,err;
int nvariables = get_nvariables();
term *varlist = get_varlist();
for(i= -1;i<nvariables;i++)
{ if(i == -1)
i = get_eigenindex(); /* try the eigenvariable first */
else if(i==get_eigenindex())
continue;
if(contains(t,FUNCTOR(varlist[i])))
{ *x = varlist[i];
err = makepoly(t,*x,ans);
if(!err)
break;
}
}
if(i==nvariables)
return 1;
return 0;
}
/*___________________________________________________________________*/
int ispolyin(term t, term x)
/* is t a polynomial in x? nonpolynomial forms in other variables
or constants are allowed. Return 1 if it IS a polynomial, zero if NOT */
{ int i,err;
long deg;
term coef;
unsigned short n = ARITY(t);
if(FUNCTOR(t) != '+')
return !monomial_form(t,x,°,&coef);
for(i=0;i<n;i++)
{ err = monomial_form(ARG(i,t),x,°,&coef);
if(err)
return 0;
}
return 1;
}
/*_________________________________________________________________*/
/* The following grammar defines rational functions, polyproducts,
polypowers, and polynomial quotients (that is, rational functions in
expanded/expanded normal form)
ratfunc ::- polyprod | polyprod/polyprod
polyprod ::- polypower | product of polypowers
polypower ::- poly | poly^n (integer n)
polyquo ::- poly/poly (note, it rejects polynomials)
Note that according to this grammar, 1/((x+1)^2 + 1)
doesn't qualify as a ratfunc. We therefore use
generalized rational functions:
gpoly ::- polypower | sum or product of gpolys | power of gpolys
grat ::- gpoly | gpoly/gpoly
The following functions implement these definitions, returning
1 if the function t satisfies the definition as a function of x:
*/
int rational_function(term t, term x)
{ if(polyprod(t,x))
return 1;
if(FUNCTOR(t)!= '/')
return 0;
if(polyprod(ARG(0,t),x) && polyprod(ARG(1,t),x))
return 1;
return 0;
}
int polypower(term t, term x)
{ if(ispolyin(t,x))
return 1;
if(FUNCTOR(t) != '^')
return 0;
if(!INTEGERP(ARG(1,t)))
return 0;
if(!ispolyin(ARG(0,t),x))
return 0;
return 1;
}
int polyquo(term t, term x)
{ if(FUNCTOR(t) != '/')
return 0;
if(!ispolyin(ARG(0,t),x))
return 0;
if(!ispolyin(ARG(1,t),x))
return 0;
return 1;
}
int polyprod(term t, term x)
{ int i;
unsigned short n;
if(polypower(t,x))
return 1;
if(FUNCTOR(t) != '*')
return 0;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(!polypower(ARG(i,t),x))
return 0;
}
return 1;
}
int gpoly(term t, term x)
{ int i;
unsigned short n;
unsigned short f = FUNCTOR(t);
if(polypower(t,x))
return 1;
if(f == '^')
{ if(INTEGERP(ARG(1,t)) && gpoly(ARG(0,t),x))
return 1;
return 0;
}
if(f != '+' && f != '*')
return 0;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(!gpoly(ARG(i,t),x))
return 0;
}
return 1;
}
int grat(term t, term x)
{ if(gpoly(t,x))
return 1;
if(FUNCTOR(t)!= '/')
return 0;
if(gpoly(ARG(0,t),x) && gpoly(ARG(1,t),x))
return 1;
return 0;
}
/*___________________________________________________________________*/
int monomial_form(term t, term x, long *degree, term *coef)
/* if t is a monomial in x, return the degree and the coefficient.
Zero return value is success. Exponents must be specific positive
integers, x^n will not count even if n>0 could be inferred.
Return 0 for success, 1 for failure.
Also accepts something of the form ax^n/b, returning (a/b) for
the coefficient, if a and b don't depend on x.
*/
{ term temp,power;
int i,j,err;
unsigned short n = ARITY(t);
set_types(&t); /* set the type info correctly on negatives and
on rational numbers contained in t.
This way the coefficients returned will carry
correct type info and cmult etc will work on
them when matrix routines are called.
*/
if(!depends(t,x)) /* constant */
{ *coef = t;
*degree = 0;
return 0;
}
if(!contains(t,FUNCTOR(x))) /* but t depends on x nevertheless, e.g. in
differentiation when user has said y depends on x */
return 1;
if(equals(t,x))
{ *coef = one;
*degree = 1;
return 0;
}
if(ATOMIC(t)) /* and not equal to x, but depends on x */
return 1;
if(FUNCTOR(t)== '-')
{ if(monomial_form(ARG(0,t),x,degree,&temp))
return 1;
*coef = tnegate(temp);
return 0;
}
if(FUNCTOR(t) == '^' && equals(ARG(0,t),x) )
{ power = ARG(1,t);
if(ISINTEGER(power))
{ *degree = INTDATA(power);
*coef = one;
return 0;
}
return 1; /* bignum or non-atomic symbolic exponent unacceptable */
}
if(FUNCTOR(t) == '*')
{ for(i=0;i<n;i++)
{ if(contains(ARG(i,t),FUNCTOR(x)))
break;
}
assert(i < n); /* otherwise first clause would have worked */
for(j=i+1;j<n;j++)
{ if(contains(ARG(j,t),FUNCTOR(x)))
return 1; /* only one factor is allowed to contain x */
}
temp = ARG(i,t);
if(equals(temp,x))
*degree = 1;
else if(FUNCTOR(temp) == '^' &&
ISINTEGER(ARG(1,temp)) &&
equals(x,ARG(0,temp))
)
*degree = INTDATA(ARG(1,temp));
else
return 1;
if(n == 2)
*coef = ( i ? ARG(0,t) : ARG(1,t));
else /* n > 2 */
{ *coef = make_term('*',(unsigned short)(n-1));
for(j=0;j<i;j++)
ARGREP(*coef,j,ARG(j,t));
for(j=i+1;j<n;j++)
ARGREP(*coef,j-1,ARG(j,t));
}
return 0;
}
if(FRACTION(t) && !depends(ARG(1,t),x))
/* example: x^2/2 is a monomial with coefficient (1/2) */
{ err = monomial_form(ARG(0,t),x,degree,&temp);
if(err)
return 1;
*coef = make_fraction(temp,ARG(1,t));
return 0;
}
return 1; /* illegal functor */
}
/*___________________________________________________________________*/
POLYnomial polyadd(POLYnomial a, POLYnomial b)
/* a and b are POLYnomials. Return their sum as a POLYnomial */
{ int i;
term ans;
unsigned short n; /* arity of *ans */
n = (ARITY(a) < ARITY(b) ? ARITY(b) : ARITY(a) ); /* maximum of input arities */
ans = make_term(POLY,n);
for(i=0;i<n;i++)
{ /* add the corresponding coefficients */
if(i >= ARITY(a))
ARGREP(ans,i,ARG(i,b));
else if(i >= ARITY(b))
ARGREP(ans,i,ARG(i,a));
else
addmonom(ARG(i,a),ARG(i,b),ARGPTR(ans) + i);
}
/* check the degree; it can be smaller! */
for(i=n-1;i>=0;i--)
{ if(!ZERO(ARG(i,ans)))
break;
}
if(i<0) /* all coefficients were zero */
{ RELEASE(ans);
ans = make_term(POLY,1);
ARGREP(ans,0,zero);
}
else if(i < n-1) /* some coefficient(s) were zero */
SETFUNCTOR(ans,POLY,i+1);
return ans;
}
/*____________________________________________________________________*/
POLYnomial polysub(POLYnomial a, POLYnomial b)
/* a and b are POLYnomials. Return a-b */
{ term ans,temp;
temp = polystrongneg(b); /* not polyneg, so as to avoid coefficients
like (u+v) -(u+v) */
ans = polyadd(a,temp);
RELEASE(temp);
return ans;
}
/*_____________________________________________________________________*/
int polymult(POLYnomial a, POLYnomial b, POLYnomial *ans)
/* a and b are POLYnomials. Return their product in *ans */
/* Zero return value is success */
/* Return value 1 is degree too large */
/* save_and_reset is used to reduce quadratic space use to linear */
{ long k;
unsigned short n,na,nb;
term temp,prod,temp2;
int i,j,startindex,endindex;
void *savenode;
assert(FUNCTOR(a) == POLY);
assert(FUNCTOR(b) == POLY);
if(UNITPOLY(a))
{ *ans = b;
return 0;
}
if(UNITPOLY(b))
{ *ans = a;
return 0;
}
na = ARITY(a);
nb = ARITY(b);
k = na+nb-1; /* arity of product = sum of degrees plus one */
if(k >> 8) /* only 8 bytes for the degree! max allowed is 256 */
return 1;
n = (unsigned short) k;
*ans = make_term(POLY,n);
/* Now compute the coefficients */
for(i=0;i<n;i++)
{ temp = zero;
startindex = i-nb+1;
if(startindex < 0)
startindex = 0;
endindex = i<=na-1 ? i : na-1;
savenode = heapmax();
for(j=startindex; j<=endindex;j++)
{ if(!ZERO(ARG(j,a)) && !ZERO(ARG(i-j,b))) /* for efficiency */
{ multmonom(ARG(j,a),ARG(i-j,b),&prod);
addmonom(temp,prod,&temp2);
temp = temp2;
}
}
save_and_reset(temp,savenode,ARGPTR(*ans)+i);
/* ARGREP(*ans,i,temp); done by save_and_reset now */
}
// if some leading coefficients are zero then decrease arity
for(i=n-1; i > 0; i--)
{ if(!ZERO(ARG(i,*ans)))
break;
}
if(i < n-1)
SETFUNCTOR(*ans,POLY,i+1);
return 0;
}
/*___________________________________________________________________*/
POLYnomial polyneg(POLYnomial v)
/* p is a POLYnomial; negate it */
{ term ans;
int i;
unsigned short n = ARITY(v);
ans =make_term(POLY,n);
for(i=0;i<n;i++)
tneg(ARG(i,v),ARGPTR(ans)+i);
return ans;
}
/*___________________________________________________________________*/
static POLYnomial polystrongneg(POLYnomial v)
/* p is a POLYnomial; strongnegate the coefficients */
/* example, (a+b)x + c becomes (-a-b)x + c, while
with polyneg it becomes (-(a+b))x + c */
{ term ans;
int i;
unsigned short n = ARITY(v);
ans =make_term(POLY,n);
for(i=0;i<n;i++)
ARGREP(ans,i,strongnegate(ARG(i,v)));
return ans;
}
/*___________________________________________________________________*/
/* polynomial pseudodivision */
/* Algorithm R, Knuth volume2, p. 407 */
void pseudodiv(POLYnomial u, POLYnomial v, POLYnomial *q, POLYnomial *r, term *cc)
/* pseudodivide u (of degree m) by v (of degree n, leading coef c)
getting quotient *q and remainder *r */
/* such that c^(m-n+1) u = qv + r */
/* return *cc = c^(m-n+1) if m >=n; or if this is numerical, return its value */
/* if m < n set *cc = one */
/* u, v, *q, *r are POLYnomials, but *cc is an ordinary term */
/* *q, *r, *cc are returned in fresh space (not overlapping the args) so
they can be destroyed if desired */
{ unsigned short m,n;
aflag arithflag = get_arithflag();
aflag saveit = arithflag;
term *workspace,*cpowers;
term workterm, stashit;
term c,temp,temp2,temp3;
term localv; /* a copy of v in fresh space */
void *savenode = heapmax();
void *marker;
int i,j,k,kk,err;
arithflag.intexp = arithflag.ratexp = arithflag.negexp = arithflag.fract =
arithflag.varadd = 1;
set_arithflag(arithflag); /* prevent getting a remainder of 2^2 - 4 instead of 0 */
assert(FUNCTOR(u)==POLY);
assert(FUNCTOR(v)==POLY);
assert(ARITY(u) > 0);
assert(ARITY(v) > 0);
m = ARITY(u)-1; /* degree of u */
n = ARITY(v)-1; /* degree of v */
if (m < n)
{ copy(u,r); /* return in fresh space */
*q = make_term(POLY,1);
ARGREP(*q,0,zero); /* *q is the zero polynomial */
*cc = one;
return;
}
copy(v,&localv); /* fresh space */
workterm = make_term(AND,(unsigned short)(m+1));
workspace = ARGPTR(workterm);
*q = make_term(POLY,(unsigned short)(m-n+1));
copy(ARG(n,v),&c); /* so c uses fresh space */
if(!ONE(c))
{ cpowers = (term *) callocate(m-n+2,sizeof(term));
if(cpowers==0)
{ nospace();
SETFUNCTOR(*q,ILLEGAL,0); /* signal space failure */
set_arithflag(saveit);
return;
}
cpowers[0] = one;
for(i=1;i<=m-n+1;i++) /* cpowers[i] = c^i */
multmonom(c,cpowers[i-1],cpowers + i);
}
/* therefore cpowers uses all fresh space (though there is sharing) */
for(i=0;i<=m;i++)
copy(ARG(i,u),workspace + i); /* workspace is all fresh space */
if(ONE(c)) /* dividing by a monic polynomial is simpler */
{ for(k=m-n; k>=0; k--) /* Step R1 in Knuth */
{ ARGREP(*q,k,workspace[n+k]); /* all fresh space since workspace is fresh */
for(j=n+k-1;j>=k;j--) /* Step R2 in Knuth */
{ multmonom(workspace[n+k],ARG(j-k,localv),&temp2);
addmonom(workspace[j],strongnegate(temp2),&temp);
workspace[j] = temp;
/* addmonom already calls polyval on temp, which is
needed since if additional variables are present
you can create coefficients like y+0-y,
which should be simplified to zero.
*/
}
}
}
else /* it wasn't monic */
{ for(k=m-n; k>=0; k--) /* Step R1 in Knuth */
{ multmonom(workspace[n+k],cpowers[k],ARGPTR(*q)+k);
/* *q is in fresh space since cpowers and workspace are in fresh space */
marker = heapmax();
for(j=n+k-1;j>=0;j--) /* Step R2 in Knuth */
{ multmonom(workspace[j],c,&temp);
if(j>=k)
{ multmonom(workspace[n+k],ARG(j-k,localv),&temp2);
addmonom(temp,strongnegate(temp2),&temp3);
polyval(temp3,workspace + j);
}
else
copy(temp,workspace+j);
}
/* The j-loop has updated workspace. Recover any heap
space that was allocated and not freed in so doing.
*/
save_and_reset(workterm,marker,&stashit);
for(kk=0;kk<m+1;kk++)
workspace[kk] = ARG(kk,stashit);
RELEASE(stashit); /* made by save_and_reset */
}
}
/* Now workspace holds the remainder */
/* first call polyval to simplify any non-zero coefficients */
for(i = n-1;i>=0;i--)
{ if(!NUMBER(workspace[i]))
{ err = polyval(workspace[i],&temp);
if(!err)
workspace[i] = temp;
}
}
/* Now find its degree */
for(i = n-1;i>=0;i--)
{ if(!ZERO(workspace[i]))
break;
}
if( i<0 ) /* zero remainder */
{ *r = make_term(POLY,1);
ARGREP(*r,0,zero);
}
else
{ *r = make_term(POLY,(unsigned short)(i+1));
for(j=0;j<=i;j++)
ARGREP(*r,j,workspace[j]);
}
free2(workspace);
if(!ONE(c))
{ err = value(cpowers[m-n+1],cc);
if(err==1)
*cc = cpowers[m-n+1];
free2(cpowers);
}
else
*cc = one;
/* Now for the final memory management: release all heap space
used for the computations. */
temp = and3(*q,*r,*cc);
save_and_reset(temp,savenode,&temp);
*q = ARG(0,temp);
*r = ARG(1,temp);
*cc = ARG(2,temp);
RELEASE(temp); /* made by save_and_reset */
set_arithflag(saveit);
}
/*______________________________________________________________________*/
int polydiv(term x, term u, term v, term *q, term *r)
/* u,v are ordinary terms, not POLY terms */
/* convert them to polynomials in x if possible and
divide, returning quotient and remainder.
Use pseudodiv for efficiency */
/* Zero return is success*/
/* Nonzero return means u or v wasn't a polynomial in x */
{ int err;
term a,b,qq,rr,cc,junk;
err = makepoly(u,x,&a);
if(err)
return 1;
err = makepoly(v,x,&b);
if(err)
return 1;
pseudodiv(a,b,&qq,&rr,&cc);
RELEASE(a);
RELEASE(b);
if(FUNCTOR(qq) == ILLEGAL)
return 1; /* out of space in pseudodiv */
if(ONE(cc))
{ *q = poly_term(qq,x);
*r = poly_term(rr,x);
return 0;
}
a = poly_term(qq,x); /* re-using a for a different purpose */
if(NEGATIVE(cc))
{ a = strongnegate(a);
cc = ARG(0,cc);
rr = polyneg(rr);
}
RELEASE(qq); /* made by pseudodiv above */
err = cancel(a,cc,&junk,q);
if(err) /* no cancellation */
*q = product(reciprocal(cc),a);
if(ARITY(rr)==1 && equals(ARG(0,rr),zero))
*r = zero;
else
{ b=poly_term(rr,x);
err = cancel(b,cc,&junk,r);
if(err)
*r = product(reciprocal(cc),b);
}
RELEASE(rr); /* made by pseudodiv above */
err = cancel(a,cc,&junk,q);
if(err) /* no cancellation */
*q = make_fraction(a,cc);
return 0;
}
/*______________________________________________________________________*/
term poly_term(POLYnomial p, term x)
/* convert POLYnomial p to ordinary term *ans, using the
variable x as indeterminate */
/* return *ans in ascending or descending order according to the
value of global variable 'orderflag' */
{ unsigned short count = 0;
term ans;
unsigned short n = ARITY(p);
int i,j,k;
term u;
/* count the non-zero terms */
for(i=0;i<n;i++)
{ if(!ZERO(ARG(i,p)))
++count;
}
if(FUNCTOR(ARG(0,p))=='+') /* constant term can be a sum */
{ count += ARITY(ARG(0,p)) - 1;
}
if(count > 1)
{ ans = make_term('+',count);
k=0;
if(get_orderflag()==ASCENDING)
{ if(FUNCTOR(ARG(0,p))=='+')
{ u = ARG(0,p);
for(j=0;j<ARITY(u);j++)
{ ARGREP(ans,k,ARG(j,u));
++k;
}
}
else if(!ZERO(ARG(0,p)))
{ ARGREP(ans,k,ARG(0,p));
++k;
}
for(i=1;i<n;i++)
{ if(!ZERO(ARG(i,p)))
{ ARGREP(ans,k,make_monomial(x,i,ARG(i,p)));
++k;
}
}
}
else
{ for(i=n-1;i>0;i--)
{ if(!ZERO(ARG(i,p)))
{ ARGREP(ans,k,make_monomial(x,i,ARG(i,p)));
++k;
}
}
if(FUNCTOR(ARG(0,p)) == '+')
{ u = ARG(0,p);
for(j=0;j<ARITY(u);j++)
{ ARGREP(ans,k,ARG(j,u));
++k;
}
}
else if(!ZERO(ARG(0,p)))
{ ARGREP(ans,k,ARG(0,p));
++k;
}
}
assert(k==count);
}
else if(count==1)
{ for(i=0;i<n;i++)
if(!ZERO(ARG(i,p))) break;
assert(i<n);
ans = make_monomial(x,i,ARG(i,p));
}
else
{ assert(count==0);
ans = zero;
}
return ans;
}
/*______________________________________________________________________*/
static term make_monomial(term x, int n, term u)
/* x is an atom; u is a term which was an arg of a POLYnomial */
/* return the monomial of degree n in x with coefficient u */
/* Normally it's not called if u is zero, so we don't try to save
time by checking that first; mt will work ok if u does happen to be zero */
{ term ans;
if(n==0)
return u;
if(n==1)
{ mt(u,x,&ans);
return ans;
}
mt(u,make_power(x,make_int(n)),&ans);
return ans;
}
/*______________________________________________________________________*/
int pp(POLYnomial e, term *content, POLYnomial *pp)
/* extract the content and principal part of a nonzero POLYnomial e; */
/* return zero if the content is not 1, 1 if it is 1 */
/* gcd computations on the coefficients are done by polygcd */
/* on failure, still sets *pp = e and *content = one */
/* The content of a constant polynomial is the coefficient. */
{ term temp,p,u; /* workspace */
int i,err;
unsigned short n = ARITY(e); /* degree + 1 */
assert(FUNCTOR(e)==POLY);
if(ALREADY(e)) /* already been through pp */
{ *content = one;
*pp = e;
return 1;
}
if(n == 1)
{ *content = ARG(0,e);
*pp = make_term(POLY,1);
ARGREP(*pp,0,one);
return ONE(*content) ? 1 : 0;
}
err = listpolygcd(ARGPTR(e),ARITY(e),content);
if(err || ONE(*content))
goto fail;
*pp = make_term(POLY,n);
for(i=0;i<n;i++)
{ u = ARG(i,e);
if(ZERO(u))
{ ARGREP(*pp,i,zero);
continue;
}
err = cancel(u,*content,&temp,ARGPTR(*pp)+i);
/* cancel can fail; example: content is (y-2c) and u = xy -2cx,
where the eigenvariable is another variable a; or for an even
simpler example, (-3r-9)/(r+3). But when it works it will be
faster than what follows. */
if(err)
{ polydiv(gcdvar,ARG(i,e),*content,&p,&temp);
assert(ZERO(temp));
/* if cancel failed, it's only because listpolygcd was
used above, and then polygcd set gcdvar */
polyval(p,ARGPTR(*pp)+i); /* it may require simplification */
}
}
SET_ALREADY(*pp); /* mark it as primitive */
return 0;
fail:
*pp = e;
*content = one; /* e is local so SET_ALREADY(e) would be wasted */
return 1;
}
/*______________________________________________________________________*/
POLYnomial multpolybyconstant(term c, POLYnomial p)
/* multiply POLYnomial p by constant c */
{ term ans;
unsigned short n = ARITY(p);
int i;
assert(FUNCTOR(p)==POLY);
ans = make_term(POLY,n);
for(i=0;i<n;i++)
multmonom(c,ARG(i,p),ARGPTR(ans)+i);
return ans;
}
/*______________________________________________________________________*/
int polygcd(term u, term v, term *ans)
/* zero return is success */
/* polymorphic gcd; works on integers, bignums, rationals,
whether positive or negative, on POLYnomials, and on general terms
(monomials or sums) if
these can be converted to polynomials in the same variable.
(it works on two terms, or two POLY's, but not on a general term and a POLY).
If u and v are both POLY's,
or if one is a POLY and one is a number, then *ans is returned as a
POLY, except if it would be of degree 0, in which case it is returned
as a "constant" (non-POLY term). So you have to be careful not to
enter the result of polygcd into POLY arithmetic routines without
checking that it is a POLY. If u and v are both sums or monomials
(external polynomials) it returns an external polynomial answer. */
/* Doesn't work on products, except in case they contain
an explicit common factor and after that is cancelled they are sums
or monomials */
{ int err;
term trash,temp;
if(ISZERO(u))
{ *ans = v;
return 0;
}
if(ISZERO(v))
{ *ans = u;
return 0;
}
if(ONE(u) || ONE(v)) /* catch these two common cases for speed */
{ *ans = one;
return 0;
}
if(ISATOM(u) && !contains(v,FUNCTOR(u)))
{ *ans = one;
return 0;
}
if(ISATOM(v) && !contains(u,FUNCTOR(v)))
{ *ans = one;
return 0;
}
if(FUNCTOR(u)=='-')
{ if(FUNCTOR(v) == '-')
return polygcd(ARG(0,u),ARG(0,v),ans);
return polygcd(ARG(0,u),v,ans);
}
if(FUNCTOR(v)=='-')
return polygcd(u,ARG(0,v),ans);
if(INTEGERP(u) && INTEGERP(v))
return gcd(u,v,ans); /* in file arith.c */
if((RATIONALP(u) && INTEGERP(v)) || (INTEGERP(u) && RATIONALP(v)))
{ ratgcd(u,v,ans); /* file cancel.c */
return 0;
}
if(FUNCTOR(v)==POLY && (INTEGERP(u) || RATIONALP(u)))
{ *ans = u;
return 0;
}
if(FUNCTOR(u)==POLY && (INTEGERP(v) || RATIONALP(v)))
{ *ans = v;
return 0;
}
if(FUNCTOR(u) == '^' && ISATOM(ARG(0,u))) /* trap these cases which
are used by polydiv_test */
{ if(ZERO(ARG(1,u)))
{ *ans = one;
return 0;
}
if(ONE(ARG(1,u)))
return polygcd(ARG(0,u),v,ans);
}
if(FUNCTOR(v) == '^' && ISATOM(ARG(0,v)))
{ if(ZERO(ARG(1,v)))
{ *ans = one;
return 0;
}
if(ONE(ARG(1,v)))
return polygcd(u,ARG(0,v),ans);
}
if(FUNCTOR(u) != POLY && FUNCTOR(v) != POLY)
{ term u1,v1,x,qq;
/* They may possibly contain an explicit common factor; let's
get that out first */
if(FUNCTOR(u) != '+' || FUNCTOR(v) != '+')
naive_gcd(u,v,&qq);
else qq = one; /* save calling overlaid naive_gcd if not necessary */
if(!ONE(qq))
{ cancel(u,qq,&trash,&u1);
cancel(v,qq,&trash,&v1);
u = u1;
v = v1;
if(ONE(u1) || ONE(v1)) /* common case, speed up */
{ *ans = qq;
return 0;
}
if(!contains(u,'+') || !contains(v,'+')) /* e.g, monomials */
{ *ans = qq;
return 0;
}
}
if(FUNCTOR(u) == '*')
/* pp calls it on the coefficients of a polynomial.
Those coefficients might be products, so it has
to work on products too */
{ term p,q,r;
if(ARITY(u) > 2)
goto fail;
err = polygcd(ARG(0,u),v,&p);
if(err)
goto fail;
err = polygcd(ARG(1,u),v,&q);
if(err)
goto fail;
err = polygcd(p,q,&r);
if(err)
goto fail;
polyval(make_fraction(product(p,q),r),ans);
return 0;
}
if(FUNCTOR(v) == '*')
{ term p,q,r;
if(ARITY(v) > 2)
goto fail;
err = polygcd(u,ARG(0,v),&p);
if(err)
goto fail;
err = polygcd(u,ARG(1,v),&q);
if(err)
goto fail;
err = polygcd(p,q,&r);
if(err)
goto fail;
polyval(make_fraction(product(p,q),r),ans);
return 0;
}
/* write u and v as polynomials in the first variable
(starting with the eigenvariable)
which they both contain in which this can be done
and they have a nontrivial gcd, temp */
err = twopolys(u,v,&x,&u1,&v1,&temp);
if(err)
goto fail;
gcdvar = x; /* stash it here for cancelgcd_aux to use */
if(ONE(qq))
{ *ans = poly_term(temp,x);
return 0;
}
else
{ polyval(product(qq,poly_term(temp,x)),ans);
return 0;
}
}
if(FUNCTOR(u) == POLY && FUNCTOR(v) != POLY)
return 1;
if(FUNCTOR(v) == POLY && FUNCTOR(u) != POLY)
return 1;
if(FUNCTOR(u)==POLY && FUNCTOR(v)==POLY)
{ *ans = polynomial_gcd(u,v);
return 0;
}
fail:
*ans = one;
return 1;
}
/*__________________________________________________________________*/
POLYnomial polynomial_gcd(POLYnomial u,POLYnomial v)
/* public gcd algorithm. It uses subresultant_gcd.
The returned gcd should not have a negative leading coefficient.
If it runs out of space, it returns ans as an ILLEGAL term
instead of a POLYnomial.
*/
{ term ans;
int i;
unsigned short n;
void *savenode = heapmax();
assert(FUNCTOR(u)==POLY && FUNCTOR(v)==POLY);
subresultant_gcd(u,v,&ans);
if(FUNCTOR(ans) == ILLEGAL)
{ /* out of space in subresultant_gcd */
SETFUNCTOR(ans,ILLEGAL,0);
reset_heap(savenode);
return ans;
}
save_and_reset(ans,savenode,&ans);
n = ARITY(ans);
/* The gcd is defined up to a unit, in this case plus or minus 1.
But now we still have to prevent some silly signs in
the answer. Return a positive leading coefficient
if n > 2, and if n > 2 at least don't return
an answer with all negative signs.
*/
if(n == 1)
return ans;
if(n == 2)
{ if(NEGATIVE(ARG(0,ans)) && NEGATIVE(ARG(1,ans)))
{ for(i=0;i<2;i++)
ARGREP(ans,i,ARG(0,ARG(i,ans)));
}
return ans;
}
if(n != ARITY(u) && n != ARITY(v))
return ans;
if(NEGATIVE(ARG(n-1,ans)))
{ for(i=0;i<n;i++)
ARGREP(ans,i,tnegate(ARG(i,ans)));
}
return ans;
}
/*__________________________________________________________________*/
static void subresultant_gcd(POLYnomial u, POLYnomial v, POLYnomial *ans)
/* see page 410 Knuth volume 2 for the algorithm */
/* u and v must be POLY terms. Return the gcd in *ans, as a POLY term. */
/* Memory management added because without it, this can use up more than
32 K on two degree 7 polynomials.
*/
{ term contentu,principalpartu,contentv,principalpartv,temp,trash,c;
int i,err,err2;
unsigned short n;
unsigned long nbytes;
term delta;
long *deltaval;
term q,r,cc,g,h;
void *savenode = heapmax();
if(ARITY(u) == 1 && ZERO(ARG(0,u)))
{ *ans = v;
return;
}
if(ARITY(v) == 1 && ZERO(ARG(0,v)))
{ *ans = u;
return;
}
if(ARITY(u) > 10)
{ /* check if we're close to running out of heap space */
nbytes = mycoreleft();
if(nbytes < 24576) /* less than 24K left */
/* don't risk running out of space */
{ SETFUNCTOR(*ans,ILLEGAL,0);
return;
}
}
err = pp(u,&contentu,&principalpartu);
if(err) /* contentu was trivial */
{ contentu = one;
SET_ALREADY(u); /* mark it as primitive */
}
err2 = pp(v,&contentv,&principalpartv);
if( err2) /* contentv was trivial */
{ contentv = one;
SET_ALREADY(v);
}
if(!err || !err2)
{ subresultant_gcd(principalpartu,principalpartv,&temp);
if(INTEGERP(contentu) && INTEGERP(contentv)) /* very common case */
gcd(contentu,contentv,&c);
else
polygcd(contentu,contentv,&c);
if(ONE(c))
*ans = temp;
else
*ans = multpolybyconstant(c,temp);
save_and_reset(*ans,savenode,ans);
return;
}
/* Now u and v are primitive */
if(ARITY(v) > ARITY(u))
{ subresultant_gcd(v,u,ans); /* swap args */
save_and_reset(*ans,savenode,ans);
return;
}
g = h = one; /* Step C1 in Knuth */
/* we are going to alter the args of v so we need to copy it first */
copy(v,&temp);
v = temp; /* the local v now points into all new space so the copy of
v in the calling environment can't be disturbed */
delta = make_int(100L); /* create space at *(delta.args) */
/* 100 > MAXCONSTANTINT is the point,
so new space will be allocated here */
KILLARGS(delta); /* make sure destroy_term won't try to free
the args of delta. We will be making terms
that contain more than one copy of delta
below */
deltaval = (long *) (delta.args);
while(1) /* loop terminated only by return */
{ *deltaval = ARITY(u)-ARITY(v); /* change value of delta without
allocating new space */
pseudodiv(u,v,&q,&r,&cc); /* Step C2 in Knuth */
if(FUNCTOR(q) == ILLEGAL)
{ /* out of space in pseudodiv */
SETFUNCTOR(*ans,ILLEGAL,0);
return;
}
if(ARITY(r)==1) /* zero or constant */
{ if(ZERO(ARG(0,r))) /* zero */
{ err = pp(v,&c,ans); /* Step C4, take out the content */
if(err) /* assume the content was one */
{ *ans = v;
SET_ALREADY(*ans);
}
save_and_reset(*ans,savenode,ans);
return;
}
reset_heap(savenode);
*ans = make_term(POLY,1);
ARGREP(*ans,0,one);
return;
}
/* not yet done, go on to Step C3 in Knuth */
u = v;
v = r;
n = ARITY(v);
temp=product(g, make_power(h,delta));
err= value(temp,&c);
if(err == 1)
c = temp;
if(! ONE(c))
{ for(i=0;i<n;i++)
{ if(ZERO(ARG(i,v)))
ARGREP(v,i,zero);
else
{ cancel(ARG(i,v),c,&trash,&temp);
ARGREP(v,i,temp);
}
}
}
/* next reset g and h */
g = ARG(ARITY(u)-1,u); /* leading coefficient of u */
if(ONE(delta))
h = g;
else if(!ZERO(delta))
{ temp = make_fraction(make_power(g,delta),make_power(h,sum(delta,tnegate(one))));
err = value(temp,&h);
if(err==1)
h = temp;
}
} /* end of while-loop */
}
/*______________________________________________________________*/
int cancelgcd_aux(term num, term denom, term *num2, term *denom2)
/* num and denom are sums, or powers of sums.
If they have a nontrivial polygcd, factor it out
of num and denom and return in *num2 and *denom2 factored forms of num and denom.
Return 0 for success.
Actually, if pseudodiv produces a nonzero *cc factor, the answers *num2
and *denom2 can come out both multiplied by a 'constant' factor.
*/
{ term num1,denom1,common,common2,trash,x,temp,cc,dd,cancelled,qq;
POLYnomial num1poly,denom1poly,commonpoly,numpoly,denompoly;
int err,err2,saveit;
int nsign=1,dsign=1;
if(eqtest(num,denom))
return 1;
if(!contains(num,'^') && !contains(denom,'^'))
{ /* Two linear polynomials can still contain a constant factor */
err = content_factor(num,&cc,&common);
if(err)
{ cc = one;
common = num;
}
err2 = content_factor(denom,&dd,&temp);
if(err && err2)
return 1;
if(err2)
{ temp = denom;
dd = one;
}
if(!equals(temp,common))
return 1;
*num2 = product(cc,common);
*denom2 = product(dd,temp);
return 0;
}
if(FUNCTOR(num) == '^' && INTEGERP(ARG(1,num)) && FUNCTOR(ARG(0,num)) == '+')
{ err = cancelgcd_aux(ARG(0,num),denom,&temp,denom2);
if(err)
return 1;
*num2 = make_power(temp,ARG(1,num));
return 0;
}
if(FUNCTOR(denom) == '^' && INTEGERP(ARG(1,denom)) && FUNCTOR(ARG(0,denom)) == '+')
{ err = cancelgcd_aux(num,ARG(0,denom),num2,&temp);
if(err)
return 1;
*denom2 = make_power(temp,ARG(1,denom));
return 0;
}
if(FUNCTOR(num) != '+' || FUNCTOR(denom) != '+')
return 1;
saveit = get_orderflag();
if(constant(ARG(0,num)) && constant(ARG(0,denom)))
set_orderflag(ASCENDING);
/* Now, we have to choose a variable and convert num and denom
to polynomials in that variable, that have a common gcd */
err = twopolys(num,denom,&x,&numpoly,&denompoly,&commonpoly);
if(err) /* then try for trig polynomials */
err = twotrigpolys(num,denom,&x,&numpoly,&denompoly,&commonpoly);
if(err) /* example: [y + y sin^2(xy)]/(1+sin^2(xy)) */
{ int err2;
set_orderflag(saveit);
err = contentfactor_pval(num,num2);
err2 = contentfactor_pval(denom,denom2);
if(err && err2)
return 1; /* failure */
if(err)
*num2 = num;
if(err2)
*denom2 = denom;
err = cancel(*num2,*denom2,&trash,&temp);
if(!err)
{ set_orderflag(saveit);
return 0;
}
set_orderflag(saveit);
return 1;
}
if(equals(numpoly,commonpoly))
{ pseudodiv(denompoly,commonpoly,&denom1poly,&trash,&dd);
if(FUNCTOR(denom1poly) == ILLEGAL)
return 1; /* out of space in pseudodiv */
num1 = dd;
denom1 = poly_term(denom1poly,x);
err = cancel(num1,denom1,&trash,&temp);
if(!err)
{ if(FRACTION(temp))
{ num1 = ARG(0,temp);
denom1 = ARG(1,temp);
}
else
{ num1 = temp;
denom1 = one;
}
}
}
else if(equals(denompoly,commonpoly))
{ pseudodiv(numpoly,commonpoly,&num1poly,&trash,&cc);
if(FUNCTOR(num1poly)==ILLEGAL)
return 1; /* out of space in pseudodiv */
denom1 = cc;
num1 = poly_term(num1poly,x);
err = cancel(num1,denom1,&trash,&temp);
if(!err)
{ if(FRACTION(temp))
{ num1 = ARG(0,temp);
denom1 = ARG(1,temp);
}
else
{ num1 = temp;
denom1 = one;
}
}
}
else
{ pseudodiv(numpoly,commonpoly,&num1poly,&trash,&cc);
/* numpoly / commonpoly = num1poly/cc ; something may
still cancel out of the right-hand side, and if we don't
cancel it, we get ridiculous-looking results. */
if(FUNCTOR(num1poly)==ILLEGAL)
{ set_orderflag(saveit);
return 1; /* out of space in pseudodiv */
}
temp = poly_term(num1poly,x);
if(NEGATIVE(cc) && FUNCTOR(temp) == '+' && NEGATIVE(ARG(0,temp)))
/* example: see NEGATIVE(dd) below */
{ cc = ARG(0,cc);
temp = strongnegate(temp);
}
if(NEGATIVE(cc))
{ nsign = -1;
cc = ARG(0,cc);
}
if(ONE(cc))
num1 = temp;
else
{ err = cancel(temp,cc,&cancelled,&num1);
if(err)
num1 = product(reciprocal(cc),temp);
else
{ err = cancel(cc,cancelled,&trash,&temp);
assert(!err);
cc = temp;
num1 = product(reciprocal(cc),num1);
}
}
pseudodiv(denompoly,commonpoly,&denom1poly,&trash,&dd);
if(FUNCTOR(denom1poly)==ILLEGAL)
return 1; /* out of space in pseudodiv */
temp = poly_term(denom1poly,x);
if(NEGATIVE(dd) && FUNCTOR(temp) == '+' && NEGATIVE(ARG(0,temp)))
/* example: dd is -1 and temp is -1-cos x */
/* so change temp to 1+cos x and dd to 1 */
/* to prevent getting -(-1-cos x) in the denom */
{ dd = ARG(0,dd);
temp = strongnegate(temp);
}
if(NEGATIVE(dd))
{ dsign = -1;
dd = ARG(0,dd);
}
if(ONE(dd))
denom1=temp;
else
{ err = cancel(temp,dd,&cancelled,&denom1);
if(err)
denom1 = product(reciprocal(dd),temp);
else
{ err = cancel(dd,cancelled,&trash,&temp);
assert(!err);
dd = temp;
denom1 = product(reciprocal(dd),denom1);
}
}
}
if(FUNCTOR(num1) == '*')
sortargs(num1);
if(FUNCTOR(denom1) == '*')
sortargs(denom1);
common = poly_term(commonpoly,x);
if(FUNCTOR(common) == '+')
additive_sortargs(common);
if(FUNCTOR(num1) == '+')
additive_sortargs(num1);
if(FUNCTOR(denom1) == '+')
additive_sortargs(denom1);
*num2 = specialproduct(common,num1);
if(nsign == -1)
{ /* instead of -(a-b)u, return (b-a)u */
*num2 = special_negate(*num2);
if(FUNCTOR(*num2) == '+')
additive_sortargs(*num2);
}
if(NEGATIVE(*num2) && FUNCTOR(ARG(0,*num2)) == '*' &&
FUNCTOR(ARG(0,ARG(0,*num2))) == '+' &&
ARITY(ARG(0,ARG(0,*num2))) == 2 &&
NEGATIVE(ARG(1,ARG(0,ARG(0,*num2))))
)
*num2 = special_negate(ARG(0,*num2));
if(NEGATIVE(*num2) && FUNCTOR(ARG(0,*num2)) == '+' &&
ARITY(ARG(0,*num2)) == 2 &&
NEGATIVE(ARG(1,ARG(0,*num2)))
)
*num2 = sum(ARG(0,ARG(1,ARG(0,*num2))),tnegate(ARG(0,ARG(0,*num2))));
if(FUNCTOR(*num2) == '*')
{ polyval(*num2,&qq); /* collect powers and order factors */
*num2 = qq;
HIGHLIGHT(*num2);
}
else if(NEGATIVE(*num2) && FUNCTOR(ARG(0,*num2)) == '*')
{ polyval(*num2,&qq);
*num2 = qq;
HIGHLIGHT(*num2);
}
copy(common,&common2);
/* we need disjoint copies to put in the num and denom, so that
destroy_term won't crash on the result. Never create DAGs. */
*denom2 = specialproduct(common2,denom1);
if(dsign == -1)
{ *denom2 = strongnegate(*denom2);
if(FUNCTOR(*denom2) == '+')
additive_sortargs(*denom2);
}
if(FUNCTOR(*denom2) == '*')
{ polyval(*denom2,&qq); /* collect powers, e.g. (x-2)(x-2) = (x-2)^2,
and order factors */
*denom2 = qq;
HIGHLIGHT(*denom2);
}
else if(NEGATIVE(*denom2) && FUNCTOR(ARG(0,*denom2)) == '*')
{ polyval(*denom2,&qq);
*denom2 = qq;
HIGHLIGHT(*denom2);
}
if(FRACTION(*num2) && FRACTION(*denom2) && equals(ARG(1,*num2),ARG(1, *denom2)))
{ *num2 = ARG(1, *num2);
*denom2 = ARG(1, *denom2);
HIGHLIGHT(*num2);
HIGHLIGHT(*denom2);
}
set_orderflag(saveit);
return 0;
}
/*_________________________________________________________________________*/
int homogeneous_poly(term p, term x, term y, POLYnomial *ans)
/* write p as a homogeneous polynomial in x and y, returning
0 for success. Other return values are as for makepoly.
Checks if p is a sum of terms, all of which have the same total
degree in x and y. If so, uses makepoly on p(x,1).
Assumes that p is a sum; don't call this on monomials.
The degree has to be a fixed number since a POLYnomial is to be
created.
*/
{ unsigned short n = ARITY(p);
term deg, target; /* total degree of the terms */
term q,r;
int i,trashflag,err;
term u,xdeg,ydeg;
if(FUNCTOR(p) == '+')
return 1;
/* first find the total degree using the first term */
u = ARG(0,p);
while(NEGATIVE(u))
u = ARG(0,u); /* powerin can't deal with negations */
err = powerin(u,x,&xdeg,&trashflag);
if(err)
xdeg = zero;
err = powerin(u,y,&ydeg,&trashflag);
if(err)
ydeg = zero;
if(INTEGERP(xdeg) && INTEGERP(ydeg))
value(sum(xdeg,ydeg),&target);
else
{ polyval(sum(xdeg,ydeg),&target);
if(!INTEGERP(target))
return 1; /* not a polynomial (with number for a degree) */
}
/* Now check that the other terms have the same total degree */
for(i=1;i<n;i++)
{ u = ARG(i,p);
while(NEGATIVE(u))
u = ARG(0,u);
err = powerin(u,x,&xdeg,&trashflag);
if(err)
xdeg = zero;
err = powerin(u,y,&ydeg,&trashflag);
if(err)
ydeg = zero;
if(INTEGERP(xdeg) && INTEGERP(ydeg))
value(sum(xdeg,ydeg),°);
else
polyval(sum(xdeg,ydeg),°); /* symbolic exponent */
if(!equals(deg,target))
return 1; /* not the same total degree */
}
subst(one,y,p,&q); /* p(x,1) */
polyval(q,&r);
return makepoly(r,x,ans);
}
/*__________________________________________________________________*/
int intpolynomial(POLYnomial p)
/* check that all coefficients are integers. If so return 1.
If not return 0. */
{ int i;
unsigned short degree = ARITY(p)-1;
term coef;
for(i=0;i<=degree;i++)
{ coef = ARG(i,p);
if(NEGATIVE(coef))
coef = ARG(0,coef);
if(!INTEGERP(coef))
return 0;
}
return 1;
}
/*__________________________________________________________________*/
static int twopolys(term u, term v, term *x, POLYnomial *u1, POLYnomial *v1, POLYnomial *ans)
/* write u and v as POLYnomials in some variable such that they
have a nontrivial gcd in that variable. Return the variable in *x,
the gcd in *ans, the two POLYnomial forms in *u1 and *v1, and
the return value is 0 for success.
*/
{ int i,j,k;
int nvariables = get_nvariables();
term *varlist = get_varlist();
unsigned short n;
int eigenindex = get_eigenindex();
for(i= 0;i<nvariables;i++)
{ if(nvariables > 1 && (difsq(u,&j) || difsq(v,&j)))
eigenindex = j; /* j is set by difsq */
if(i==0)
j=eigenindex; /* start with the eigenvariable
(or the variable found by difsq)
*/
else if(i==eigenindex) /* and it didn't work */
j=0;
else
j = i;
*x = varlist[j];
if(
contains(u,FUNCTOR(*x)) && contains(v,FUNCTOR(*x)) &&
makepoly(u,*x,u1)==0 && makepoly(v,*x,v1)==0
)
{ *ans = polynomial_gcd(*u1,*v1);
if(ARITY(*ans)==1 && ONE(ARG(0,*ans)))
continue; /* this didn't work */
if(FUNCTOR(*ans) == ILLEGAL)
continue; /* out of space in polynomial_gcd, don't crash */
/* it did work */
n = ARITY(*ans);
/* maybe the signs need reversing */
if(
( NEGATIVE(ARG(0, *ans)) &&
(j != eigenindex || get_orderflag() == ASCENDING)
) ||
( NEGATIVE(ARG(n-1, *ans)) &&
(j == eigenindex || get_orderflag() == DESCENDING)
)
)
{ for(k=0;k<n;k++)
ARGREP(*ans,k,tnegate(ARG(k,*ans)));
}
return 0;
}
else
continue; /* go on to the next i */
}
return 1;
}
/*_______________________________________________________*/
int listpolygcd(term *e, unsigned n, term *ans)
/* calculate the polygcd of an array of n polynomials,
returning the result in *ans, and returning 0 for success.
*/
{ term sofar = zero;
term temp;
unsigned i;
int err;
for(i=0;i<n;i++)
{ if(!ZERO(e[i]))
{ err = polygcd(sofar,e[i],&temp);
if(err)
return 1;
sofar = temp;
}
}
*ans = temp;
return 0;
}
/*__________________________________________________________________*/
static int twotrigpolys(term u, term v, term *x, POLYnomial *u1, POLYnomial *u2, POLYnomial *ans)
/* write u and v as POLYnomials in some trig function of an atom,
such that they have a nontrivial gcd as polynomials in that function.
Return the trig function in *x, the gcd in *ans,
the two POLYnomial forms in *u1 and *u2, and
the return value is 0 for success.
*/
{ term v0,v1,t,mid,z;
int savenvariables;
short savenextassumption;
int flag0,flag1,err,k;
unsigned short n;
if(ONE(u) || ONE(v))
return 1;
savenvariables = get_nvariables();
savenextassumption = get_nextassumption();
t = make_fraction(u,v);
if(!trigrational(t)) /* ensure the preconditions are satisfied */
return 1;
v0 = getnewvar(t,"acuxp");
v1 = getnewvar(t,"bdvyq");
mid = express_trigrat(0,t,v0,v1,&z);
/* passing 0 in the first arg tells express_trigrat not to
make assumptions. So theoretically the calls to set_nextassumption
below are now redundant. Nevertheless they are harmless. */
flag0 = contains(mid,FUNCTOR(v0));
flag1 = contains(mid,FUNCTOR(v1));
if(!FRACTION(mid))
{ set_nvariables(savenvariables);
set_nextassumption(savenextassumption);
return 1;
}
if(flag0 && !flag1)
{ err = makepoly(ARG(0,mid),v0,u1);
if(err)
return 1;
err = makepoly(ARG(1,mid),v0,u2);
if(err)
return 1;
*x = sin1(z);
set_nvariables(savenvariables);
set_nextassumption(savenextassumption);
}
else if(!flag0 && flag1)
{ err = makepoly(ARG(0,mid),v1,u1);
if(err)
return 1;
err = makepoly(ARG(1,mid),v1,u2);
if(err)
return 1;
*x = cos1(z);
set_nvariables(savenvariables);
set_nextassumption(savenextassumption);
}
else
{ set_nvariables(savenvariables);
set_nextassumption(savenextassumption);
return 1;
}
assert(FUNCTOR(*u1) == POLY && FUNCTOR(*u2)==POLY);
*ans = polynomial_gcd(*u1,*u2);
n = ARITY(*ans);
if(n > 1)
/* maybe the signs need reversing */
{ if(
(NEGATIVE(ARG(0, *ans)) && get_orderflag() == ASCENDING) ||
(NEGATIVE(ARG(n-1, *ans)) && get_orderflag() == DESCENDING)
)
{ for(k=0;k<ARITY(*ans);k++)
ARGREP(*ans,k,tnegate(ARG(k,*ans)));
}
return 0;
}
return 1;
}
/*__________________________________________________________*/
POLYnomial polyderiv(POLYnomial t)
/* t is a POLYnomial. Return its derivative as a POLYnomial */
{ unsigned short n = ARITY(t);
int i,err;
term ans,a,c;
assert(FUNCTOR(t) == POLY);
ans = make_term(POLY,(unsigned short)(n-1));
for(i=0;i<n-1;i++)
{ a = ARG(i+1,t);
if(ZERO(a))
ARGREP(ans,i,zero);
else if(ONE(a))
ARGREP(ans,i,make_int(i+1));
else
{ a = product(make_int(i+1),a);
err = value(a,&c);
if(err == 1)
c = a;
ARGREP(ans,i,c);
}
}
return ans;
}
/*__________________________________________________________*/
int divideoutpowers(term x, term v, term u, unsigned *m, term *ans)
/* if either u or v isn't a polynomial in x (an atom), return 2.
If both are polynomials and v divides u, write u = v^m ans, where v
does not divide ans, and return m and ans in the pointer variables
passed, returning zero for success. If v does not divide u,
return 1.
*/
{ int err,i;
term a,b,qq,rr,cc;
err = makepoly(u,x,&a);
if(err)
return 2;
err = makepoly(v,x,&b);
if(err)
return 2;
pseudodiv(a,b,&qq,&rr,&cc);
if(FUNCTOR(rr) == ILLEGAL)
return 1; /* out of space in pseudodiv */
if(!ZEROPOLY(rr))
return 1;
for(i=0; ZEROPOLY(rr) ; ++i)
{ a = qq;
pseudodiv(a,b,&qq,&rr,&cc);
if(FUNCTOR(rr) == ILLEGAL)
return 1; /* out of space in pseudodiv */
}
*m = i;
*ans = poly_term(a,x);
return 0;
}
/*__________________________________________________________________*/
POLYnomial polyexp(POLYnomial u, unsigned long m)
/* compute u^m; assuming the answer has degree < MAXDEGREE */
/* Before calling this you should check m * DEGREE(u) < MAXDEGREE */
{ POLYnomial t;
int i,k;
if(m==0)
{ makepoly(one,var0,&t);
return t;
}
if(m==1)
return u;
k = bitlength(m);
makepoly(one,var0,&t);
for(i=k-1;i>=0;i--)
{ polymult(t,t,&t);
if((m>>i) & 1)
polymult(t,u,&t);
}
return t;
}
/*_________________________________________________________*/
int polyform(term t, term x, POLYnomial *ans)
/* Bring t to polynomial form as a polynomial in x if
possible. Return 0 for success, 1 for failure.
Assumes x is an atom. Resets the heap if it fails
so that the net memory used is zero.
*/
{ int err;
unsigned short f;
void *savenode;
int factorflag,factorflag2;
POLYnomial u;
f = FUNCTOR(t);
if(ATOMIC(t) || f == '+' || !contains(t,FUNCTOR(x)))
{ err = makepoly(t,x,ans);
if(!err)
return 0;
}
savenode = heapmax();
factorflag = get_polyvalfactorflag();
factorflag2 = get_polyvalfactorflag2();
set_polyvalfactorflag(0);
set_polyvalfactorflag2(0);
polyval(t,&u);
set_polyvalfactorflag(factorflag);
set_polyvalfactorflag2(factorflag2);
err = polyform2(u,x,ans);
if(err)
reset_heap(savenode);
return err;
}
/*_________________________________________________________*/
static int polyform2(term t, term x, POLYnomial *ans)
/* Bring t to polynomial form as a polynomial in x if
possible. Return 0 for success, nonzero for failure.
Assumes that t has been through polyval already
and that x is an atom.
Return values
2: non-integer exponent;
3: integer exponent too large;
*/
{ int i,err;
unsigned short f,m,n;
long kk;
POLYnomial u,v;
f = FUNCTOR(t);
if(ATOMIC(t) || f == '+' || !contains(t,FUNCTOR(x)))
{ err = makepoly(t,x,ans);
if(!err)
return 0;
}
// polyval(t,&u); not needed as it's presumed input has been through polyval
// t = u;
// Remove these lines next time you see this.
f = FUNCTOR(t);
if(f == '-')
{ err = polyform2(ARG(0,t),x,&u);
if(err)
return 1;
*ans = polyneg(u);
return 0;
}
if(f == '/')
{ if(contains(ARG(1,t),FUNCTOR(x)))
return 1; /* denominator has to be constant */
err = polyform(ARG(0,t),x,&u);
if(err)
return 1;
*ans = multpolybyconstant(reciprocal(ARG(1,t)),u);
return 0;
}
if(f == '^')
{ if(!INTEGERP(ARG(1,t)))
return 2;
if(!ISINTEGER(ARG(1,t)))
return 3;
err = polyform2(ARG(0,t),x,&u);
if(err)
return 1;
m = ARITY(u) - 1; /* degree of base */
kk = INTDATA(ARG(1,t));
if(m > 1 && kk >= MAXDEGREE/2)
return 3;
if(m * kk >= MAXDEGREE)
return 3;
*ans = polyexp(u,kk);
return 0;
}
if(f != '*' && f != '+')
return 1;
n = ARITY(t);
err = polyform2(ARG(0,t),x,&u);
if(err)
return 1;
for(i=1;i<n;i++)
{ err = polyform2(ARG(i,t),x,&v);
if(err)
return 1;
if(f == '+')
u = polyadd(u,v);
else
polymult(u,v,&u);
}
*ans = u;
return 0;
}
/*_______________________________________________________________*/
void set_types(term *t)
/* set the type info on negative numbers and rational numbers
contained in t */
{ int i;
unsigned short n;
if(ATOMIC(*t))
return;
if(NEGATIVE(*t) && OBJECT(ARG(0,*t)))
{ SETTYPE(*t,TYPE(ARG(0,*t)));
return;
}
if(FRACTION(*t) && ISINTEGER(ARG(0,*t)) && ISINTEGER(ARG(1,*t)))
{ SETTYPE(*t, RATIONAL);
return;
}
if(FRACTION(*t) && OBJECT(ARG(0,*t)) && OBJECT(ARG(1,*t)) &&
TYPE(ARG(0,*t)) == BIGNUM && TYPE(ARG(1,*t)) == BIGNUM
)
{ SETTYPE(*t, BIGRAT);
return;
}
n = ARITY(*t);
for(i=0;i<n;i++)
set_types(ARGPTR(*t)+i);
return;
}
/*______________________________________________________________*/
static int difsq(term u, int *j)
/* It is presumed that nvariables > 1.
If u has the form y^2 - x^2 (or related
forms on which differenceofsquares will work)
then return in *j the j such that y is varlist[j].
Return 1 if u does have this form, 0 if not.
If 0 is returned, *j will be garbage.
The use of this function is as follows:
if u is of the form (y^2-x^2) then in twopolys,
let's choose y for the variable, not x,
because if we choose x then we get
screwy signs in cancelgcd_aux, e.g. (y-x)/(y^2-x^2) becomes
-(x-y)/(x-y)(-x-y) instead of (y-x)/(y-x)(y+x)
as we desire.
*/
{ term a,b,c;
term *varlist;
int nvariables,i;
if(FUNCTOR(u) != '+' || ARITY(u) != 2)
return 0;
a = ARG(0,u);
b = ARG(1,u);
if(!NEGATIVE(b))
return 0;
if(NEGATIVE(a))
return 0;
b = ARG(0,b);
if(seminumerical(a))
return 0;
if(sqrt_aux2(a,&c))
return 0;
if(sqrt_aux2(b,&c))
return 0;
varlist = get_varlist();
nvariables = get_nvariables();
for(i=0;i<nvariables;i++)
{ if(contains(a,FUNCTOR(varlist[i])))
{ *j = i;
return 1;
}
}
return 0; /* assert(0) */
}
/*__________________________________________________________*/
static term specialproduct(term a, term b)
/* when a is (p-q) and b is a sum with all negative terms,
return (q-p) strongnegate(b). Otherwise return signedproduct(a,b).
*/
{ unsigned short n;
int i;
term u,v;
if(FUNCTOR(a) == '+' && FUNCTOR(b) == '+' && ARITY(a) == 2 &&
NEGATIVE(ARG(1,a)) && !NEGATIVE(ARG(0,a))
)
{ n = ARITY(b);
for(i=0;i<n;i++)
{ if(!NEGATIVE(ARG(i,b)))
return signedproduct(a,b);
}
v = make_term('+',n);
for(i=0;i<n;i++)
ARGREP(v,i,ARG(0,ARG(i,b)));
u = sum(ARG(0,ARG(1,a)),tnegate(ARG(0,a)));
return product(u,v);
}
if(NEGATIVE(b) && FUNCTOR(a) == '+' && ARITY(a)== 2 &&
NEGATIVE(ARG(1,a)) && !NEGATIVE(ARG(0,a))
)
return specialproduct(sum(ARG(0,ARG(1,a)),tnegate(ARG(0,a))),ARG(0,b));
if(NEGATIVE(a) && FUNCTOR(b) == '+' && ARITY(b)== 2 &&
NEGATIVE(ARG(1,b)) && !NEGATIVE(ARG(0,b))
)
return specialproduct(ARG(0,a),sum(ARG(0,ARG(1,b)),tnegate(ARG(0,b))));
return signedproduct(a,b);
}
/*______________________________________________________________*/
term special_negate(term t)
/* if t has the form (a-b)c, return (b-a)c; otherwise
return strongnegate(t).
*/
{ term a,b,ans;
int i;
unsigned short n;
if(FUNCTOR(t) != '*' || FUNCTOR(ARG(0,t)) != '+' ||
ARITY(ARG(0,t)) != 2 || !NEGATIVE(ARG(1,ARG(0,t)))
)
return strongnegate(t);
n = ARITY(t);
a = ARG(0,ARG(0,t));
b = ARG(0,ARG(1,ARG(0,t)));
ans = make_term('*',n);
ARGREP(ans,0, sum(b,tnegate(a)));
for(i=1;i<n;i++)
ARGREP(ans,i,ARG(i,t));
return ans;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists