Sindbad~EG File Manager
/* M. Beeson, for Mathpert
polyval (one-step simplification)
used to implement the Simplify operation.
Original date 2.26.91
modified 6.18.99
1.15.00 added icount, complexcount, and code that uses them
1.15.00 added inproductflag
6.27.05 changed the way polyvalfactorflag2 controls factoring
7.3.05 added LAM in two places so that lambda terms also get the
eigenvariable set during simplification--needed by Otter-lambda.
1.23.06 added SUM to definition of OMITS
9.2.07 added code (line 275 ff) to make sure 2pi i/3 isn't made into (2pi/3) i,
and to make sure that (2pi i)/3 + pi i/3 becomes (2pi + 1) i/3
9.3.07 added polyvaldomainflag to activate_polyvalDLL and init_polyvalflags
5.5.13 deleted ctype.h
changed innumflag2 to innumflag22 and indenomflag2 to indenomflag22 to
avoid conflict with non-static variables defined in automode.c (Xcode won't take it.)
5.31.13 added code at line 1539 to stop a loop
6.4.13 switched from "i pi" to "pi i" at dated line 329 with a related change around line 296
6.8.13 stopped a loop around line 1500;
modified multiplyfractions_aux to not multiply (1/2) i out.
6.8.13 corrected multiplyfractions_aux again!
Don't have polyval SET_ALREADY on sums.
6.10.13 modified polyvalexp around line 2282 to prevent a possible loop.
7.13.13 added if(!ATOMIC(*ans)) at line 2743
9.30.14 added termsize calls in expand_for_polyval to stop a loop (in otter-lambda, but it could turn up in MathXpert too).
12.4.14 added code around line 1702 and 3931 to stop a loop.
12.8.14 added code around line 2277 to stop a loop.
12.10.14 added 35 or so lines of code at line 1572
3.18.23 line 1485, added assert(trigsqflag == SIN) to silence a warning
8.8.24 changed math.h to sincos.h
12.7.24 made set_complex call set_parser_complex
12.8.24 added the dated line to prevent an infinite repetition
*/
#include <string.h>
#include <assert.h>
#include <math.h> /* really math.h, for fabs */
#include "globals.h"
#include "ops.h" /* prototypes of operators */
#include "trig.h"
#include "calc.h"
#include "cancel.h"
#include "algaux.h"
#include "polynoms.h"
#include "order.h"
#include "simpsums.h"
#include "simpprod.h"
#include "deriv.h"
#include "complex4.h"
#include "domain.h"
#include "fraction.h"
#include "factor.h"
#include "checkarg.h"
#include "graphstr.h"
#include "mpdoc.h"
#include "automode.h"
#include "probtype.h"
#include "radsimp.h"
#include "deval.h"
#include "evaltrig.h"
#include "pvalaux.h"
#include "nfactor.h" /* factor_long */
#include "sqrtfrac.h" /* cancel_sqrts */
#include "mpmem.h" /* save_and_reset */
#include "surdsimp.h" /* surdsimp */
#include "match.h"
#include "prover.h" /* NOTDEFINED */
#include "dcomplex.h" /* ceval needs it */
#include "ceval.h" /* complexnumerical */
#include "plogs.h" /* polyval_collectlns etc. */
#include "binders.h"
#include "activate.h" /* init_polyvalflags */
#include "termstr.h" /* termsize */
/*__________________________________________________________________________*/
/* The following static globals control polyval. See polyval.h for
a discussion of how they are controlled from the calling program. */
static int polyvalfactorflag = 1; /* should polyval perform contentfactor? */
static int polyvalzeropowerflag = 0; /* should polyval set x^0 = 1? */
static int polyvalfunctionflag = 0; /* should polyval evaluate trig and log functions to algebraic values? */
static int polyvalfractexpflag = 1; /* should polyval convert radicals to
fractional exponents? */
static int polyvaldifflag = 0; /* should polyval evaluate derivatives? */
static int polyvalintflag = 1; /* should polyval use linearity of integral ? */
static int polyvalgcdflag = 0; /* should polyval cancel gcd of num and denom of fractions? */
static int polyvaldomainflag = 0; /* should cancel check definedness of cancelled terms?
and polyval check definedness of the product
before applying 0 x = x ? and that
x >= 0 before (root(n,x))^n = x? In other words,
if it's zero, polyval assumes all terms it deals with
are defined, and if it's nonzero, it doesn't so assume.
*/
static int polyvalnegexpflag = 0; /* How should polyval treat negative exponents? */
/* if -1, eliminate negative exponents;
if 1, convert fractions to neg exponents;
if 2, convert fractions with complex denominators
to negative exponents.
Note: the positive values are NOT
used by polyval, only by operators of Mathpert.
if 0, eliminate negative exponents in denominators,
but not elsewhere */
static int polyvalrootproductflag = 0; /* should polyval make assumptions that
a>=0 and b>=0 and apply (ab)^n = a^n b^n for
fractional n? If the flag is nonzero it does,
if the flag is zero it uses this law only
if the condition can be inferred. */
static int polyvalcomdenomflag = 0; /* should polyval do common denominators? */
static int complex;
static int infractionflag;
static int inproductflag;
static int innumflag2;
static int indenomflag2;
static int inderivflag; /* set when we go into a DIFF term, to prevent
using quotienttopower inside derivatives */
static int inlimitflag; /* set when we are in a LIMIT but NOT in a fraction
in a limit, to control the use of
quotienttopower. */
static int polyvalexpandflag; /* used only by expand_for_polyval, not accessed
outside this file. */
static int stop_contentfactorundersqrt(term t);
static int stop_contentfactorunderroot(term t);
static int contains_fract(term t);
static int log_in_sum(term power);
static int one_nonconstant_log(term t);
static int r_gcd(term num, term denom, term *ans);
static int expand_for_polyval(term t, term *next);
/*__________________________________________________________________________*/
/* The following flags are never set when polyval is used from polyvalop;
they are set to nonzero values only when polyval is used for calculating
singularities or limits. Hence, they don't need to be saved with a saved
document. */
static int polyvallogflag; /* enables log operations */
/* if it's 1, perform only e^ln x = x, ln(e^x) = x, etc. */
/* if it's 2, in addition collect and attract logs. */
static int polyvaltrigsqflag; /* enables (1-cos t)(1+cos t) = sin^2 t) etc */
static int polyvalfactorflag2 = 0; /* nonzero enables factoring; note that
polyvalfactorflag controls only content-factoring. Set this
like factorflag: bit 0 controls factoring denoms, bit 4 controls
factoring nums, bit 8 will get any sum factored. */
static int polyvalsumflag = 0; /* if nonzero, comdenom will be used
on sums which are factors of a product with other nonconstant factors.
This is needed in in singularity calculations. */
void set_polyvallogflag(int n)
{ polyvallogflag = n;
}
int get_polyvallogflag(void)
{ return polyvallogflag;
}
void set_polyvaltrigsqflag(int n)
{ polyvaltrigsqflag = n;
}
int get_polyvaltrigsqflag(void)
{ return polyvaltrigsqflag;
}
void set_polyvalfactorflag2(int n)
{ polyvalfactorflag2 = n;
}
int get_polyvalfactorflag2(void)
{ return polyvalfactorflag2;
}
void set_polyvalsumflag(int n)
{ polyvalsumflag = n;
}
/*__________________________________________________________________________*/
static int possibly_undefined(term);
static int simpdenom(term, term *);
static int polyval_seminumerical(unsigned, term, term *);
static int multiplyfractions_aux2(term t, term *next);
static int eliminatenegexp2(term, term *);
static int complex_denoms(term t);
static int complex_exponents_to_num(term t, term *ans);
static int reduce_by_gcd(term num, term denom, term *p, term *q);
static int contains_sum_as_factor(term t);
/*_______________________________________________________________________*/
int polyval(term expr, term *ans)
/* return value 0 for "did something" , nonzero for "no change" */
/* do arithmetic and polynomial simplification, but working even on
terms that are not polynomials. */
/* Uses basic algebraic laws, but does not do common denominators,
unless polyvalcomdenomflag is set.
Multiplies out products only if they are in a content-factored sum;
does content-factoring, but no more complicated factoring */
/* Make sure *ans is in fresh space so it can be destroyed without risk */
/* Fulfilling this spec requires that the following functions also return
in fresh space : arith (when it returns 0 or 2), cancel */
/* If return value is nonzero, *ans is a copy of expr */
/* If expr is marked ALREADY, it is just copied to *ans; and before
exiting, *ans will be marked ALREADY (unless it is a proposition,
in which case ALREADY means already-processed-by-lpt), so that
repeated calls to polyval will be fast. */
/* Does not work on PROTECTED terms, and (in automode) does not use
common denoms on sums with a PROTECTED summand, even to eliminate
compound fractions (example: limits of rational functions can have
protected summands like 1/lim(x->0,x).) */
/* A return value more than 2 is an arithmetic error; use aem(err)
to get the error message. 49 is out of space. */
/* Does not perform complex arithmetic, except as done by complexparts */
{ term temp,temp2,temp3,p,q,arg,cancelled,w,x,mid,num,denom,a,b,c,v;
int signcount,pflag,savelimitflag,stopexpand,trigsqflag;
unsigned short i,j,k;
term savelocus;
int savej=0, nvars;
term *varlist;
varinf *varinfo;
aflag flag = get_arithflag(); /* control 'value' */
int err,err2,err3, saveit=0, savefactorflag=0, savefactorflag2=0,saveringflag=0,saveeigen=0;
int integralflag,difflag,sigmaflag;
unsigned long nbytes;
unsigned short f = FUNCTOR(expr);
unsigned short n = ARITY(expr);
unsigned short fnum, fdenom;
void *savenode=NULL;
if(ALREADY(expr))
{ copy(expr,ans);
/* one can check the ALREADY bit BEFORE calling polyval
to avoid an unnecessary copying step.
*/
return 1; /* has already been processed */
}
flag.pure = 0;
flag.flt = 0;
flag.complex = 0; /* polyval doesn't do complex arithmetic,
e.g. reciprocals, because most students
need to see separate steps for that. */
flag.varadd = 1;
flag.fract = flag.comdenom = 1;
if(f == '-' && ZERO(ARG(0,expr)))
{ *ans = zero;
return 0;
}
if( ATOMIC(expr) || PROTECTED(expr) ||
(f == '-' && ATOMIC(ARG(0,expr)))
)
{ copy(expr,ans);
SET_ALREADY(*ans);
return 1;
}
if(flag.intexp == 0 && f == '^' && NEGATIVE(ARG(0,expr)))
{ /* (-1)^n = 1 or -1 according as n is even or odd */
/* (-a)^n = a^n or -a^n according as n is even or odd */
/* These are done by arithmetic if flag.intexp is nonzero
but we want them done anyway, especially for showing
the first few terms of a series. */
if(ONE(ARG(0,ARG(0,expr))))
{ if(iseven(ARG(1,expr)))
{ *ans = one;
return 0;
}
if(isodd(ARG(1,expr)))
{ *ans = minusone;
return 0;
}
}
else
{ if(iseven(ARG(1,expr)))
{ polyval(make_power(ARG(0,ARG(0,expr)),ARG(1,expr)),ans);
return 0;
}
if(isodd(ARG(1,expr)))
{ polyval(tnegate(make_power(ARG(0,ARG(0,expr)),ARG(1,expr))),ans);
return 0;
}
}
}
if(!ALREADYARITH(expr) && (f == '+' || f == '*' || (flag.complex ? complexnumerical(expr) : numerical(expr))))
{ savenode = heapmax();
err = arith(expr,ans,flag);
if(err != 0 && err != 2 && f != '*' && f != '*' && !polyvalfunctionflag)
{ /* arith generated an error */
reset_heap(savenode);
copy(expr,ans);
SET_ALREADY(*ans);
return err;
}
if(err==0) /* answer was numerical */
{ SET_ALREADY(*ans);
save_and_reset(*ans,savenode,ans);
return equals(*ans,expr);
}
if(err == 2 && !equals(expr,*ans))
{ save_and_reset(*ans,savenode,&expr);
/* something was done but answer wasn't a value, so keep going */
if(FUNCTOR(expr) != VAR)
SET_ALREADYARITH(expr);
polyval(expr,ans);
destroy_term(expr); /* arith returned ans in fresh space */
if(FUNCTOR(*ans) == '+')
additive_sortargs(*ans);
return 0;
}
}
if(FRACTION(expr) && isinteger(ARG(1,expr)) &&
iscomplex(expr) && /* expr really contains complexi */
!complexparts(expr,&temp,&temp2) && /* that is, complexparts succeeds */
ZERO(temp) /* so it's of the form c i / n */
)
/* Old comment, no longer true: (i/2) should not become (1/2)i because multiplyfractions_aux
will change it back, causing a loop; and it causes problems in exponents too */
/* 6.4.13, it MUST become (1/2)i, so that when ShowStepOperation is called on a sum to make
it look like complexform was called, complexform must be able to duplicate polyval.
Moreover inspecting the code for multiplyfractions_aux, I think it will leave (1/2) i alone
*/
{ // complexparts(ARG(0,expr),&temp, &temp2);
// *ans = make_fraction(product(temp2,complexi),ARG(1,expr));
*ans = product(temp2,complexi);
SET_ALREADY(*ans);
return 0;
}
if(
iscomplex(expr) && /* expr really contains complexi */
!complex_denoms(expr) && /* complexparts will compute complex reciprocals,
which we don't want polyval to do */
!complexparts(expr,&temp,&temp2) && /* that is, complexparts succeeds */
!ZERO(temp2) // 12.8.24, there is actually an imaginary part
)
{ /* expr = temp + temp2 i */
/* except in case temp is zero temp2 is a sum of fractions with the same denominator, e.g. 2k pi /3 and pi/3,
in which case we want (2k+1) pi i/3. */
term a,b,c;
if(ZERO(temp))
a = zero;
else
polyval(temp,&a);
polyval(temp2,&b);
if(ZERO(a) && FUNCTOR(b) == '+' && ARITY(b) == 2 && FRACTION(ARG(0,b)) && FRACTION(ARG(1,b)) &&
equals(ARG(1,ARG(0,b)),ARG(1,ARG(1,b)))
)
{ polyval(sum(ARG(0,ARG(0,b)),ARG(0,ARG(1,b))),&temp);
err = contentfactor_pval(temp,&temp2);
if(err)
temp2 = temp;
c = make_fraction(product(temp2,complexi),ARG(1,ARG(0,b)));
}
else
c = product(b,complexi); // order switched 6.4.13 to match complexform
if(PROTECTED(b))
PROTECT(c); /* surdsimp may have protected b */
*ans = ZERO(a) ? c : sum(a, c);
SET_ALREADY(*ans);
if(PROTECTED(b) && PROTECTED(c))
PROTECT(*ans);
return equals(*ans,expr) ? 1 : 0;
}
if(alg_numerical(expr))
{ err = surdsimp(expr,&temp);
if(!equals(expr,temp))
{ copy(temp,ans); /* surdsimp doesn't return in fresh space, but polyval has to */
SET_ALREADY(*ans); /* surdsimp sets it only if it finds a canonical form */
return 0;
}
if(err == 0) /* surdsimp says this is a canonical form */
{ copy(expr,ans); /* surdsimp doesn't return in fresh space */
return 1; /* so no use simplifying it further */
}
/* else go on as if it hadn't passed alg_numerical */
}
err = 1;
if(f == '-')
{ err = polyval(ARG(0,expr),&temp);
if(FUNCTOR(temp) == '+')
/* -(-a-b) = a+b etc. */
/* also -(a+b) = -a-b */
{ *ans = strongnegate(temp);
additive_sortargs(*ans); /* -(a-b) = b-a not -a+b */
return 0;
}
tneg(temp,ans); /* handles doubleminus ok */
if(!err || NEGATIVE(temp))
return 0;
else
return err;
}
if( polyvaldifflag && f == DIFF)
{ *ans = derivative(ARG(0,expr),ARG(1,expr));
if(!equals(*ans,expr))
{ SET_ALREADY(*ans);
return 0;
}
}
if(f == CASES)
{ /* cases( if(prop1, case1), if(prop2, case2),...., lastcase) */
term prop,u;
for(i=0;i<n;i++)
{ u = ARG(i,expr);
if(FUNCTOR(u) != IF)
{ if(i + 1 == n)
{ polyval(u,ans);
return 0;
}
/* assert(0) (syntax error in CASE construction) */
copy(expr,ans);
return 1;
}
prop = lpt(ARG(0,u));
if(equals(prop,trueterm))
{ polyval(ARG(1,u),ans);
return 0;
}
if(!equals(prop,falseterm))
{ copy(expr,ans); /* can't evaluate condition */
return 1;
}
}
}
temp = make_term(f,n);
if(DEFINED_FUNCTION(f) && SUBSCRIPTARGS(expr))
SET_SUBSCRIPTARGS(temp);
if(f == INTEGRAL && n == 4 && IMPROPER(expr))
SETIMPROPER(temp);
if(f == '/' && SOME_INFINITESIMAL(expr))
{ if(POSITIVE_INFINITESIMAL(expr))
SETPOSITIVE(temp);
else if(NEGATIVE_INFINITESIMAL(expr))
SETNEGATIVE(temp);
else
SETINFINITESIMAL(temp);
}
else if(f == '/')
{ if(ZERO(ARG(0,expr)))
{ *ans = zero;
RELEASE(temp);
return 0;
}
num = ARG(0,expr);
denom = ARG(1,expr);
fnum = FUNCTOR(num);
fdenom = FUNCTOR(denom);
if(fnum == '*')
{ /* check for a zero factor */
/* zero factors screw up cancel because of gcd(0,0) */
for(i=0;i<ARITY(num);i++)
{ p = ARG(i,num);
if(ISZERO(p) || (FUNCTOR(p) == '^' && ZERO(ARG(0,p))))
{ *ans = zero;
return 0;
}
}
}
if(ZERO(num) || (fnum == '^' && ISZERO(ARG(0,num))))
{ *ans = zero;
return 0;
}
if(
(ATOMIC(num) || fnum == '*' || fnum == '^') &&
(ATOMIC(denom) || fdenom == '*' || fdenom == '^') &&
!cancel(num,denom,&cancelled,&p)
)
/* try cancel BEFORE simplifying args, as Mathpert's automode does. */
{ polyval(p,ans);
RELEASE(temp);
return 0;
}
}
if(f == DIFF)
++inderivflag;
if(f == LIMIT)
++inlimitflag;
if(f == '^' && FUNCTOR(ARG(0,expr)) == '^')
{ /* (a^b)^c; for example (6^2)^(1/5) */
a = ARG(0,ARG(0,expr));
b = ARG(1,ARG(0,expr));
c = ARG(1,expr);
if(isinteger(c) || obviously_nonnegative(a))
{ RELEASE(temp);
temp = make_power(a,product(b,c));
return polyval(temp,ans); /* for example 6^2/5 instead of 36^(1/5) */
}
if(isinteger(b) && iseven(b) && FRACTION(c) &&
isinteger(ARG(0,c)) && isodd(ARG(0,c)) && iseven(ARG(1,c))
)
{ RELEASE(temp);
temp = make_power(abs1(a),product(b,c));
return polyval(temp,ans); /* (x^2)^(1/2) = abs(x), not x. */
}
}
if(n==1 && f != SQRT)
/* Don't use common denoms inside log, sin, etc. Of course
if there is a fraction inside log, polyvalcomdenomflag will get
turned back on again when we enter the num and denom. But
this stops e.g. ln(1+h/x) from changing to ln((x+h)/x) */
{ saveit = polyvalcomdenomflag;
polyvalcomdenomflag = 0;
if(TRIGFUNCTOR(f))
{ saveringflag = get_ringflag();
set_ringflag( saveringflag & ~RATRING);
/* so we get sin(u/4) instead of sin((1/4)u),
which is needed to get half-angle formulas applicable,
especially a case like sin((u+v)/2), which is in danger
of becoming sin((1/2)u + (1/2)v), whereupon automode will
break it by sinsum instead of half-angles. */
}
err = polyval(ARG(0,expr),ARGPTR(temp));
polyvalcomdenomflag = saveit;
if(TRIGFUNCTOR(f))
set_ringflag(saveringflag);
}
else if(f == SQRT)
{ savefactorflag = get_polyvalfactorflag();
if(FUNCTOR(ARG(0,expr)) == '+' && stop_contentfactorundersqrt(ARG(0,expr)))
set_polyvalfactorflag(0);
err = polyval(ARG(0,expr),ARGPTR(temp));
set_polyvalfactorflag(savefactorflag);
}
else if(f == ROOT)
{ savefactorflag = get_polyvalfactorflag();
if(FUNCTOR(ARG(1,expr)) == '+' && stop_contentfactorunderroot(ARG(1,expr)))
set_polyvalfactorflag(0);
err2 = polyval(ARG(0,expr),ARGPTR(temp));
err = polyval(ARG(1,expr),ARGPTR(temp)+1);
set_polyvalfactorflag(savefactorflag);
err = (!err || !err2) ? 0 : 1; /* if either arg changed err is zero */
}
else if(f != '+' && f != '*' && f != '/')
{ if(f == INTEGRAL || f == SUM || f == DIFF)
{ /* turn factoring and common denoms off */
saveit = polyvalcomdenomflag;
polyvalcomdenomflag = 0;
savefactorflag = polyvalfactorflag;
savefactorflag2 = polyvalfactorflag2;
polyvalfactorflag = 0;
polyvalfactorflag2 = 0;
}
if(BINDING2(expr))
{ nvars = get_nvariables();
x = BOUNDVAR(expr);
setlocus(x,&savelocus,&savej,expr);
fillbinders(expr);
saveeigen = get_eigenindex();
varlist = get_varlist();
for(k=0;k<nvars;k++)
{ if(equals(varlist[k],x))
{ set_eigenvariable(k);
break;
}
}
}
else if(f == INTEGRAL || f == DIFF || f == LAM)
{ x = BOUNDVAR(expr);
varlist = get_varlist();
nvars = get_nvariables();
saveeigen = get_eigenindex();
for(k=0;k<nvars;k++)
{ if(equals(varlist[k],x))
{ set_eigenvariable(k);
break;
}
}
}
for(i=0;i<n;i++) /* simplify the args */
{ if(f == '^' && i==1)
{ /* always use descending order in exponents:
1 + x^(k+1), not 1 + x^(1+k) */
int saveorderflag = get_orderflag();
set_orderflag(DESCENDING);
err2 = polyval(ARG(i,expr),ARGPTR(temp)+i);
set_orderflag(saveorderflag);
}
else
err2 = polyval(ARG(i,expr),ARGPTR(temp)+i);
if(!err2)
err=0 ;
/* so if something is done to any of the args,
then err is set to zero */
}
if(f == INTEGRAL || f == SUM || f == DIFF)
{ /* restore factorflag and comdenomflag to former values. */
polyvalcomdenomflag = saveit;
polyvalfactorflag = savefactorflag;
polyvalfactorflag2 = savefactorflag2;
/* simplify a series, indexed sum, derivative, or definite integral of zero to zero. */
if(f == SUM || f == DIFF || (f == INTEGRAL && n == 4))
{ if(ZERO(ARG(0,temp)))
temp = zero;
/* but don't return because there's a lot of cleanup still to do,
e.g. releasebinders, etc. */
}
}
if(BINDING2(expr))
{ varinfo = get_varinfo();
varinfo[savej].locus = savelocus;
releasebinders();
set_eigenvariable(saveeigen);
}
else if(f == INTEGRAL || f == DIFF || f == LAM)
set_eigenvariable(saveeigen);
}
if(f == DIFF)
--inderivflag;
if(f == LIMIT)
--inlimitflag;
if(f == '/') /* be sure to get (n + 1/2)/2 simplified to (2n+1)/4 */
{ saveit = polyvalcomdenomflag;
if(FUNCTOR(ARG(0,expr)) != LIMIT && FUNCTOR(ARG(1,expr)) != LIMIT)
polyvalcomdenomflag = 1; /* always use common denoms in fractions */
/* except in a fraction of limits */
for(i=0;i<2;i++)
{ temp2 = ARG(i,expr);
UNSET_ALREADY(temp2); /* because comdenomflag may be different */
++infractionflag;
if(i==0)
++innumflag2;
else
++indenomflag2;
savelimitflag = inlimitflag;
inlimitflag = 0;
err2 = polyval(temp2,ARGPTR(temp)+i);
inlimitflag = savelimitflag;
--infractionflag;
if(i==0)
--innumflag2;
else
--indenomflag2;
if(!err2)
err=0;
}
polyvalcomdenomflag = saveit;
if(ZERO(ARG(1,temp))) /* zero denominators can arise in limit problems */
{ *ans = temp;
return err;
}
}
if(f == '+') /* simplify the args, dropping any zero terms */
{ int nfracts = 0;
int nconstants = 0;
int eigenflag = 0;
x = get_eigenvariable();
k = pflag = 0;
if(n > 6)
savenode = heapmax();
for(i=0;i<n;i++)
{ if(PROTECTED(ARG(i,expr)))
pflag = 1;
if(equals(ARG(i,expr),x))
++eigenflag;
else if(!contains(ARG(i,expr),FUNCTOR(x)))
++nconstants;
err2 = polyval(ARG(i,expr),&temp2);
if(!err2)
err = 0;
/* so if something is done to any of the args, then err is set to zero */
if(!ZERO(temp2))
{ ARGREP(temp,k,temp2);
++k;
if(FRACTION(temp2) ||
(NEGATIVE(temp2) && FRACTION(ARG(0,temp2)))
)
++nfracts;
}
if(n > 6)
{ if(k == 0)
reset_heap(savenode);
else
{ SETFUNCTOR(temp,'+',k);
save_and_reset(temp,savenode,&temp3);
SETFUNCTOR(temp,'+',n);
for(j=0;j<k;j++)
ARGREP(temp,j,ARG(j,temp3));
RELEASE(temp3);
}
}
}
if(k==1) /* only one term left */
{ *ans = ARG(0,temp);
RELEASE(temp);
SET_ALREADY(*ans);
return 0;
}
if(k==0)
{ *ans = zero;
RELEASE(temp);
SET_ALREADY(*ans);
return 0;
}
SETFUNCTOR(temp,'+',k);
n = k;
if(!pflag && polyvalcomdenomflag && nfracts &&
!(eigenflag == 1 && nconstants == n-1)
/* this line protects sums produced by factoring, such as
x + 1/2 - sqrt(3)/2 , which especially in the denom of an
integral need to be left alone. */
)
/* pflag stops common denoms when a summand is protected */
/* Try collecting before common denoms, e.g. when simplifying
(sqrt(y+3)-sqrt y)(1/sqrt(y+3) + 1/sqrt(y)), after multiplying
out we have a sum of four terms, but they simplify and cancel
to a sum of two terms. If we don't do that cancellation and try
naivecomdenom on the four-term sum, we run out of memory.
*/
{ savenode = heapmax();
err3 = collect(temp,&temp2);
/* temp is already in new space, so it's ok for temp2
to overlap temp */
if(err3) /* collect returns zero for nothing done */
{ save_and_reset(temp2,savenode,&temp2);
/* recover heap space BEFORE as well as after the recursive call */
polyval(temp2,ans);
save_and_reset(*ans,savenode,ans);
/* instead of destroy_term(temp2); */
return 0;
}
err2 = naivecomdenom(temp,&temp2);
if(err2 == 0)
{ polyval(temp2,ans);
return 0;
}
}
}
if(f == '*')
/* simplify the args, dropping any 1's
and counting and removing minus signs */
{ /* First check for an arg that is literally zero, and
count the minus signs. */
int nonconstantflag = 0;
x = get_eigenvariable();
signcount = 0;
for(i=0;i<n;i++)
{ arg = ARG(i,expr);
if(NEGATIVE(arg))
{ ++signcount;
arg = ARG(0,arg);
}
if(ZERO(arg) && !possibly_undefined(expr))
goto zeroarg; /* a few lines below */
if(contains(arg,FUNCTOR(x)))
++nonconstantflag;
}
k = 0;
for(i=0;i<n;i++)
{ arg = ARG(i,expr);
if(NEGATIVE(arg))
arg = ARG(0,arg);
if(FUNCTOR(arg) == '+' &&
polyvalsumflag &&
nonconstantflag &&
contains_at_toplevel(arg,'/')
)
{ naivecomdenom(arg,&w);
polyval(w,&temp2);
err2 = 0;
}
else
{ ++inproductflag;
err2 = polyval(arg,&temp2);
--inproductflag;
}
if(!err2)
{ err = 0;
if(NEGATIVE(temp2))
{ ++signcount;
temp2 = ARG(0,temp2);
}
}
/* so if something is done to any of the args, then err is set to zero */
if(ZERO(temp2) && !possibly_undefined(expr))
{ zeroarg:
if(!get_polyvaldomainflag() || !check1(domain(expr)))
{ *ans = zero;
return 0;
}
else
{ copy(expr,ans);
return 1; /* don't do anything to this weird expression,
which has the form 0*u where u is provably not
defined, yet does not contain an undefined constant;
for example 0 *(1/0) would get here, and can arise,
too, if user evaluates limits in menu mode */
}
}
if(!ISONE(temp2))
{ ARGREP(temp,k,temp2);
++k;
}
}
if(k==1) /* only one term left */
{ if(signcount & 1)
tneg(ARG(0,temp),ans);
else
*ans = ARG(0,temp); /* already in fresh space */
RELEASE(temp);
SET_ALREADY(*ans);
return 0;
}
if(k==0)
{ *ans = one;
RELEASE(temp);
SET_ALREADY(*ans);
return 0;
}
SETFUNCTOR(temp,'*',k);
if(signcount & 1)
{ err = polyval(temp,&temp2);
tneg(temp2,ans);
SET_ALREADY(*ans);
return 0;
}
}
if(polyvalfunctionflag && seminumerical(temp))
{ err2 = polyval_seminumerical(f,temp,ans);
if(!err2)
return 0; /* and otherwise keep going */
if(err2 == 49)
return 49; /* out of space */
}
else if(polyvalfunctionflag && TRIGFUNCTOR(f))
/* sin(x+2n pi_term) = sin(x), tan(x+n pi_term) = tan x, etc. */
{ err2 = periodic(temp,&temp2);
if(!err2)
temp = temp2;
if(equals(ARG(0,temp),pi_term) || (NEGATIVE(ARG(0,temp)) && equals(ARG(0,ARG(0,temp)),pi_term)))
{ if(f == SIN || f == TAN)
{ *ans = zero;
return 0;
}
if(f == COS)
{ *ans = one;
return 0;
}
}
if(
(FUNCTOR(ARG(0,temp)) == '*' &&
!cancel(ARG(0,temp),pi_term,&cancelled,&w) &&
isinteger(w)
) ||
(NEGATIVE(ARG(0,temp)) && FUNCTOR(ARG(0,ARG(0,temp))) == '*' &&
!cancel(ARG(0,ARG(0,temp)),pi_term,&cancelled,&w) &&
isinteger(w)
)
)
{ if(f == SIN || f == TAN)
{ *ans = zero;
return 0;
}
if(f == COS)
{ if(iseven(w))
{ *ans = one;
return 0;
}
if(isodd(w))
{ *ans = tnegate(one);
return 0;
}
*ans = make_power(minusone,w);
return 0;
}
}
if(NEGATIVE(ARG(0,temp)))
{ term uu = ARG(0,ARG(0,temp));
switch(f)
{ case SIN:
temp = tnegate(sin1(uu));
break;
case COS:
temp = cos1(uu);
break;
case TAN:
temp = tnegate(tan1(uu));
break;
case SEC:
temp = sec1(uu);
break;
case CSC:
temp = tnegate(csc1(uu));
break;
case COT:
temp = tnegate(cot1(uu));
break;
}
}
}
if(f == SQRT && polyvalfractexpflag)
/* without polyvalfunctionflag here, which applies when
polyval is called from limval or the prover,
we can't infer sqrt x = x^(1/2)
*/
{ temp2 = make_power(ARG(0,temp),make_fraction(one,two));
polyval(temp2,ans);
destroy_term(temp2);
RELEASE(temp);
return equals(*ans, temp) ? 1 : 0;
}
if(f == ROOT && FUNCTOR(ARG(1,temp)) == '^' && !cancel(ARG(1,ARG(1,temp)),ARG(0,temp),&cancelled,&temp2))
{ polyval(make_power(ARG(0,ARG(1,temp)),temp2),ans);
return 0;
}
if(f == ROOT && (polyvalfractexpflag || polyvalfunctionflag))
{ temp2 = make_power(ARG(1,temp),make_fraction(one,ARG(0,temp)));
polyval(temp2,ans);
destroy_term(temp2);
RELEASE(temp);
return 0;
}
if(f == LOG && polyvallogflag)
{ /* log(10^x) = x */
if(FUNCTOR(ARG(0,temp)) == '^' && equals(ARG(0,ARG(0,temp)),ten))
{ polyval(ARG(1,ARG(0,temp)),ans);
return 0;
}
if(FUNCTOR(ARG(0,temp)) == '^' && contains(ARG(1,ARG(0,temp)),FUNCTOR(get_eigenvariable())))
{ polyval(product(ARG(1,ARG(0,temp)),log1(ARG(0,ARG(0,temp)))),ans);
return 0; /* log(u^v) = v log u */
/* Example: x^(log x) = log(x) log(x) */
}
if(equals(ARG(0,temp),ten))
{ *ans = one;
return 0;
}
if(ONE(ARG(0,temp)))
{ *ans = zero;
return 0;
}
if(FRACTION(ARG(0,temp)) && ONE(ARG(0,ARG(0,temp))))
{ /* log (1/x) = -log x */
polyval(tnegate(log1(ARG(1,ARG(0,temp)))),ans);
return 0;
}
}
if(f == LN && polyvallogflag)
{ /* ln(e^x) = x */
if(FUNCTOR(ARG(0,temp)) == '^' && equals(ARG(0,ARG(0,temp)),eulere))
{ polyval(ARG(1,ARG(0,temp)),ans);
return 0;
}
if(FUNCTOR(ARG(0,temp)) == '^' && contains(ARG(1,ARG(0,temp)),FUNCTOR(get_eigenvariable())))
{ polyval(product(ARG(1,ARG(0,temp)),ln1(ARG(0,ARG(0,temp)))),ans);
return 0; /* ln(u^v) = v ln u */
/* Example: x^(ln x) = ln(x) ln(x) */
}
if(equals(ARG(0,temp),eulere))
{ *ans = one;
return 0;
}
if(ONE(ARG(0,temp)))
{ *ans = zero;
return 0;
}
if(FRACTION(ARG(0,temp)) && ONE(ARG(0,ARG(0,temp))))
{ /* log (1/x) = -log x */
polyval(tnegate(ln1(ARG(1,ARG(0,temp)))),ans);
return 0;
}
}
if(f == LOGB && polyvallogflag)
{ if(equals(ARG(0,temp),ARG(1,temp)))
{ *ans = one; /* log(b,b) == 1 */
return 0;
}
if(ONE(ARG(1,temp)))
{ *ans = zero;
return 0;
}
/* log(b,b^x) = x etc. */
if(FUNCTOR(ARG(1,temp)) == '^' && equals(ARG(0,ARG(1,temp)),ARG(0,temp)))
{ polyval(ARG(1,ARG(1,temp)),ans);
return 0;
}
if(FRACTION(ARG(1,temp)) && ONE(ARG(0,ARG(1,temp))))
{ /* log (1/x) = -log x */
polyval(tnegate(logb1(ARG(0,temp),ARG(1,ARG(1,temp)))),ans);
return 0;
}
if(FUNCTOR(ARG(0,temp)) == SQRT)
{ /* log(sqrt(b),x) = 2 log(b,x) */
polyval(product(two,logb1(ARG(0,ARG(0,temp)),ARG(1,temp))),ans);
return 0;
}
if(FUNCTOR(ARG(0,temp)) == ROOT)
{ polyval(product(ARG(0,ARG(0,temp)),logb1(ARG(1,ARG(0,temp)),ARG(1,temp))),ans);
return 0;
}
if(FUNCTOR(ARG(0,temp)) == '^')
{ /* log(b^n,x) = log(b,x)/n */
polyval(make_fraction(logb1(ARG(0,ARG(0,temp)),ARG(1,temp)),ARG(1,ARG(0,temp))),ans);
return 0;
}
if(ZERO(ARG(1,temp)))
{ *ans = minusinfinity;
return 0;
}
if(INTEGERP(ARG(1,temp)) && INTEGERP(ARG(0,temp)) && !ZERO(ARG(0,temp)))
/* example, log(2,4) = 2 */
{ double b,x,z;
long kk;
deval(ARG(0,temp),&b);
deval(ARG(1,temp),&z);
/* is z a power of b? */
x = log(z)/log(b);
if(nearint(x,&kk))
{ *ans = make_int(kk);
return 0;
}
}
if(FRACTION(ARG(0,temp)))
{ if(ONE(ARG(0,ARG(0,temp))))
/* log(1/b,x) = - log(b,x) */
{ polyval(tnegate(logb1(ARG(1,ARG(0,temp)),ARG(1,temp))),ans);
return 0;
}
polyval(make_fraction(logb1(ARG(1,ARG(0,temp)),ARG(1,temp)),
sum(logb1(ARG(1,ARG(0,temp)),ARG(0,ARG(0,temp))),minusone)
),
ans /* log(p/q,x) = log(q,x)/(log(q,p) - 1) */
);
return 0;
}
}
if(f == INTEGRAL && ARITY(temp) == 2 &&
/* don't use intsum on definite integrals */
polyvalintflag &&
FUNCTOR(ARG(0,temp)) == '+' &&
!squareofone(ARG(0,temp)) /* block use of intsum if the integrand is
sin^4 u + 2 sin^2 u cos^2 u + cos^4 u
*/
)
{ term u = ARG(0,temp);
term x = ARG(1,temp);
term v,c,s;
unsigned short n = ARITY(u);
unsigned short i;
temp2 = make_term('+',n);
for(i=0;i<n;i++)
{ v = ARG(i,u);
/* go ahead and use intminus and intlinear too */
if(NEGATIVE(v))
{ if(FUNCTOR(ARG(0,v)) == '*')
{ twoparts(ARG(0,v),x,&c,&s);
ARGREP(temp2,i,tnegate(product(c,integral(s,x))));
}
else
ARGREP(temp2,i,tnegate(integral(ARG(0,v),x)));
}
else if(FUNCTOR(v) == '*')
{ twoparts(v,x,&c,&s);
ARGREP(temp2,i,product(c,integral(s,x)));
}
else
ARGREP(temp2,i,integral(v,x));
}
polyval(temp2,ans);
destroy_term(temp2);
RELEASE(temp);
return 0;
}
if (f == INTEGRAL && polyvalintflag &&
(FUNCTOR(ARG(0,temp)) == '*' || FUNCTOR(ARG(0,temp)) == '/')
)
/* apply intlinear */
{ term u = ARG(0,temp);
term x = ARG(1,temp);
term c,v,w;
twoparts(u,x,&c,&v);
if(!ONE(c))
{ w = ARITY(temp)==2 ? integral(v,x) : definite_integral(v,x,ARG(2,temp),ARG(3,temp));
if(IMPROPER(temp))
SETIMPROPER(w);
temp2 = product(c,w);
polyval(temp2,ans);
destroy_term(temp2);
RELEASE(temp);
return 0;
}
}
if (f == INTEGRAL && FUNCTOR(ARG(0,temp)) == '-')
/* apply intminus */
{ term u = ARG(0,ARG(0,temp));
term x = ARG(1,temp);
if(ARITY(temp) == 2)
temp2 = tnegate(integral(u,x));
else
{ temp2 = tnegate(definite_integral(u,x,ARG(2,temp),ARG(3,temp)));
if(IMPROPER(temp))
SETIMPROPER(ARG(0,temp2));
}
polyval(temp2,ans);
destroy_term(temp2);
RELEASE(temp);
return 0;
}
if(f == DENOM)
{ err2 = simpdenom(temp,ans);
if(err2)
*ans = temp;
SET_ALREADY(*ans);
return err2 ? err : 0;
}
if(f != '+' && f != '*' && f != '^' && f != '/' && f != IMAGPART && f != REALPART)
{ *ans = temp; /* already in fresh space */
if(!INEQUALITY(f) && f != AND && f != OR && f != NOT && f != SUM)
SET_ALREADY(*ans);
/* don't SET_ALREADY on inequalities as it will prevent them from
being worked on by lpt. Passing inequalities to polyval is just
a convenient way of simultaneously simplifying both sides. */
/* don't SET_AREADY on series as it is used to mark them convergent or divergent,
which prevents autosimp from finding the sum. */
return err; /* temp is just a copy of expr if nothing simplified */
}
if(f== '+')
{ savenode = heapmax();
err2 = summands(temp,&temp2); /* regroup terms */
if(!err2)
{ /* first trap the case of (x - algebraic number). The alg number
will be PROTECTED and we want the resulting sum of
arity 3 to be PROTECTED too. */
if(n==2 && PROTECTED(ARG(1,temp)) &&
ISATOM(ARG(0,temp)) &&
alg_numerical(ARG(1,temp))
)
{ PROTECT(temp2);
SET_ALREADY(temp2);
save_and_reset(temp2,savenode,ans);
return 0;
}
save_and_reset(temp2,savenode,&temp);
/* like temp = temp2 but recovering memory */
/* Now n = ARITY(temp) is no longer true, but n is not
used below so assigning it produces a warning message,
at least in Borland's 32-bit compiler. */
}
if(ARITY(temp) == 3 && ISATOM(ARG(0,temp)))
{ /* trap the case of x + a/c + sqrt(b)/d and reduce it to
standard algebraic form */
term u,v;
u = ARG(1,temp);
v = ARG(2,temp);
if(NEGATIVE(u))
u = ARG(0,u);
if(NEGATIVE(v))
v = ARG(0,v);
if(RATIONALP(u) && FRACTION(v) && INTEGERP(ARG(1,v)) &&
FUNCTOR(ARG(0,v)) == SQRT && INTEGERP(ARG(0,ARG(0,v)))
)
{ *ans = make_term('+',3);
ARGREP(*ans,0,ARG(0,temp));
ARGREP(*ans,1,ARG(1,temp));
if(NEGATIVE(ARG(2,temp)))
ARGREP(*ans,2,tnegate(product(reciprocal(ARG(1,v)),ARG(0,v))));
else
ARGREP(*ans,2,product(reciprocal(ARG(1,v)),ARG(0,v)));
PROTECT(*ans);
return 0;
}
}
if(!degree_simp(temp,&temp2))
{ polyval(temp2,ans);
save_and_reset(*ans,savenode,ans);
return 0;
}
if( (!err || !err2 || !ORDERED(expr))
&& !contains(temp,INTEGRAL) && !contains(temp,DIFF)
&& !contains(temp,LIMIT)
)
{ err2 = additive_sortargs(temp); /* only permutes the args, no new space */
/* don't reorder terms if nothing has been done so far and the
original expr was marked ORDERED to prevent reordering, as
in pi/4 + n pi */
}
err3 = collect(temp,&temp2);
/* temp is already in new space, so it's ok for temp2
to overlap temp */
if(err3) /* collect returns zero for nothing done */
{ save_and_reset(temp2,savenode,&temp2);
/* recover heap space BEFORE as well as after the recursive call */
polyval(temp2,ans);
save_and_reset(*ans,savenode,ans);
/* instead of destroy_term(temp2); */
return 0;
}
if(polyvallogflag > 1 && contains(temp,LN))
{ err3 = polyval_collectlns(temp,&temp2);
if(!err3)
{ save_and_reset(temp2,savenode,&temp2);
polyval(temp2,ans);
save_and_reset(*ans,savenode,ans);
return 0;
}
}
if(polyvallogflag > 1 && contains(temp,LOG))
{ err3 = polyval_collectlogs(temp,&temp2);
if(!err3)
{ save_and_reset(temp2,savenode,&temp2);
polyval(temp2,ans);
save_and_reset(*ans,savenode,ans);
return 0;
}
}
if(polyvallogflag > 1 && contains(temp,LOGB))
{ err3 = polyval_collectlogb(temp,&temp2);
if(!err3)
{ save_and_reset(temp2,savenode,&temp2);
polyval(temp2,ans);
save_and_reset(*ans,savenode,ans);
return 0;
}
}
if(!err) /* some arg simplified, but nothing
at toplevel except maybe sorting */
{ polyval(temp,ans);
save_and_reset(*ans,savenode,ans);
/* instead of destroy_term(temp); */
SET_ALREADY(*ans);
return 0;
}
else /* including the case err2==0 when args were sorted, but
nothing else was done */
/* Now content-factor, and then expand (multiply out products) */
{ term temp2;
int j;
int powerflag, sumflag;
if(polyvalfactorflag &&
!polyvalexpandflag &&
!algebraic_number(temp) &&
!complex_number(temp) &&
!(contains(temp,PI_ATOM) && is_linear_in(temp,pi_term))
)
{ err = contentfactor_pval(temp,&temp2);
if(!err)
{ /* temp2 can overlap temp, as contentfactor doesn't
necessarily use fresh space. We have to send
the args through polyval again anyway, because even
though contentfactor produces simplified output
from simplified input, the input may not have
been all the way simplified yet. */
save_and_reset(temp2,savenode,&temp2);
/* recover space used by naive_gcd etc. in contentfactor */
err = polyval(temp2,ans);
if(err && FUNCTOR(*ans) == '*')
/* still must additive_order the factors */
{ for(j=0;j<ARITY(*ans);j++)
{ temp2 = ARG(j,*ans);
if(FUNCTOR(temp2) == '+')
additive_sortargs(temp2);
}
}
return 0;
}
}
if( mvpoly2(temp) &&
!polyvalexpandflag &&
(
(polyvalfactorflag2 & 0x0100) || // changed from 0x0111 6.27.05
((polyvalfactorflag2 & 0x0010) && innumflag2) ||
((polyvalfactorflag2 & 0x0001) && indenomflag2)
)
)
{ err = purefactor(temp,&temp2);
if(!err)
{ save_and_reset(temp2,savenode,&temp2);
/* recover space used by naive_gcd etc. in contentfactor */
err = polyval(temp2,ans);
if(err && FUNCTOR(*ans) == '*')
/* still must additive_order the factors */
{ for(j=0;j<ARITY(*ans);j++)
{ temp2 = ARG(j,*ans);
if(FUNCTOR(temp2) == '+')
additive_sortargs(temp2);
}
}
return 0;
}
else
save_and_reset(temp,savenode,&temp);
/* recover space used in fruitless attempt to factor */
}
/* is any arg a product with a sum (or power up to 4 of a sum) for a factor? */
/* Or a negation of such a product? */
/* Or a square of a sum? */
powerflag = sumflag = 0;
trigsqflag = 0;
for(i=0;i<ARITY(temp);i++)
{ term s = ARG(i,temp);
if(FUNCTOR(s) == '-')
s = ARG(0,s);
if(FUNCTOR(s) == '^' && equals(ARG(1,s),two) &&
(FUNCTOR(s) == SIN || FUNCTOR(s) == COS)
)
++trigsqflag;
if(FUNCTOR(s)=='*')
{ for(j=0;j<ARITY(s);j++)
{ arg = ARG(j,s);
if(FUNCTOR(arg)=='+')
++sumflag;
if(FUNCTOR(arg)=='^' && ISINTEGER(ARG(1,arg)) &&
FUNCTOR(ARG(0,arg)) == '+' &&
INTDATA(ARG(1,arg)) <= 4L
)
++powerflag;
}
if(sumflag > 1 || powerflag)
break;
}
if(FUNCTOR(s) == '^' && equals(ARG(1,s),two) && FUNCTOR(ARG(0,s)) == '+')
{ ++powerflag;
break;
}
}
if(trigsqflag > 1 && polyvaltrigsqflag)
{ term lhs = sum(make_power(sin1(var0),two),make_power(cos1(var0),two));
term a;
err = match(temp,lhs,one,&a,&mid);
if(!err)
{ polyval(mid,ans);
return 0;
}
}
if( sumflag==1 ||
/* go ahead and distribute a number in a sum
as in c + (1/2) (diff(u,x) + diff(v,x)) */
((sumflag || powerflag) && !contains(temp,DIFF))
/* derivatives should be evaluated first
before expanding products and powers
*/
)
{ /* before expanding, we should contentfactor if the
summands all have a (possibly complicated) common
factor */
if(polyvalfactorflag || /* contentfactor was tried already above */
polyvalexpandflag /* we are trying to expand completely */
)
err = 1;
else
err = contentfactor_pval(temp,&temp2);
if(!err &&
(
(FUNCTOR(temp2) == '*' &&
!RATIONALP(ARG(0,temp2)) &&
!iscomplex(temp2)
) ||
(NEGATIVE(temp2) && FUNCTOR(ARG(0,temp2)) == '*' &&
!RATIONALP(ARG(0,ARG(0,temp2))) &&
/* don't bother if it only factors out a rational fraction */
!iscomplex(temp2)
/* don't factor i out of (ai+bi^2) for example */
)
)
)
{ err3 = polyval(temp2,ans);
destroy_term(temp2); /* overlaps temp */
RELEASE(temp);
if(err3 && FUNCTOR(*ans) == '*')
/* still must additive_order the factors */
{ int j;
for(j=0;j<ARITY(*ans);j++)
{ temp2 = ARG(j,*ans);
if(FUNCTOR(temp2) == '+')
additive_sortargs(temp2);
}
}
return 0;
}
/* well, there was no common factor, so expand.
But first, guard against running out of memory. */
if(ARITY(temp) > 5)
{ nbytes = mycoreleft();
if(nbytes < 8192U * ARITY(temp))
stopexpand = 1;
else
stopexpand = 0;
}
else
stopexpand = 0;
if(!stopexpand)
{ err3 = 1;
while(1)
{ err = expand_for_polyval(temp,&temp2);
if(err)
break;
save_and_reset(temp2,savenode,&temp);
err3 = 0;
}
save_and_reset(temp,savenode,&temp);
if(!err3)
{ /* expansion took place */
polyval(temp,ans);
save_and_reset(*ans,savenode,ans);
SET_ALREADY(*ans);
return 0;
}
}
}
}
*ans = temp;
if(FUNCTOR(*ans) == '+' && !err2)
additive_sortargs(*ans);
SET_ALREADY(*ans);
return (err2 ? 1 : 0);
}
if(f == '*')
{ int count,ratcount,vectorflag,numericalcount,complexcount,icount;
unsigned h;
trigsqflag = 0;
err2 = factors(temp,&temp2); /* regroup terms if necessary */
if(!err2)
{ err = polyval(temp2,ans); /* e.g. 3(8x^7) goes to 3*8x^7 which now needs arith */
destroy_term(temp2); /* already in fresh space */
return err;
}
if(!degree_simp(temp,&temp2))
{ polyval(temp2,ans);
return 0;
}
/* multiply fractions if necessary */
/* but, if there is only one fraction and it is a rational number,
DON'T multiply it out -- unless the other factor is
a root or sqrt of an integer. */
/* Also, don't multiply out, for example, (5 sqrt(7)/7) x, which
is a canonical algebraic fraction times a symbolic term */
count = ratcount = 0; /* count the fractions and the rational fractions;
ratcount also counts fractions like sqrt(3)/2 */
numericalcount = 0; /* count the numerical terms which are not rational numbers or integers */
vectorflag = 0; /* are there vectors or matrices in the product? */
icount = 0; /* does complexi occur as a factor? */
complexcount = 0; /* count the complex factors */
integralflag = difflag = sigmaflag = 0;
for(i=0;i<ARITY(temp);i++)
{ q = ARG(i,temp);
if(!RATIONALP(q) && !INTEGERP(q) && numerical(q))
++numericalcount;
if(get_complex())
{ if(iscomplex(q))
++complexcount;
if(ISATOM(q) && equals(q,complexi))
++icount;
}
h = FUNCTOR(q);
if(h == '/')
{ ++count;
if(INTEGERP(ARG(0,q)) && INTEGERP(ARG(1,q)) && !ZERO(ARG(1,q)))
++ratcount;
else if(FRACTION(q) && numerical(q) &&
INTEGERP(ARG(1,q)) && !ZERO(ARG(1,q)) &&
canonical(0,q)
)
++ratcount;
}
else if(h == VECTOR || h == MATRIX)
vectorflag = 1;
if(h == '+' && ARITY(q) == 2 &&
(
(ONE(ARG(0,q)) && FUNCTOR(ARG(1,q)) == COS) ||
(ONE(ARG(1,q)) && FUNCTOR(ARG(0,q)) == COS)
)
)
trigsqflag = COS;
if(h == '+' && ARITY(q) == 2 &&
(
(ONE(ARG(0,q)) && FUNCTOR(ARG(1,q)) == SIN) ||
(ONE(ARG(1,q)) && FUNCTOR(ARG(0,q)) == SIN)
)
)
trigsqflag = SIN;
if(h == INTEGRAL)
integralflag = 1;
if(h == DIFF)
difflag = 1;
if(h == SUM)
sigmaflag = 1;
}
if(complexcount == 1 && icount == 1)
{ err = cancel(temp,complexi,&cancelled,&temp2);
if(!err)
{ polyval(temp2,&q);
*ans = product(q,complexi);
return equals(*ans,expr) ? 1 : 0;
}
}
if(polyvaltrigsqflag && trigsqflag)
{ /* (1-cos t)(1+cos t) = sin^2 t */
term lhs,rhs,a;
if(trigsqflag == COS)
{ lhs = product(sum(one,cos1(var0)),sum(one,tnegate(cos1(var0))));
rhs = make_power(sin1(var0),two);
}
else
{ assert(trigsqflag == SIN);
lhs = product(sum(one,sin1(var0)),sum(one,tnegate(sin1(var0))));
rhs = make_power(cos1(var0),two);
}
err = match(temp,lhs,rhs,&a,&mid);
if(!err)
{ polyval(mid,ans);
return 0;
}
}
if(
(count &&
!(ratcount == 1 && count == 1 && /* the only fraction is a rational */
(get_ringflag() & RATRING) && /* rational constants desired */
!infractionflag /* not in a compound fraction */
) &&
!( count == 1 && (integralflag || sigmaflag || difflag) )
)
|| /* But DO multiply out (1/2) sqrt(3), (1/2) pi , (1/2) e, (1/2)2^(5/2) */
( RATIONALP(ARG(0,temp)) &&
seminumerical(temp) && !contains_fract(temp) &&
!(get_ringflag() & RATRING)
)
||
numericalcount > 1 /* multiply out sqrt(3) (sqrt(3)/2) */
)
{ err2 = multiplyfractions_aux2(temp,&temp2);
if(!err2)
{ term temp73;
// ensure no loop with factors
int err4 = factors(temp2,&temp73);
if(err4) // no loop thus
{ RELEASE(temp);
polyval(temp2,ans);
destroy_term(temp2); /* toplevel created by multiplyfractions_aux2;
// args created from parts of temp, which was
// already in fresh space */
return 0;
}
}
err2 = 1;
}
else
err2=1;
if( (!err || !err2 || !ORDERED(expr) ) && !vectorflag )
err2 = sortargs(temp);
err3 = rawcollectpowers(temp,&temp2,1);
if(!err3)
{ RELEASE(temp);
polyval(temp2,ans);
destroy_term(temp2); /* made by rawcollectpowers using parts of
temp, which is already in fresh space */
return 0;
}
if(ARITY(temp) == 2 &&
FUNCTOR(ARG(1,temp)) == '+' &&
(
(
numerical(ARG(0,temp)) &&
(!FRACTION(ARG(0,temp)) || (!polyvalfactorflag && !polyvalfactorflag2)) &&
!inlimitflag
) ||
FUNCTOR(ARG(0,temp)) == '^' /* e^x(c+e^-x) */
)
)
{ err3 = plain_distribandcancel(temp,&temp2);
if(!err3)
{ polyval(temp2,ans);
return 0;
}
}
if(ARITY(temp) == 2 &&
FUNCTOR(ARG(0,temp)) == '+' &&
FUNCTOR(ARG(1,temp)) == '^' /* e^x(c+e^-x) */
)
{ term temp44 = product(ARG(1,temp),ARG(0,temp));
err3 = plain_distribandcancel(temp44,&temp2);
if(!err3)
{ // ensure there is no loop created:
term temp41;
if(contentfactor_pval(temp2,&temp41))
{ // that is, if content factoring fails
polyval(temp2,ans);
return 0;
}
}
RELEASE(temp44);
}
/* That still doesn't catch e^x(c+e^-x) occurring within a product of arity more than 2,
and this comes up in integrate to logarithms problem 35 */
if(ARITY(temp) > 2)
{ int n = ARITY(temp);
int i,j,k;
term e,u,v,x,p,q,r,z;
for(i=0;i<n;i++)
{ u = ARG(i,temp);
if(FUNCTOR(u) != '^')
continue;
e = ARG(0,u);
x = ARG(1,u);
for(j=0;j<n;j++)
{ v = ARG(j,temp);
if(FUNCTOR(v) != '+' || ARITY(v) != 2)
continue;
p = ARG(0,v);
q = ARG(1,v);
if(FUNCTOR(p) == '^' && equals(ARG(0,p),e) && equals(ARG(1,p),tnegate(x)))
r = sum(one, product(u,q));
else if(FUNCTOR(q) == '^' && equals(ARG(0,q),e) && equals(ARG(1,q),tnegate(x)))
r = sum(product(u,p),one);
else
continue;
z = make_term('*',n-1);
if(j < i)
{ // swap j and i
k = j;
j = i;
i = k;
}
for(k=0;k<i;k++)
ARGREP(z,k,ARG(k,temp));
ARGREP(z,i,r);
for(k=i+1;k<j;k++)
ARGREP(z,k,ARG(k,temp));
for(k=j;k<n-1;k++)
ARGREP(z,k,ARG(k+1,temp));
polyval(z,ans);
return 0;
}
}
}
if(polyvallogflag > 1 && contains(temp,LN))
{ term w;
/* Only use attractlns to create exponents that won't be pulled
apart again by ln(u^v) = v ln u, creating a loop. */
if(one_nonconstant_log(temp) && !polyval_attractlns(temp,&w))
{ polyval(w,ans);
return 0;
}
}
if(polyvallogflag > 1 && contains(temp,LOG))
{ term w;
if(one_nonconstant_log(temp) && !polyval_attractlogs(temp,&w))
{ polyval(w,ans);
return 0;
}
}
if(polyvallogflag > 1 && contains(temp,LOGB))
{ term w;
if(one_nonconstant_log(temp) && !polyval_attractlogb2(temp,&w))
{ polyval(w,ans);
return 0;
}
}
/* 2 sqrt(a/4) hasn't been simplified yet */
if(ARITY(temp) == 2 &&
FUNCTOR(ARG(1,temp)) == SQRT &&
FRACTION(ARG(0,ARG(1,temp)))
)
{ term w = ARG(0,ARG(1,temp));
term a,b;
if(!cancel(ARG(0,temp),ARG(1,w),&a,&b))
{ polyval(sqrt1(make_fraction(product(square2(ARG(0,temp)),ARG(0,w)),ARG(1,w))),ans);
return 0;
}
}
if(ARITY(temp) == 2 &&
FUNCTOR(ARG(1,temp)) == ROOT &&
FRACTION(ARG(1,ARG(1,temp)))
)
{ term w = ARG(1,ARG(1,temp));
term a,b;
if(!cancel(ARG(0,temp),ARG(1,w),&a,&b))
{ polyval(make_root(ARG(0,ARG(1,temp)),make_fraction(product(square2(ARG(0,temp)),ARG(0,w)),ARG(1,w))),ans);
return 0;
}
}
*ans = temp;
SET_ALREADY(*ans);
if( !err || !err2)
return 0;
else
return 1;
}
if(f== '/')
{ term cancelled,num,denom,ss;
num = ARG(0,temp);
denom = ARG(1,temp);
if(ONE(denom)) /* a/1 = a */
{ *ans = num;
SET_ALREADY(*ans);
return 0;
}
if(equals(denom,minusone)) /* a / (-1) = -a */
{ tneg(num,ans);
SET_ALREADY(*ans);
return 0;
}
if(ZERO(num) && !possibly_undefined(denom)) /* 0/a = 0 */
{ *ans = zero;
return 0;
}
else if(ZERO(num))
{ *ans = temp;
return 1;
}
if(!degree_simp(temp,&temp2))
{ polyval(temp2,ans);
return 0;
}
if(INTEGERP(denom) &&
(FUNCTOR(num) == INTEGRAL ||
(FUNCTOR(num) == '*' && contains_at_toplevel(num,INTEGRAL))
)
)
{ polyval(num,&temp2);
destroy_term(num); /* temp was already in fresh space */
if(FUNCTOR(temp2) == '*')
{ /* Put all the non-integral terms into p, and the
integral(s) into q, and simplify p and q separately. */
p = make_term('*',ARITY(temp2));
q = make_term('*', ARITY(temp2));
k = j = 0;
for(i=0;i<ARITY(temp2);i++)
{ if(FUNCTOR(ARG(i,temp2)) != INTEGRAL)
{ ARGREP(p,k,ARG(i,temp2));
++k;
}
else
{ ARGREP(q,j,ARG(i,temp2));
++j;
}
}
if(k==0)
{ RELEASE(p);
p = one;
}
else if(k==1)
{ w = ARG(0,p);
RELEASE(p);
p = w;
}
else
SETFUNCTOR(p,'*',k);
if(j==0)
assert(0);
if(j==1)
{ w = ARG(0,q);
RELEASE(q);
q = w;
}
else
SETFUNCTOR(q,'*',j);
err = polyval(p,&w);
p = w;
err2 = polyval(q,&w);
q = w;
*ans = product(p,q);
return err == 0 ? 0 : err2 == 0 ? 0 : 1;
}
*ans = product(reciprocal(denom),temp2);
return 0;
}
if(FUNCTOR(num) == '/' && FUNCTOR(denom) == '/' && equals(ARG(1,num), ARG(1,denom)))
{ num = ARG(0,num);
denom = ARG(0, denom);
}
if(FUNCTOR(num)=='-') /* use (-a/b) = -(a/b) */
{ polyval(make_fraction(ARG(0,num),denom),&ss);
*ans = strongnegate(ss);
if(FUNCTOR(*ans)=='+')
additive_sortargs(*ans);
if(NEGATIVE(*ans) && FRACTION(ARG(0,*ans)) && SOME_INFINITESIMAL(temp))
copy_infinitesimal_markers(temp,ARGPTR(*ans));
destroy_term(temp); /* temp was made by make_term, and its args
were filled in by polyval, which always
returns in fresh space. Since polyval always
uses fresh space, ss does not overlap num and
denom, which are the args of temp. */
SET_ALREADY(*ans);
return 0;
}
if(FUNCTOR(denom)=='-') /* use (a/-b) = -(a/b) */
{ polyval(make_fraction(num,ARG(0,denom)),&ss);
*ans = strongnegate(ss);
if(FUNCTOR(*ans)=='+')
additive_sortargs(*ans);
if(NEGATIVE(*ans) && FRACTION(ARG(0,*ans)) && SOME_INFINITESIMAL(temp))
copy_infinitesimal_markers(temp,ARGPTR(*ans));
destroy_term(temp);
SET_ALREADY(*ans);
return 0;
}
if(FUNCTOR(num) == '+')
{ unsigned short n = ARITY(num);
if(alg_numerical(num) && ALREADY(num) && INTEGERP(denom) &&
!apart3(temp,&w)
)
/* Example: (1 + (1/2) sqrt 5) /2 goes to
1/2 + (1/4) sqrt 5 */
{ polyval(w,ans);
destroy_term(temp);
SET_ALREADY(*ans);
return 0;
}
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,num)) != '-')
break;
}
if(i == n && (!complexnumerical(num) || !complexnumerical(denom)))
{ /* use (-a-b)/c = -(a+b)/c */
/* But, not if -a-b is an algebraic or complex number */
w = make_fraction(strongnegate(num), denom);
if(SOME_INFINITESIMAL(temp))
copy_infinitesimal_markers(temp,&w);
polyval(tnegate(w),ans);
destroy_term(temp);
SET_ALREADY(*ans);
return 0;
}
}
if(FUNCTOR(denom) == '+')
{ unsigned n = ARITY(denom);
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,denom)) != '-')
break;
}
if(i == n)
{ /* use c/(-a-b)/c = -c/(a+b) */
term w = make_fraction(num,strongnegate(denom));
if(SOME_INFINITESIMAL(temp))
copy_infinitesimal_markers(temp,&w);
polyval(tnegate(w),ans);
destroy_term(temp);
SET_ALREADY(*ans);
return 0;
}
}
if(FUNCTOR(num) == ABSFUNCTOR && FUNCTOR(denom) == ABSFUNCTOR)
{ polyval(make_fraction(ARG(0,num),ARG(0,denom)),&w);
destroy_term(temp);
polyval(abs1(w),ans);
/* abs1(w) may not be the answer, e.g.
abs(3x)/abs(x) = 3, not abs(3) */
return equals(*ans,expr) ? 1 : 0;
}
if(FUNCTOR(num) == SQRT && FUNCTOR(denom) == SQRT)
{ v = make_fraction(ARG(0,num),ARG(0,denom));
polyval(v,&w);
if(!equals(v,w))
{ polyval(sqrt1(w),ans);
if(!equals(*ans,expr))
return 0;
}
}
if(FUNCTOR(num) == ROOT && FUNCTOR(denom) == ROOT &&
equals(ARG(0,denom),ARG(0,num))
)
{ v = make_fraction(ARG(1,num),ARG(1,denom));
polyval(v,&w);
if(!equals(v,w))
{ polyval(make_root(ARG(0,num),w),ans);
if(!equals(*ans,expr))
return 0;
}
}
/* but when polyvalfractexpflag is nonzero, roots and sqrts have
already been converted to fractional exponents */
if(FUNCTOR(num) == '^' && FUNCTOR(denom) == '^' &&
equals(ARG(1,num),ARG(1,denom)) &&
!equals(ARG(0,num),minusone)
/* leave (-1)^n/2^n alone, else it becomes (-1/2)^n = (-(1/2))^n = (-1)^n(1/2)^n = (-1)^n/2^n loop */
)
{ v = make_fraction(ARG(0,num),ARG(0,denom));
polyval(v,&w);
if(!equals(v,w))
{ polyval(make_power(w,ARG(1,num)),ans);
if(!equals(*ans,expr))
return 0;
}
}
if(FUNCTOR(denom) == '/' && FUNCTOR(num)== '/' && /* invert and multiply */
!SOME_INFINITESIMAL(denom) && !SOME_INFINITESIMAL(num)
)
{ if(get_polyvaldomainflag())
/* check the denominator of the denominator is nonzero;
it's going to wind up in the numerator */
{ if(check1(nonzero(ARG(1,denom))))
{ *ans = undefined;
destroy_term(temp);
return 0;
}
}
if(equals(ARG(1,denom),ARG(1,num)))
polyval(make_fraction(ARG(0,num),ARG(0,denom)),ans);
else if(equals(ARG(0,num),ARG(0,denom)))
polyval(make_fraction(ARG(1,denom),ARG(1,num)),ans);
else
polyval(make_fraction(
product(ARG(0,num),ARG(1,denom)),
product(ARG(1,num),ARG(0,denom))
),
ans
);
destroy_term(temp);
SET_ALREADY(*ans);
return 0;
}
if(FUNCTOR(denom) == '/' && !SOME_INFINITESIMAL(denom))
/* and num isn't a fraction */
{ polyval(make_fraction(product(ARG(1,denom),num),ARG(0,denom)),ans);
destroy_term(temp);
SET_ALREADY(*ans);
return 0;
}
if(FUNCTOR(num) == '/') /* and denom isn't a fraction */
{ polyval(make_fraction(ARG(0,num),product(ARG(1,num),denom)),ans);
if(SOME_INFINITESIMAL(num))
copy_infinitesimal_markers(num,ans);
destroy_term(temp);
SET_ALREADY(*ans);
return 0;
}
if(polyvalgcdflag && !SOME_INFINITESIMAL(temp) && !r_gcd(num,denom,&p))
{ polyval(p,ans);
return 0;
}
/* even if polygcdflag isn't set, we still want to simplify (2x+2)/(x+1) */
if(
(FUNCTOR(ARG(0,temp)) == '+' || FUNCTOR(ARG(1,temp)) == '+') &&
!cancel_by_contentfactor(ARG(0,temp),ARG(1,temp),&cancelled,&temp2)
/* that is, if cancel_by_contentfactor succeeds */
)
{ savenode = heapmax();
save_and_reset(temp2,savenode,&temp2);
polyval(temp2,ans);
save_and_reset(*ans,savenode,ans);
if(SOME_INFINITESIMAL(temp2))
copy_infinitesimal_markers(temp2,ans);
return 0;
}
/* now temp isn't a compound fraction so we can call 'cancel' */
savenode = heapmax();
err2 = cancel(ARG(0,temp),ARG(1,temp),&cancelled,&temp2);
if(!err2) /* there was a cancellation */
{ if(equals(temp2,temp))
assert(0);
if(SOME_INFINITESIMAL(temp))
copy_infinitesimal_markers(temp,&temp2);
save_and_reset(temp2,savenode,&temp2);
polyval(temp2,ans); /* put it through again, it may need more work */
save_and_reset(*ans,savenode,ans);
return 0;
}
else
reset_heap(savenode);
/* There may be square roots to cancel using sqrt(xy)/sqrt y = sqrt x */
/* This will also cancel ROOT and ABSFUNCTOR similarly */
if(contains_sqrt(num) && contains_sqrt(denom))
{ err2 = cancel_sqrts(temp,&temp2);
if(!err2)
{ if(SOME_INFINITESIMAL(temp))
copy_infinitesimal_markers(temp,&temp2);
save_and_reset(temp2,savenode,&temp2);
polyval(temp2,ans);
save_and_reset(*ans,savenode,ans);
return 0;
}
}
else
reset_heap(savenode);
/* Now eliminate negative exponents if any */
if(polyvalnegexpflag == -1) /* eliminate all negative exponents */
err2 = eliminatenegexp2(temp,&temp2);
else /* eliminate them in denominators only */
{ char localbuffer[DIMREASONBUFFER];
err2 = eliminatenegexpdenom(temp,zero,&temp2,localbuffer);
}
if(err2)
*ans = temp; /* temp is already in fresh space */
else
{ polyval(temp2,ans);
err = 0;
}
/* polyval NEVER introduces negative real exponents. The values
polyvalnegexpflag = 1 or 2 are used only by operators of Mathpert,
not by polyval itself; polyval treats them the same as 0.
However, polyval does eliminate e^(complex number) from the
denominator, unless it would cause a loop */
if(FRACTION(*ans) && iscomplex(ARG(1,*ans)))
{ err2 = complex_exponents_to_num(*ans,&temp);
if(!err2)
{ *ans = temp;
err = 0;
}
}
/* Next rewrite (2 sin x)/3 as (2/3) sin x */
/* But be careful not to loop with multiplyfractions */
/* These conditions must jibe with those around 'get_ringflag' at
its other occurrence */
if(FRACTION(*ans) && !infractionflag /* not in compound fraction */
&& (get_ringflag() & RATRING) /* rational constants desired */
&& INTEGERP(ARG(1,*ans)) /* integer denominator */
&& seminumerical(ARG(0,*ans)) && contains_fract(ARG(0,*ans))
/* don't pull 1/2 out of 2^(1/2)/2, or out of pi^2/2,
but do pull it out of sqrt(1 + sqrt(3/2))/2
*/
&& !ATOMIC(ARG(0,*ans)) /* leave x/3 and 2/3 alone */
&& !(FUNCTOR(ARG(0,*ans)) == SQRT && INTEGERP(ARG(0,ARG(0,*ans))))
/* leave sqrt(3)/2 alone */
&& !(FUNCTOR(ARG(0,*ans)) == ROOT && INTEGERP(ARG(1,ARG(0,*ans))))
/* leave root(3,2)/2 alone too */
)
{ term num = ARG(0,*ans);
term z;
char localbuffer[DIMREASONBUFFER];
if(FUNCTOR(num) != '*')
temp = product(reciprocal(ARG(1,*ans)),ARG(0,*ans));
else
pulloutrational(*ans,zero,&temp,localbuffer);
err = 0;
if(FUNCTOR(temp) == '*' && ARITY(temp) == 2 &&
RATIONALP(ARG(0,temp)) && FUNCTOR(ARG(1,temp)) == '+' &&
(!FRACTION(ARG(0,temp)) || !polyvalfactorflag)
)
plain_distriblaw(temp,ans);
else if(FRACTION(ARG(0,temp)) && /* Don't produce (1/2)sqrt(2) u */
ONE(ARG(0,ARG(0,temp))) &&
FUNCTOR(ARG(1,temp)) == SQRT &&
INTEGERP(ARG(0,ARG(1,temp)))
)
{ if(ARITY(temp) == 2)
*ans = make_fraction(ARG(1,temp),ARG(1,ARG(0,temp)));
else if(ARITY(temp) == 3)
*ans = product(make_fraction(ARG(1,temp),ARG(1,ARG(0,temp))),ARG(2,temp));
else
{ z = make_term('*',(unsigned short)(ARITY(temp)-2));
for(i=0;i<ARITY(z);i++)
ARGREP(z,i,ARG(i+2,temp));
*ans = product(make_fraction(ARG(1,temp),ARG(1,ARG(0,temp))),z);
}
}
else
*ans = temp;
}
SET_ALREADY(*ans);
return err; /* 0 if num or denom has already been simplified */
}
if(f=='^')
{ if(PROTECTED(ARG(0,temp)))
{ *ans = temp; /* already in fresh space */
SET_ALREADY(*ans);
return equals(ARG(1,temp),ARG(1,expr));
}
err2 = polyvalexp(temp,ans);
/* use of this auxiliary prevents out-of-memory on compiling polyval */
return !err ? 0 : err2;
}
if(f == IMAGPART)
{ term temp3;
temp2 = ARG(0,temp);
err2 = complexparts(temp2,&temp3,ans);
if(err2)
{ *ans = temp;
SET_ALREADY(*ans);
return err; /* tells whether arg of IMAGPART simplified or not */
}
if(ZERO(*ans))
destroy_term(temp);
return 0;
}
if(f == REALPART)
{ term temp3;
temp2 = ARG(0,temp);
err2 = complexparts(temp2,ans,&temp3);
if(err2)
{ *ans = temp;
SET_ALREADY(*ans);
return err; /* tells whether arg of REALPART simplified or not */
}
if(ZERO(*ans))
destroy_term(temp);
return 0;
}
assert(0);
return 1;
}
/*_____________________________________________________________________*/
int polyvalexp(term temp, term *ans)
/* finish polyval on exponents. This function does not
necessarily use fresh space, but if it does, it destroys temp.
(This is sensible because it is called from within polyval
and temp has been created locally, within polyval, so if it
is not used in *ans it should be destroyed.)
*/
{ term base,power,power2,a,b,c,u,v,w,zz,temp2,x,cancelled,trash;
aflag arithflag = get_arithflag();
int err,err2;
unsigned short i,j,n;
if(FUNCTOR(temp) != '^')
assert(0);
base = ARG(0,temp);
power = ARG(1,temp);
if(ISONE(base)) /* 1^a = 1 */
/* ISONE will cause 1.0 + roundoff to be replaced by 1 */
/* Otherwise we get things printing like 1^2 which are really 1.0^2 */
{ if(check1(domain(power))==0) /* assume the exponent is defined */
/* example: 1^(1/x) = 0 assuming x != 0 */
/* example: 1^(1/0) does not reduce by polyval */
/* This is a (rare) exception to the idea that polyval shouldn't call infer */
{ *ans = one;
return 0;
}
}
if(ONE(power)) /* a^1 = a */
{ *ans = base;
SET_ALREADY(*ans);
return 0;
}
if(polyvalzeropowerflag && ZERO(power))
{ *ans = one;
return 0;
}
if(ZERO(power))
/* don't apply a^0=1 in general but only when a isn't zero */
/* but don't try to infer a != 0 as polyval shouldn't call infer */
{ temp2 = base;
if(ALREADYARITH(temp2) && (AE(temp2) || CE(temp2)) && !ZERO(temp2))
{ *ans = one;
return 0;
}
if(equals(temp2,pi_term) || equals(temp2,eulere))
{ *ans = one;
return 0;
}
}
if(NEGATIVE(power) &&
!inderivflag &&
!inlimitflag &&
( polyvalnegexpflag == -1 ||
(polyvalnegexpflag == 0 && indenomflag2)
)
)
{ if(ONE(ARG(0,power)))
u = reciprocal(base);
else
u = reciprocal(make_power(base,ARG(0,power)));
polyval(u,ans);
return 0;
}
if(FUNCTOR(base) == ABSFUNCTOR && isinteger(power) && iseven(power))
{ polyval(make_power(ARG(0,base),power),ans); /* |x|^(2n) = x^(2n) */
return 0;
}
if(FUNCTOR(base) == SQRT && equals(power,two))
{ if(!get_polyvaldomainflag() || OBJECT(ARG(0,base)))
{ *ans = ARG(0,base);
return 0;
}
err = check1(le(zero,ARG(0,base)));
if(!err)
{ *ans = ARG(0,base);
return 0;
}
}
if(FUNCTOR(base) == SQRT)
{ term trash, newpower;
err = cancel(power,two, &trash, &newpower);
if(!err)
{ if(!get_polyvaldomainflag() || OBJECT(ARG(0,base)))
{ *ans = make_power(ARG(0,base),newpower);
return 0;
}
err = check1(le(zero,ARG(0,base)));
if(!err)
{ *ans = make_power(ARG(0,base),newpower);
return 0;
}
else
{ *ans = undefined;
return 1;
}
}
}
if(FUNCTOR(base) == ROOT && equals(ARG(0,base),power)
&& ISINTEGER(ARG(0,ARG(0,temp)))
)
{ /* root(n,x)^n = x */
unsigned long n = INTDATA(ARG(0,ARG(0,temp)));
if(n&1 || complex || !get_polyvaldomainflag() || OBJECT(ARG(1,base)))
/* odd or complex roots */
{ *ans = ARG(1,base);
return 0;
}
else
{ err = check1(le(zero,ARG(1,base)));
if(!err)
{ *ans = ARG(1,base);
return 0;
}
else
{ *ans = undefined;
return 1;
}
}
}
if(FUNCTOR(base) == ROOT && ISINTEGER(ARG(0,ARG(0,temp))))
{ /* root(n,x)^(nm) = x^m */
unsigned long n = INTDATA(ARG(0,ARG(0,temp)));
term trash,m;
err = cancel(power,ARG(0,ARG(0,temp)),&trash,&m);
if(!err)
{ if(n&1 || complex || !get_polyvaldomainflag() || OBJECT(ARG(1,base)))
/* odd or complex roots, or roots known to be defined */
{ *ans = make_power(ARG(1,base),m);
return 0;
}
else
{ err = check1(le(zero,ARG(1,base)));
if(!err)
{ *ans = make_power(ARG(1,base),m);
return 0;
}
else
{ *ans = undefined;
return 1;
}
}
}
}
if(polyvallogflag)
{ term w,illegal;
SETFUNCTOR(illegal,ILLEGAL,0);
if(equals(base,eulere) && FUNCTOR(power) == LN)
{ polyval(ARG(0,power),ans); /* e^ln x = x */
return 0;
}
if(equals(base,eulere) && FUNCTOR(power) == '*' &&
contains(power,LN) && !polyval_lninexponent2(temp,&w)
)
{ polyval(w,ans);
return 0;
}
if(equals(base,eulere) && FRACTION(power) && /* e^(ln(c)/a) = c^(1/a) */
FUNCTOR(ARG(0,power)) == LN
)
{ polyval(make_power(ARG(0,ARG(0,power)),reciprocal(ARG(1,power))),ans);
return 0;
}
if(equals(base,ten) && FRACTION(power) && /* 10^(log(c)/a) = c^(1/a) */
FUNCTOR(ARG(0,power)) == LOG
)
{ polyval(make_power(ARG(0,ARG(0,power)),reciprocal(ARG(1,power))),ans);
return 0;
}
if(FRACTION(power) && /* b^(log(b,c)/a) = c^(1/a) */
FUNCTOR(ARG(0,power)) == LOGB &&
equals(base,ARG(0,ARG(0,power)))
)
{ polyval(make_power(ARG(1,ARG(0,power)),reciprocal(ARG(1,power))),ans);
return 0;
}
if(equals(base,ten) && FUNCTOR(power) == LOG)
{ polyval(ARG(0,power),ans); /* 10^log x = x */
return 0;
}
if(INTEGERP(base) && FUNCTOR(power) == LN && !constant(power))
{ /* c^ln x = x^ln c */
/* This is needed in some limit calculations */
polyval(make_power(ARG(0,power),ln1(base)),ans);
return 0;
}
if(equals(base,ten) && FUNCTOR(power) == '*' &&
contains(power,LOG) && !polyval_loginexponent2(temp,&w)
)
{ polyval(w,ans);
return 0;
}
if(FUNCTOR(power) == LOGB && equals(ARG(0,power),base))
{ polyval(ARG(1,power),ans); /* b^log(b,x) = x */
return 0;
}
if(FUNCTOR(power) == '*' &&
contains(power,LOGB) && !polyval_logbinexponent2(temp,&w)
)
{ polyval(w,ans);
return 0;
}
if(FRACTION(power) && contains(power,LOGB) &&
!polyval_introducelogbinexponent(temp,illegal,&w)
)
{ polyval(w,ans);
return 0;
}
if(FUNCTOR(power) == '+' && ATOMIC(base) && log_in_sum(power))
{ /* c^(p log x + q) = c^p log x c^q */
int flag = 0;
n = ARITY(power);
v = make_term('*',n);
for(i=0;i<n;i++)
{ w = ARG(i,power);
if(FUNCTOR(w) == LN && equals(base,eulere))
{ ARGREP(v,i,ARG(0,w));
flag = 1;
}
else if(FUNCTOR(w) == LOG && equals(base,ten))
{ ARGREP(v,i,ARG(0,w));
flag = 1;
}
else if(FUNCTOR(w) == LOGB && equals(base,ARG(0,w)))
{ ARGREP(v,i,ARG(1,w));
flag = 1;
}
else
ARGREP(v,i,make_power(base,w));
}
if(flag)
{ polyval(v,ans);
return 0;
}
RELEASE(v);
}
if(FUNCTOR(power) == '*')
{ n = ARITY(power);
for(i=0;i<n;i++)
{ w = ARG(i,power);
if(FUNCTOR(w) == '+' && log_in_sum(w))
break;
}
if(i < n)
{ if(n == 2)
{ err2 = mvpolymult2(ARG(i?0:1,power),ARG(i?1:0,power),&w);
if(!err2 && !equals(w,power))
{ term p,q;
// worry about possible loop
polyval(base,&p);
polyval(power,&q);
*ans = make_power(base,power);
if(equals(p,base) && equals(q,power))
{ SET_ALREADY(*ans);
return 0;
}
polyval(make_power(base,w),ans);
return equals(temp,*ans) ? 1 : 0;
}
}
v = make_term('*',(unsigned short)(n-1));
for(j=0;j<n-1;j++)
ARGREP(v,j,ARG(j<i ? j : j+1,power));
err2 = mvpolymult2(v,ARG(i,power),&w);
if(!err2 && !equals(w,power))
{ term p,q;
polyval(make_power(base,w),ans);
if(equals(temp, *ans))
return 1;
if(FUNCTOR(*ans) != '^')
return 0;
// worry about a possible loop if we feed a power back into polyval
polyval(ARG(0,*ans),&p);
polyval(ARG(1,*ans),&q);
if(equals(p,ARG(0,*ans)) && equals(q,ARG(1,*ans)))
{ SET_ALREADY(*ans); // mark it done
return 0;
}
*ans = make_power(p,q);
return 0;
}
}
}
x = get_eigenvariable();
if(contains(base,FUNCTOR(x)) && contains(power,FUNCTOR(x)))
{ if(FRACTION(power) &&
!cancel(log1(base), ARG(1,power),&cancelled,&trash) &&
!polyval_introduceloginexponent(temp,&w)
)
{ polyval(w,ans);
return 0;
}
if(FRACTION(power) &&
!cancel(ln1(base), ARG(1,power),&cancelled,&trash) &&
!polyval_introducelninexponent(temp,&w)
)
{ polyval(w,ans);
return 0;
}
if(contains(temp,LOGB) &&
FRACTION(power) && contains(ARG(1,power),LOGB) &&
!polyval_introducelogbinexponent(temp,illegal,&w)
)
{ polyval(w,ans);
return 0;
}
}
}
if(FUNCTOR(power) == '^' && !equals(ARG(0,power),eulere) && FUNCTOR(ARG(1,power)) == '-')
/* a^(u^(-n)) = a^(1/u^n) */
/* eliminate negative exponents in exponents, except not in u^(e^-x) */
{ term u = ARG(0,power);
term n = ARG(0,ARG(1,power));
if(ATOMIC(n))
{ if(ONE(n))
temp2 = make_power(base,make_fraction(one,u));
else
temp2 = make_power(base,make_fraction(one,make_power(u,n)));
polyval(temp2,ans);
destroy_term(temp2);
return 0;
}
}
if(FUNCTOR(base)=='*') /* apply (ab)^c = a^c b^c */
{ unsigned short m = ARITY(base);
temp2 = make_term('*',m);
for(i=0;i<m;i++)
{ v = ARG(i,base);
if(!ATOMIC(power))
copy(power,&power2); /* avoid creating DAGs */
else
power2 = power;
w = make_power(v,power2);
if(numerical(w) && !contains_big_exponents(w))
{ err = value(w,ARGPTR(temp2)+i);
if(err)
ARGREP(temp2,i,w);
}
else if(INTEGERP(power) ||
complex ||
(NEGATIVE(power) && INTEGERP(ARG(0,power))) ||
(RATIONALP(power) && ISODD(ARG(1,power))) ||
(NEGATIVE(power) && RATIONALP(ARG(0,power)) && ISODD(ARG(1,ARG(0,power))))
)
ARGREP(temp2,i,w);
else if(RATIONALP(power))
{ err = polyvalrootproductflag ? check1(le(zero,v)) :
infer(le(zero,v));
if(err)
{ *ans = temp;
/* (ab)^n=a^nb^n requires a^n and b^n defined. */
RELEASE(temp2);
return 1;
}
ARGREP(temp2,i,w);
}
else
{ err = polyvalrootproductflag ? check1(domain(w)):
infer(domain(w));
if(err)
{ *ans = temp;
RELEASE(temp2);
return 1;
}
ARGREP(temp2,i,w);
}
}
polyval(temp2,ans);
destroy_term(temp);
/* don't RELEASE the args of temp2, because some of them may
be numbers produced by value, and make_power might not have
actually allocated something. You could allocate m flags
and keep track of which args could be freed, but it would
slow things down, and this is a minor memory leak. */
RELEASE(temp2);
return 0;
}
/* apply laws a^b^c = a^(bc); or law i^2 = -1 ; or (-a)^n = (-1)^na^n */
assert(FUNCTOR(base) != '*'); /* or it would have been caught above */
if(FUNCTOR(base) == '-' && !ISONE(ARG(0,base)))
{ term nn = ARG(1,temp);
if(isinteger(nn) ||
(FRACTION(nn) && isinteger(ARG(0,nn)) && INTEGERP(ARG(1,nn)) && ISODD(ARG(1,nn)))
)
{ w = make_power(ARG(0,base),nn);
v = make_power(minusone,nn);
polyval(product(v,w),ans);
RELEASE(v);
RELEASE(w);
destroy_term(temp);
return 0;
}
*ans = temp;
return 1;
}
if(equals(base,complexi) && constant(complexi) && arithflag.complex)
{ /* apply law i^2 = -1 */
/* testing arithflag.complex means we don't use this law when
the topic is _complex_arithmetic, because polyval1 is called
indirectly when multiplying out (a+bi)(c+di), and we don't get
enough detail if this is used. On all other topics involving
complex numbers, arithflag.complex will be 1. */
w = ARG(1,temp);
err = cancel(w,two,&zz,&v);
if(err)
{ *ans = temp;
SET_ALREADY(*ans);
return err;
}
temp2 = make_power(minusone,v);
polyval(temp2,ans); /* maybe v was even, so more should be done */
destroy_term(temp);
destroy_term(temp2); /* cancel put v in fresh space so
temp2 is all in fresh space */
return 0;
}
if(FRACTION(base) &&
!inderivflag && !inlimitflag &&
!contains(power, LIMIT) &&
!contains(power, DIFF) &&
!contains(power, SUM) &&
!contains(power, INTEGRAL) &&
(!get_polyvaldomainflag() ||
(!contains_undefined(power) && !check1(domain(power)))
)
/* see explanation in postops.c, search for "don't do this" */
)
/* apply (a/b)^n = a^n/b^n except inside derivatives and limits,
or when unevaluated limits, sums, integrals, or derivatives
are in the exponent */
/* that's what auto mode does on pass 0; on pass 1 auto mode
WILL do it inside limits, but polyval doesn't. */
{ term num, denom;
num = make_power(ARG(0,base),power);
denom = make_power(ARG(1,base),power);
/* don't apply (a/b)^n = a^n/b^n unless both a^n and b^n are defined */
if(!INTEGERP(power) && !(RATIONALP(power) && ISODD(ARG(1,power))))
{ err = OBJECT(ARG(0,base)) ? 0 : infer(domain(num));
if(err)
{ *ans = temp;
return 1;
}
err = OBJECT(ARG(1,base)) ? 0 : infer(domain(denom));
if(err)
{ *ans = temp;
return 1;
}
}
temp2 = make_fraction(num,denom);
polyval(temp2,ans);
if(FUNCTOR(ARG(0,temp2)) == '^')
RELEASE(ARG(0,temp2));
if(FUNCTOR(ARG(1,temp2)) == '^')
RELEASE(ARG(1,temp2));
assert(FRACTION(temp2));
RELEASE(temp2);
destroy_term(temp); /* not destroy_term(temp2) because power
has a duplicate occurrence in temp2 */
return 0;
}
if(ATOMIC(base) || FUNCTOR(base) != '^')
{ *ans = temp;
SET_ALREADY(*ans);
return 1;
}
/* Now FUNCTOR(base) == '^' */
a = u = ARG(0,base);
b = v = ARG(1,base);
/* We have to prevent ((-1)^2)^(1/2)= -1 etc.*/
/* following conditions are copied from powertopower in exponent.c,
but 'check' is changed to 'infer' */
c = power;
/* (a^b)^c= a^(b c) provided either
a > 0 and c is an integer, or
a >=0 and both b and c are positive.
And, it also works e.g. in case b = 4, c = 1/5; the point
is that there must not be a cancellation of 2 in bc,
as in ((-1)^2)^(1/2). Indeed (-1)^(u/v)^(p/q) is
(u even ? 1 : v even ? undefined : -1)^(p/q) =
u even ? 1 : v even ? undefined : p even ? 1 : q even ? undefined: -1
while (-1)^(up/vq) = up even ? 1 : vq even ? undefined : -1
PROVIDED there's no cancellation of 2 in up/vq.
*/
if(isinteger(c))
err = 0;
else if(obviously_positive(a))
err = 0;
else if(FRACTION(c) && isinteger(ARG(0,c)) && isinteger(ARG(1,c)) &&
isinteger(b) &&
(isodd(ARG(1,c)) || isodd(b))
)
err = 0;
else if(FRACTION(b) && FRACTION(c) &&
isinteger(ARG(0,b)) && isinteger(ARG(1,b)) &&
isinteger(ARG(0,c)) && isinteger(ARG(1,c)) &&
(isodd(ARG(1,c)) || isodd(ARG(0,b))) &&
(isodd(ARG(0,c)) || isodd(ARG(1,b)))
)
err = 0;
else if(obviously_positive(b) && obviously_positive(c))
{ /* long computations ensue if we say infer(le(zero,a)), and a is a tower of exponentials */
term aa,bb;
if(FUNCTOR(a) != '^')
err = infer(le(zero,a));
else
{ err = 1;
bb = ARG(1,a);
for(aa = a; FUNCTOR(aa) == '^'; bb = ARG(1,aa))
{ aa = ARG(0,aa);
if(iseven(bb))
{ err = 0;
break;
}
}
if(err)
{ if(obviously_positive(aa))
err = 0; /* ((2^p)^b)^c) */
else
err = 1;
}
}
}
else if(mvpoly2(a) && !(contains(a,'+') && contains(a,'^')))
err = infer(lessthan(zero,a));
/* don't miss it if a is a limit variable or variable of
definite integration which has to be positive. */
else
err = 1;
/* It still could be true if type(c,INTEGER) or lessthan(zero,a);
but if these conditions haven't been verified above it's not
likely they will be verified now, and it can cause a lengthy
regress and out-of-space error. */
if(err)
{ *ans = temp;
return 1;
}
zz = product(v,ARG(1,temp));
polyval(zz,&w);
if(ONE(w))
copy(u,ans);
else if(ZERO(w))
*ans = one;
else
{ *ans = make_term('^',2);
copy(u,ARGPTR(*ans));
ARGREP(*ans,1,w);
}
destroy_term(temp);
SET_ALREADY(*ans);
return 0;
}
/*_______________________________________________________________*/
static int possibly_undefined(term t)
/* return 1 if t contains an undefined atom or the functor LIMIT */
{ unsigned short i,n;
if(ATOMIC(t))
return NOTDEFINED(t);
if(FUNCTOR(t) == LIMIT || (FUNCTOR(t) == INTEGRAL && IMPROPER(t)))
return 1;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(possibly_undefined(ARG(i,t)))
return 1;
}
return 0;
}
/*_______________________________________________________________*/
static int simpdenom(term temp, term *ans)
/* denom(p \pm integer) = denom(p); */
/* used by the prover to simplify assumptions */
{ term vv = ARG(0,temp);
if(FUNCTOR(vv) != '+' || ARITY(vv) != 2)
return 1;
if(
INTEGERP(ARG(1,vv)) ||
(NEGATIVE(ARG(1,vv)) && INTEGERP(ARG(0,ARG(1,vv))))
)
{ *ans = make_term(DENOM,1);
ARGREP(*ans,0,ARG(0,vv));
SET_ALREADY(*ans);
return 0;
}
return 1;
}
/*_______________________________________________________________*/
static int polyval_seminumerical(unsigned f, term temp, term *ans)
/* finish polyval on seminumerical terms. */
/* This was broken out of polyval because the compiler ran out of
memory on polyval.
Return values are as for polyval, including 49 for out of space.
*/
{ double z;
long k,kk,jj;
int err,sign;
term u;
int err3;
if(f==SIN || f == COS || f == TAN || f == SEC || f == CSC || f == COT)
{ u = ARG(0,temp);
if(FUNCTOR(u) == DEG)
{ u = ARG(0,u);
deval(u,&z);
if(nearint(z,&kk))
{ if(kk < 0)
{ sign = -1;
kk = -kk;
}
else
sign = 1;
kk = kk % 360;
jj = kk % 90;
if( jj != 0 && jj != 30 && jj != 45 && jj != 60)
{ copy(temp,ans);
SET_ALREADY(*ans);
return 1;
}
*ans = trig_aux(f,kk);
if(sign < 0 && (f == SIN || f == CSC || f == TAN || f == COT))
/* those are the four odd functions */
*ans = tnegate(*ans);
return 0;
}
}
else /* not in degrees */
{ u = ARG(0,temp);
if(ZERO(u))
{ switch(f)
{ case SIN:
*ans = zero;
return 0;
case SEC:
*ans = one;
return 0;
case COS:
*ans = one;
return 0;
case TAN:
*ans = zero;
return 0;
case COT:
/* fall through */
case CSC:
copy(temp,ans);
SET_ALREADY(*ans);
return 1;
}
}
else
{ term s = make_fraction(product(make_int(12),u),pi_term);
err = deval(s,&z);
if(err || !nearint(z,&kk))
{ RELEASE(s);
copy(temp,ans);
SET_ALREADY(*ans);
return 1;
}
if(kk < 0)
{ kk = -kk;
sign = -1;
}
else
sign = 1;
kk = kk % 24;
if(kk % 6 == 1 || kk % 6 == 5) /* can't do 15 degrees */
{ RELEASE(s);
copy(temp,ans);
SET_ALREADY(*ans);
return 1;
}
kk *= 15; /* convert to degrees */
*ans = trig_aux(f,kk);
if(sign < 0 && (f == SIN || f == CSC || f == TAN || f == COT))
/* those are the four odd functions */
*ans = tnegate(*ans);
SET_ALREADY(*ans);
return 0;
}
}
}
err3 = deval(temp,&z);
if(!err3 && nearint(z,&k)) /* this will get ln 1 = 0, etc. */
{ if(k==0)
*ans = INEQUALITY(f) ? falseterm : zero;
else if(k==1)
*ans = INEQUALITY(f) ? trueterm : one;
else
*ans = make_int(k);
SET_ALREADY(*ans);
return equals(*ans,temp); /* That is, 0 if they're not equal, 1 if they are */
}
if(!err3 && fabs(z) < 400.0 && nearint(z*z,&k))
/* this will get arctan(1) = \sqrt 2 etc. */
{ if(k==0)
*ans = zero;
else if(k==1)
*ans = z<0.0 ? minusone: one;
else
{ /* the answer is \pm \sqrt k; but if k is even, we want
to simplify by bring out a factor if possible,
e.g. \sqrt 12 = 2\sqrt 3. Following the code of sqrtsimp: */
term mid,out,in;
unsigned nfactors;
int err4;
term kk = make_int(k);
factor_long(k,&nfactors,&mid);
if(FUNCTOR(mid) == ILLEGAL)
return 49; /* out of space in factor_long */
if(!OBJECT(mid)) /* kk did factor */
{ err4 = radsimpaux(two,mid,&out,&in);
if(!err4)
{ temp = product(out,make_sqrt(in));
err4 = value(temp,ans);
if(err4 != 0 && err4 != 2)
*ans = temp;
}
else
*ans = sqrt1(kk);
if(z < 0.0)
*ans = tnegate(*ans);
}
else if(polyvalfractexpflag)
*ans = z < 0.0 ? tnegate(make_power(kk, make_fraction(one,two))): make_power(kk, make_fraction(one,two));
else
*ans = z < 0.0 ? tnegate(sqrt1(kk)) : sqrt1(kk);
}
if(!ATOMIC(*ans))
SET_ALREADY(ARG(0,*ans));
SET_ALREADY(*ans);
return equals(*ans,temp); /* e.g. on \sqrt 3 there's no change! */
}
return 1;
}
/*______________________________________________________________*/
int rawcollectpowers(term t, term *next, int flag)
/* do the work of collectpowers */
/* If flag is nonzero, do arithmetic on the exponents */
{ unsigned short i,j,k,count,err;
term a,base;
term newexp,newexp1,newfactor;
unsigned short n = ARITY(t);
int *scratchpad;
if(FUNCTOR(t) != '*')
return 1; /* inapplicable */
scratchpad = callocate(n,sizeof(int));
if(scratchpad==NULL)
nospace();
for(i=0;i<n;i++)
{ a = ARG(i,t);
if(FUNCTOR(a) == '^')
base = ARG(0,a);
else
base = a;
/* Now go through the rest of the args to see if anything collects
with a; at first just count how many terms WILL collect and
record their indices in scratchpad */
count = 0;
for(j=i+1;j<n;j++)
{ if(equals(ARG(j,t),base) ||
(FUNCTOR(ARG(j,t)) == '^' && equals(ARG(0,ARG(j,t)),base))
)
{ scratchpad[j] = 1;
++count;
}
}
if(count) /* something collects with a */
{ scratchpad[i] = 1;
newexp = make_term('+',(unsigned short)(count+1));
k=0; /* put the next exponent as the k-th arg of newexp */
for(j=i;j<n;j++)
{ if(scratchpad[j] == 1)
{ if(FUNCTOR(ARG(j,t))=='^')
{ if(FUNCTOR(base) == '^' && equals(ARG(j,t),base))
ARGREP(newexp,k,one);
else
ARGREP(newexp,k,ARG(1,ARG(j,t)));
}
else
ARGREP(newexp,k,one);
++k;
}
}
if(!flag)
newexp1 = newexp;
else
{ err = arith(newexp,&newexp1,get_arithflag());
if(err != 0 && err != 2)
newexp1 = newexp; /* error in arith, e.g. exponents */
else
RELEASE(newexp);
}
if(ISZERO(newexp1)) /* sum of exponents is zero, factor disappears */
{ if(n==count+1) /* all terms collect to 1 */
{ *next = one;
SETCOLOR(*next,YELLOW);
return 0;
}
if(n==count+2) /* all but one term is disappearing */
{ /* which one is it?-- the k with scratchpad[k]==0 */
k=0;
while(scratchpad[k] != 0)
++k;
*next = ARG(k,t);
SETCOLOR(*next,YELLOW);
return 0;
}
/* now there will still be at least two factors */
*next = make_term('*',(unsigned short)(n-count-1));
for(j=0;j<i;j++) ARGREP(*next,j,ARG(j,t));
k=i; /* place to put next factor not collected */
for(j=i+1;j<n;j++)
{ if(!scratchpad[j])
{ ARGREP(*next,k,ARG(j,t));
++k;
}
}
SETCOLOR(*next,YELLOW);
free2(scratchpad);
return 0;
}
else if(ISONE(newexp1))
newfactor = base;
else
newfactor = make_power(base,newexp1);
HIGHLIGHT(newfactor);
/* now create a new term *next containing newfactor where 'a' was */
if(n-count == 1) /* collected all terms to one */
{ *next = newfactor;
free2(scratchpad);
return 0;
}
/* now there are at least two factors left over */
*next = make_term('*',(unsigned short)(n-count));
for(j=0;j<i;j++)
ARGREP(*next,j,ARG(j,t));
ARGREP(*next,i,newfactor);
k=i+1; /* place to put next factor not collected */
for(j=i+1;j<n;j++)
{ if(!scratchpad[j])
{ ARGREP(*next,k,ARG(j,t));
++k;
}
}
free2(scratchpad);
return 0;
}
/* nothing collects with ARG(i,t), continue in the i-loop */
}
/* if we make it here, nothing collects at all */
return 1;
}
/*_____________________________________________________________________*/
term multiply_cancel_and_order(term a, term b)
/* compute the product of a and b, performing cancellations and collecting powers,
and put the resulting term (or its num and denom) in correct order.
*/
{ term p,q,r,v,w,cancelled,ans,temp,c,s;
int err,cancelflag=0;
unsigned short f = FUNCTOR(a);
unsigned short g = FUNCTOR(b);
unsigned short i,j,n;
int ringflag = (get_ringflag() & RATRING);
if(f == '-')
{ if(FUNCTOR(b) == '-')
return multiply_cancel_and_order(ARG(0,a),ARG(0,b));
return tnegate(multiply_cancel_and_order(ARG(0,a),b));
}
if(g == '-')
return tnegate(multiply_cancel_and_order(a,ARG(0,b)));
if(f == '/' && equals(ARG(1,a),b))
return ARG(0,a); /* do this fast */
if(g == '/' && equals(ARG(1,b),a))
return ARG(0,b);
if(f == '/' && (g == '*' || g == '^') && !cancel(b,ARG(1,a),&cancelled,&temp))
{ p = ONE(ARG(0,a)) ? temp : multiply_cancel_and_order(ARG(0,a),temp);
if(ringflag && !seminumerical(b) && FRACTION(temp))
{ ratpart2(p,&c,&s);
return product(c,s);
}
return p;
}
if(g == '/' && (f == '*' || f == '^') && ! cancel(a,ARG(1,b),&cancelled,&temp))
{ p = ONE(ARG(0,b)) ? temp : multiply_cancel_and_order(ARG(0,b),temp);
if(ringflag && !seminumerical(b) && FRACTION(temp))
{ ratpart2(p,&c,&s);
return product(c,s);
}
return p;
}
if(RATIONALP(a) && g == '*' && !infractionflag &&
(get_ringflag() & RATRING) &&
(
(FUNCTOR(ARG(0,b)) == SQRT && INTEGERP(ARG(0,ARG(0,b)))) ||
(FUNCTOR(ARG(0,b)) == ROOT && INTEGERP(ARG(1,ARG(0,b))))
)
)
/* example: (1/2) * sqrt(3) t = (sqrt(3)/2) t */
{ mfracts(a,ARG(0,b),&p);
ans = make_term('*',ARITY(b));
ARGREP(ans,0,p);
for(i=1;i<ARITY(ans);i++)
ARGREP(ans,i,ARG(i,b));
return ans;
}
if(RATIONALP(a) && g == '*' && !infractionflag &&
(get_ringflag() & RATRING) &&
(INTEGERP(ARG(0,b)) || RATIONALP(ARG(0,b)))
) /* example: (1/3) * 2 sin t = (2/3) sin t, not (2 sin t)/3;
provided we're not inside a compound fraction
*/
{ term temp,ans;
value(product(a,ARG(0,b)),&temp);
if(ONE(temp) && ARITY(b) == 2)
ans = ARG(1,b);
else if(!ONE(temp))
{ ans = make_term('*',ARITY(b));
ARGREP(ans,0,temp);
for(i=1;i<ARITY(b);i++)
ARGREP(ans,i,ARG(i,b));
}
else
{ ans = make_term('*',(unsigned short)(ARITY(b)-1));
for(i=1;i<ARITY(b);i++)
ARGREP(ans,i-1,ARG(i,b));
}
return ans;
}
if(POSNUMBER(a) && POSNUMBER(b))
{ mfracts(a,b,&p);
err = value(p,&ans);
if(err)
ans = p;
return ans;
}
if(RATIONALP(a) &&
(get_ringflag() & RATRING) &&
!infractionflag && /* we're not in a compound fraction */
!(g == SQRT && INTEGERP(ARG(0,b))) && /* don't produce (1/2) sqrt 2
even if ringflag & RATRING */
(
(g == '*' && ! contains_at_toplevel(b,'/')) ||
/* example: (1/3) x sin x, not (x sin x)/3 */
(ARITY(b) == 1 && /* example: (1/3) log x, not (log x)/3 */
!OBJECT(b) /* remember objects have arity 1 */
)
)
)
{ err = cancel(b,ARG(1,a),&cancelled,&p);
if(err)
return product(a,b);
if(equals(cancelled,ARG(1,a)))
return ONE(ARG(0,a)) ? p : product(ARG(0,a),p);
polyval(make_fraction(product(ARG(0,a),cancelled),ARG(1,a)),&q);
return product(q,p);
}
if(!infractionflag &&
(g == INTEGRAL || g == LIMIT || g == DIFF || g == SUM ||
f == INTEGRAL || f == LIMIT || f == DIFF || f == SUM
)
)
return product(a,b);
if((f == '/' && g == '*') || (f == '*' && g == '/') ||
(f == '/' && ARITY(b) == 1 && contains(b,'/'))
/* e.g. 1/sqrt 3 arctan (x/ sqrt 3) */
)
{ w = product(a,b);
if(FUNCTOR(w) == '*')
{ err = multiplyfractions_aux2(product(a,b),&p);
if(err)
p = w;
}
/* Not just mfracts, or we may create fractions with
integrals, limits, or sums in the numerator */
else
p = w;
}
else if(f == '/' || g == '/')
mfracts(a,b,&p);
else if (g == '*' &&
contains_at_toplevel(b,'/')
)
/* Example: multiplying (1/sqrt 2) u by sqrt 2, we want the
sqrt(2) to cancel. */
{ term num,denom,z;
int k=0,j=0;
unsigned short m = ARITY(b);
num = make_term('*',(unsigned short)(m+1));
denom = make_term('*',(unsigned short)(f == '/' ? m : m+1));
ARGREP(num,0,a);
++j;
for(i=0;i<ARITY(b);i++)
{ z = ARG(i,b);
if(FRACTION(z))
{ if(!ONE(ARG(0,z)))
{ ARGREP(num,j,ARG(0,z));
++j;
}
ARGREP(denom,k,ARG(1,z));
++k;
}
else
{ ARGREP(num,j,z);
++j;
}
}
if(k == 0)
assert(0);
if(k == 1)
{ z = ARG(0,denom);
RELEASE(denom);
denom = z;
}
else
SETFUNCTOR(denom,'*',k);
if(j == 0)
{ RELEASE(num);
num = one;
}
if(j == 1)
{ z = ARG(0,num);
RELEASE(num);
num = z;
}
else
SETFUNCTOR(num,'*',j);
p = make_fraction(num,denom);
if(FRACTION(p) && !cancel(ARG(0,p),ARG(1,p),&q,&r))
{ if(FRACTION(r) && INTEGERP(ARG(1,r)) && (get_ringflag() & RATRING))
{ ratpart2(r,&c,&s);
p = product(c,s);
}
else
p = r;
}
else
p = product(a,b);
/* example: if b = (sqrt(2)/2) cos((1/4)arctan u), we
don't want to make a fraction with denom 2, so don't keep
the result of all this unless there's really a cancellation. */
cancelflag = 1; /* don't apply cancel to a few lines below. */
}
else
p = product(a,b);
if(FUNCTOR(p) == '/' && ! cancelflag)
{ err = cancel(ARG(0,p),ARG(1,p),&q,&r);
if(err)
r = p;
}
else if (FUNCTOR(p) == '*' && FRACTION(ARG(0,p)))
{ /* this happens e.g. if a = 1/x and b = x dy/dx; then p = (x/x) dy/dx */
err = cancel(ARG(0,ARG(0,p)),ARG(1,ARG(0,p)),&cancelled,&v);
if(!err)
{ if(ONE(v) && ARITY(p) == 2)
r = ARG(1,p);
else if(ONE(v))
{ r = make_term('*', (unsigned short)(ARITY(p)-1));
for(i=0;i<ARITY(r);i++)
ARGREP(r,i,ARG(i+1,p));
}
else
{ r = make_term('*',ARITY(p));
ARGREP(r,0,v);
for(i=1;i<ARITY(r);i++)
ARGREP(r,i,ARG(i,p));
}
}
else
r=p;
}
else
r=p;
if(FUNCTOR(r) == '/' || FUNCTOR(r) == '*')
{ /* make a top-level copy so we can tinker with the args without
disturbing the original arguments */
v = make_term(FUNCTOR(r),ARITY(r));
for(i=0;i<ARITY(r);i++)
ARGREP(v,i,ARG(i,r));
r = v;
}
if(FUNCTOR(r) == '*')
{ err = rawcollectpowers(r,&q,1);
if(!err)
r = q;
}
else if(FUNCTOR(r) == '/')
{ if(FUNCTOR(ARG(0,r)) == '*')
{ err = rawcollectpowers(ARG(0,r),&q,1);
if(!err)
ARGREP(r,0,q);
}
if(FUNCTOR(ARG(1,r)) == '*')
{ err = rawcollectpowers(ARG(1,r),&q,1);
if(!err)
ARGREP(r,1,q);
}
}
if(FUNCTOR(r) == '*')
sortargs(r);
else if(FUNCTOR(r) == '/')
{ if(FUNCTOR(ARG(0,r)) == '*')
sortargs(ARG(0,r));
if(FUNCTOR(ARG(1,r)) == '*')
sortargs(ARG(1,r));
}
value(r,&ans);
if(FUNCTOR(ans) == '*') /* remove any factors of 1 */
{ n = ARITY(ans);
if(n==2)
{ if(ONE(ARG(0,ans)))
return ARG(1,ans);
if(ONE(ARG(1,ans)))
return ARG(0,ans);
return ans;
}
for(i=0;i<n;i++)
{ if(ONE(ARG(i,ans)))
break;
}
if(i<n) /* delete ARG(i,ans) */
{ r = ans;
ans = make_term('*',(unsigned short)(n-1));
for(j=0;j<i;j++)
ARGREP(ans,j,ARG(j,r));
for(j=i;j<n-1;j++)
ARGREP(ans,j,ARG(j+1,r));
}
}
return ans;
}
/*____________________________________________________________________*/
#define OMIT(f,u) ( (f) == DIFF || (f) == INTEGRAL || (f) == LIMIT || ((f) == '+' && (contains(u,DIFF) || contains(u,INTEGRAL) || contains(u,LIMIT) || contains(u,SUM) || contains_fract(u))))
static int multiplyfractions_aux2(term t, term *next)
/* Similar to multiplyfractions_aux in fraction.c, but independent of
the user model and produces no reason string. */
/* multiply (a/b)(c/d) = ac/(bd) or a(b/c) = ab/c, even in products
with many factors; do all fractions at once if more than two to multiply.
It calls mfracts to do the actual multiplying, and mfracts does not
multiply rational numbers if ringflag == RATIONAL, so it can happen
that there are fractions and they don't get multiplied.
In this case *next will be set equal to t.
There are certain terms which should not be multiplied
into fractions: limits, derivatives, integrals, sums containing
fractions, limits, derivs, or integrals. This will be done only
if (1) we're in menu mode and (2) otherwise there's nothing to do.
*/
{ term temp,sofar;
int flag=0; /* how many fractions there are in t */
int omitflag = 0; /* use to see if there are limits or integrals or derivatives in the product */
unsigned short i,n = ARITY(t);
term u,v,w;
unsigned short f;
int err;
if(FUNCTOR(t) != '*')
return 1; /* inapplicable */
for(i=0;i<n;i++)
{ w = ARG(i,t);
f = FUNCTOR(ARG(i,t));
if(f == '/')
++flag;
if(OMIT(f,w))
++omitflag;
if(ARITY(w)==1 && contains(w,'/'))
++omitflag; /* example, 1/sqrt 3 arctan(x/sqrt 3) */
/* don't multiply this out */
if(equals(w,complexi))
++omitflag; // don't multiply out (1/2) i to i/2, it causes a loop
}
if(flag==0)
return 1; /* no fractions in t */
if(flag==1 && omitflag == n-1)
return 1; /* one fraction and some terms to omit, leave alone */
/* The next clause takes care of (3/5) sqrt(3) x producing ( 3 sqrt(3)/5) x
instead of 3 sqrt(3) x/ 5 */
if(n > 2 && flag == 2 && (get_ringflag() & RATRING) && !get_polyvalcomdenomflag() &&
RATIONALP(ARG(0,t)) &&
FRACTION(ARG(1,t)) && INTEGERP(ARG(1,ARG(1,t))) && !ZERO(ARG(1,ARG(1,t))) &&
canonical(0,ARG(1,t))
)
{ surdsimp(product(ARG(0,t),ARG(1,t)),&temp);
if(n == 3)
{ *next = product(temp,ARG(2,t));
return 0;
}
*next = make_term('*',(unsigned short)(n-1));
ARGREP(*next,0,temp);
for(i=1;i<n-1;i++)
ARGREP(*next,i,ARG(i+1,t));
return 0;
}
if(omitflag && omitflag != n-1) /* don't multiply in the terms to be omitted */
{ /* put the limits and integrals in v, the other terms in u */
int j,k;
u = make_term('*',n);
v = make_term('*',n);
j=k=0;
for(i=0;i<n;i++)
{ w = ARG(i,t);
f = FUNCTOR(w);
if(OMIT(f,w) || (ARITY(w)==1 && contains(w,'/')) || equals(w,complexi))
{ ARGREP(v,k,w);
++k;
}
else
{ ARGREP(u,j,w);
++j;
}
}
assert(j>1);
SETFUNCTOR(u,'*',j);
assert(k>0);
if(k==1)
{ temp = ARG(0,v);
RELEASE(v);
v = temp;
}
else
SETFUNCTOR(v,'*',k);
err = multiplyfractions_aux2(u,&temp);
if(err)
{ *next = t;
return 1;
}
SETCOLOR(temp,YELLOW);
*next = product(temp,v);
if(equals(*next,t))
return 1; /* this can happen if e.g. u contained only a rational */
return 0;
}
if(n==2)
{ mfracts(ARG(0,t),ARG(1,t),next);
if(equals(t,*next))
/* in case of a rational times an atom, mfracts may not actually
do the multiplying, if ringflag & RATRING, but we want it done
anyway in a fraction.
*/
{ if(infractionflag && RATIONALP(ARG(0,t)) && ISATOM(ARG(1,t)))
{ *next = make_fraction(product(ARG(0,ARG(0,t)),ARG(1,t)),ARG(1,ARG(0,t)));
return 0;
}
if(infractionflag && RATIONALP(ARG(1,t)) && ISATOM(ARG(0,t)))
{ *next = make_fraction(product(ARG(0,ARG(1,t)),ARG(0,t)),ARG(1,ARG(1,t)));
return 0;
}
return 1;
}
}
else
{ /* Now t is a product of 3 or more factors */
temp = ARG(0,t);
for(i=1;i<n;i++)
{ if(RATIONALP(temp) && !FRACTION(ARG(i,t)))
/* Multiply them out anyway, (3/5) x = 3x/5 */
sofar = make_fraction(product(ARG(0,temp),ARG(i,t)),ARG(1,temp));
else if(RATIONALP(ARG(i,t)) && !FRACTION(temp))
sofar = make_fraction(product(ARG(0,ARG(i,t)),temp),ARG(1,ARG(i,t)));
else
mfracts(temp,ARG(i,t),&sofar);
temp = sofar;
}
if(equals(t,sofar))
return 1; /* can happen if MATRIX terms are involved */
*next = sofar;
}
if(FRACTION(*next))
/* It might not be a fraction if some numerical fractions
were multiplied out but ringflag == RATIONAL so that
they are not multiplied into the symbolic part
*/
{ for(i=0;i<2;i++)
{ temp = ARG(i,*next);
if(FUNCTOR(temp) == '*')
{ err = rawcollectpowers(temp,&sofar,1);
if(!err)
ARGREP(*next,i,sofar);
}
}
}
HIGHLIGHT(*next);
return 0;
}
/*___________________________________________________________*/
static int eliminatenegexp2(term t, term *next)
/* like eliminatenegexp in exponent.c, but does not refer to
the user model or bother to produce a reason string.
*/
{ int err,err2;
char buffer[40];
int somethingdone = 0;
int count,k;
unsigned short i,n;
term num,denom,arg;
term a,b,u,temp;
if(FUNCTOR(t)=='^')
{ a = ARG(0,t);
b = ARG(1,t);
if(NEGATIVE(b) &&
/* leave e^(-x) alone except occurring as e^(-ln x) */
constant(a) &&
!constant(b) &&
(
(FUNCTOR(ARG(0,b)) == LN && equals(a,eulere)) ||
(FUNCTOR(ARG(0,b)) == LOG && equals(a,ten)) ||
(FUNCTOR(ARG(0,b)) == LOGB && equals(a,ARG(0,ARG(0,b))))
)
)
return 1;
if(polyvalnegexpflag == -1 &&
(contains_neg_exp(a) || contains_neg_exp(b) )
)
return 1; /* fail, eliminate the inside negexp first */
err = negexp_aux(t,&u);
if(err)
return 1;
*next = reciprocal(make_power(a,u));
SETCOLOR(*next,YELLOW);
return 0;
}
if(FUNCTOR(t)=='*')
{ n = ARITY(t);
num = make_term('*',n); /* be sure to have enough space */
denom = make_term('*',n);
count = 0; /* count the negative exponents in t */
k = 0; /* mark the place in num */
if(polyvalnegexpflag==-1)
{ for(i=0;i<n;i++)
{ if(contains_neg_exp(ARG(i,t)))
return 1;
/* fail, should eliminate the inside neg exp first */
}
}
for(i=0;i<n;i++)
{ arg = ARG(i,t);
if(FUNCTOR(arg) == '^' || FRACTION(arg))
{ a = ARG(0,arg);
b = ARG(1,arg);
}
if( /* leave e^(-x) alone except occurring as e^(-ln x) */
FUNCTOR(arg) == '^' &&
constant(a) && NEGATIVE(b)&&
!constant(b) &&
!(FUNCTOR(ARG(0,b)) == LN && equals(a,eulere)) &&
!(FUNCTOR(ARG(0,b)) == LOG && equals(a,ten)) &&
!(FUNCTOR(ARG(0,b)) == LOGB && equals(a,ARG(0,ARG(0,b))))
)
{ ARGREP(num,k,arg);
++k;
continue;
}
if( FUNCTOR(arg) == '^' && !negexp_aux(arg,&u))
{ ARGREP(denom,count,make_power(a,u));
++ count;
++ somethingdone;
}
else if(FRACTION(arg)) /* (a/b)c^(-n) = a/(bc^n) */
{ if(!ONE(a))
{ ARGREP(num,k,a);
++k;
}
ARGREP(denom,count,b);
++count;
}
else
{ ARGREP(num,k,arg);
++k;
}
}
SETFUNCTOR(num,'*',k);
SETFUNCTOR(denom,'*',count);
if(count == 0 || somethingdone == 0)
{ RELEASE(denom);
RELEASE(num);
return 1;
}
if(k==0)
{ RELEASE(num);
num = one;
}
if(k==1)
{ temp = ARG(0,num);
RELEASE(num);
num = temp;
}
if(count == 1)
{ temp = ARG(0,denom);
RELEASE(denom);
denom = temp;
}
*next = make_fraction(num,denom);
return 0;
}
if(FUNCTOR(t)=='/')
{ term temp;
err = eliminateconstnegexpnum1(t,&temp);
if(err)
temp = t;
err2 = eliminatenegexpdenom(temp,zero,next,buffer);
if(err2)
*next = temp;
if(!err || !err2)
return 0;
}
return 1;
}
/*____________________________________________________________*/
/* The following functions enable the caller to access and change
(get and set) the static globals that control polyval. */
/*____________________________________________________________*/
int get_polyvalfactorflag(void)
{ return polyvalfactorflag;
}
void set_polyvalfactorflag(int n)
{ polyvalfactorflag = n;
}
int get_polyvalfunctionflag(void)
{ return polyvalfunctionflag;
}
void set_polyvalfunctionflag(int n)
{ polyvalfunctionflag = n;
}
int get_polyvaldifflag(void)
{ return polyvaldifflag;
}
void set_polyvaldifflag(int n)
{ polyvaldifflag = n;
}
int get_polyvalintflag(void)
{ return polyvalintflag;
}
void set_polyvalintflag(int n)
{ polyvalintflag = n;
}
int get_polyvalgcdflag(void)
{ return polyvalgcdflag;
}
void set_polyvalgcdflag(int n)
{ polyvalgcdflag = n;
}
int get_polyvalzeropowerflag(void)
{ return polyvalzeropowerflag;
}
void set_polyvalzeropowerflag(int n)
{ polyvalzeropowerflag = n;
}
int get_polyvalfractexpflag(void)
{ return polyvalfractexpflag;
}
void set_polyvalfractexpflag(int n)
{ polyvalfractexpflag = n;
}
int get_polyvalnegexpflag(void)
{ return polyvalnegexpflag;
}
void set_polyvalnegexpflag(int n)
{ polyvalnegexpflag = n;
}
int get_polyvalrootproductflag(void)
{ return polyvalrootproductflag;
}
void set_polyvalrootproductflag(int n)
{ polyvalrootproductflag = n;
}
int get_polyvalcomdenomflag(void)
{ return polyvalcomdenomflag;
}
void set_polyvalcomdenomflag(int n)
{ polyvalcomdenomflag = n;
}
int get_polyvaldomainflag(void)
{ return polyvaldomainflag;
}
void set_polyvaldomainflag(int n)
{ polyvaldomainflag = n;
}
int get_infractionflag(void)
{ return infractionflag;
}
void set_infractionflag(int n)
{ infractionflag = n;
}
void increment_infractionflag(void)
{ ++infractionflag;
}
void decrement_infractionflag(void)
{ --infractionflag;
}
int get_complex(void)
{ return complex;
}
void set_complex(int n)
{ complex = n;
set_parser_complex(n);
}
/*____________________________________________________________*/
static int complex_denoms(term t)
/* return 1 if some denominator inside t contains 'i', 0 if not */
{ unsigned short i,n;
if(ATOMIC(t))
return 0;
if(FRACTION(t))
{ if(iscomplex(ARG(1,t)))
return 1;
return complex_denoms(ARG(0,t));
}
n = ARITY(t);
for(i=0;i<n;i++)
{ if(complex_denoms(ARG(i,t)))
return 1;
}
return 0;
}
/*____________________________________________________________*/
static polyflags *pDocPolyData;
void init_polyvalflags(polyflags *p)
{ p->factor = polyvalfactorflag;
p->function = polyvalfunctionflag;
p->dif = polyvaldifflag;
p->intlinear = polyvalintflag;
p->gcd = polyvalgcdflag;
p->zeropower = polyvalzeropowerflag;
p->fractexp = polyvalfractexpflag;
p->negexp = polyvalnegexpflag;
p->rootproduct = polyvalrootproductflag;
p->comdenom = polyvalcomdenomflag;
p->domainflag = polyvaldomainflag;
p->infraction = infractionflag;
p->arith = get_arithflag();
p->complex = complex;
p->ringflag = get_ringflag();
p->orderflag = get_orderflag();
}
void activate_polyvalDLL(polyflags *p)
/* Initialize the static globals above. Called when a document
is activated, when it has previously been opened. */
{ pDocPolyData = p;
polyvalfactorflag = p->factor;
polyvalfunctionflag = p->function;
polyvaldifflag = p->dif;
polyvalintflag = p->intlinear;
polyvalgcdflag = p->gcd;
polyvalzeropowerflag = p->zeropower;
polyvalfractexpflag = p->fractexp;
polyvalnegexpflag = p->negexp;
polyvalrootproductflag = p->rootproduct;
polyvalcomdenomflag = p->comdenom;
infractionflag = p->infraction;
polyvaldomainflag = p->domainflag;
set_ringflag(p->ringflag); /* ringflag is static in order.c */
set_orderflag(p->orderflag);
complex = p->complex;
set_arithflag(p->arith);
}
/*____________________________________________________________*/
void deactivate_polyvalDLL(void)
/* Set the document data from the DLL globals.
Leaves the static polyvalflags in an undetermined condition.
Called when a document is deactivated. */
{ init_polyvalflags(pDocPolyData);
}
/*_____________________________________________________________________*/
static int complex_exponents_to_num(term t, term *ans)
/* t is a fraction. Move any complex exponents in the denom to the
numerator, introducing negative exponents if necessary */
{ unsigned short i,n,m,f;
term num,denom,u,v,newnum,newdenom;
assert(FRACTION(t));
num = ARG(0,t);
denom = ARG(1,t);
f = FUNCTOR(denom);
if(f == '^' && equals(ARG(0,denom),eulere) && iscomplex(ARG(1,denom)))
{ *ans = product(num,make_power(eulere,tnegate(ARG(1,denom))));
if(FUNCTOR(*ans) == '*')
sortargs(*ans);
return 0;
}
if(f != '*')
return 1;
n = ARITY(denom);
for(i=0;i<n;i++)
{ u = ARG(i,denom);
if(FUNCTOR(u) == '^' && equals(ARG(0,u),eulere) && iscomplex(ARG(1,u)))
{ v = make_power(eulere, tnegate(ARG(1,u)));
break;
}
}
if(i == n)
return 1;
newnum = product(num,v);
if(FUNCTOR(newnum)=='*')
sortargs(newnum);
if(n == 2)
newdenom = ARG(i ? 0 : 1,denom);
else
{ newdenom = make_term('*',(unsigned short)(n-1));
for(m=0;m<n-1;m++)
ARGREP(newdenom,m, ARG((m < i ? m : m+1), denom));
}
*ans = make_fraction(newnum,newdenom);
return 0;
}
/*_________________________________________________________________*/
void copy_infinitesimal_markers(term t, term *ans)
/* copy the bits recording that a fraction has a zero denom and
telling what sign the function had that it came from */
{ if(FUNCTOR(t) != '/' || !SOME_INFINITESIMAL(t) || FUNCTOR(*ans) != '/')
return;
if(POSITIVE_INFINITESIMAL(t))
SETPOSITIVE(*ans);
else if(NEGATIVE_INFINITESIMAL(t))
SETNEGATIVE(*ans);
else
SETINFINITESIMAL(*ans);
}
/*___________________________________________________________________*/
static int expand_for_polyval(term t, term *next)
/* Like expand but model-free and reason-free for use by polyval */
{ int err;
term temp,summand,temp2;
unsigned short i,f,n = ARITY(t);
int saveit;
int j,k;
unsigned long nbytes;
void *savenode;
if(FUNCTOR(t) != '+')
return 1; /* inapplicable */
nbytes = mycoreleft();
if(nbytes < 24576)
return 1; /* less than 24K available, don't risk running out of memory */
savenode = heapmax();
for(i=0;i<n;i++)
{ summand = (FUNCTOR(ARG(i,t)) == '-' ? ARG(0,ARG(i,t)) : ARG(i,t));
f = FUNCTOR(summand);
if(f == '*' || f == '^')
{ err = multiplyout_for_polyval(summand,&temp2);
if(err)
{ reset_heap(savenode);
continue;
}
save_and_reset(temp2,savenode,&temp2);
saveit = polyvalexpandflag;
polyvalexpandflag = 1;
polyval1(temp2,&temp);
polyvalexpandflag = saveit;
if(equals(temp,summand))
continue;
/* (a+2)(1+x) will get expanded and then factored again
and cause a loop without this 'continue' line */
j = termsize(temp);
k = termsize(summand);
if(j <= k)
continue; // expanding is supposed to make things longer.
save_and_reset(temp,savenode,&temp);
break;
}
}
if(i<n) /* a term was found that multiplied out successfully */
{ if(FUNCTOR(ARG(i,t)) == '-')
{ subst(strongnegate(temp),ARG(i,t),t,next);
/* example: expanding u -3(x+y) => u-3x-3y, not u-(3x+3y) */
}
else
subst(temp,ARG(i,t),t,next);
return 0;
}
return 1; /* nothing to multiply out */
}
/*_________________________________________________________________*/
static int stop_contentfactorundersqrt(term t)
/* t is a sum. Return 1 if the content of t is squarefree.
*/
{ term c,s;
int err;
if(FUNCTOR(t) != '+')
return 1; /* no point trying to factor a non-sum */
err = content_factor(t,&c,&s);
if(err)
return 0;
if(INTEGERP(c) && !nsquarefree(c))
return 0;
return 1;
}
/*_________________________________________________________________*/
static int stop_contentfactorunderroot(term t)
/* t is a sum. Return 1 if the content of t does not contain
any cubic factors.
*/
{ term c,s;
int err;
if(FUNCTOR(t) != '+')
return 1; /* no point trying to factor a non-sum */
err = content_factor(t,&c,&s);
if(err)
return 0;
if(INTEGERP(c) && !rootfree(c,3))
return 0;
return 1;
}
/*_________________________________________________________________________*/
static int reduce_by_gcd(term num, term denom, term *p, term *q)
/* assumes num is a product. Find a factor u of num such that
cancelgcd_aux(u,denom...) works, or cancelgcd_aux(u,v) for some
factor v of denom, if denom is a product, and return in *p and *q
factored forms of num and denom. Return 0 for success, 1 for
failure.
*/
{ unsigned short n,m;
int i,j,k;
term u,v,w,z,a,b;
if(FUNCTOR(denom) == '+' && FUNCTOR(num) == '*')
{ n = ARITY(num);
for(i=0;i<n;i++)
{ u = ARG(i,num);
if(
(
FUNCTOR(u) == '+' ||
(FUNCTOR(u) == '^' && FUNCTOR(ARG(0,u)) == '+')
) &&
!cancelgcd_aux(u,denom,&w,q)
)
{ v = make_term('*',n);
for(j=0;j<n;j++)
ARGREP(v,j, j==i ? w :ARG(j,num));
*p = topflatten(v);
return 0;
}
}
return 1;
}
if(FUNCTOR(num) == '+' && FUNCTOR(denom) == '*')
return reduce_by_gcd(denom,num,q,p);
if(FUNCTOR(num) == '*' && FUNCTOR(denom) == '*')
{ n = ARITY(num);
m = ARITY(denom);
for(i=0;i<n;i++)
{ u = ARG(i,num);
if(FUNCTOR(u) != '+' &&
!(FUNCTOR(u) == '^' && FUNCTOR(ARG(0,u)) == '+')
)
continue;
for(k=0;k<m;k++)
{ v = ARG(k,denom);
if(FUNCTOR(v) != '+' &&
!(FUNCTOR(v) == '^' && FUNCTOR(ARG(0,v)) == '+')
)
continue;
if(cancelgcd_aux(u,v,&w,&z))
continue;
goto success;
}
}
return 1; /* failure */
success:
/* w and z should replace ARG(i,num) and ARG(k,denom) respectively */
a = make_term('*',n);
b = make_term('*',m);
for(j=0;j<n;j++)
ARGREP(a,j,j==i? w : ARG(j,num));
for(j=0;j<m;j++)
ARGREP(b,j,j==k? z : ARG(j,denom));
*p = topflatten(a);
*q = topflatten(b);
return 0;
}
return 1;
}
/*________________________________________________________________________*/
static int contains_sum_as_factor(term t)
/* if t is a sum, or power of a sum, or contains a sum or a power of a sum
as a factor, return 1. Else return 0. */
{ unsigned short n = ARITY(t);
int i;
term u;
if(FUNCTOR(t) == '+')
return 1;
if(FUNCTOR(t) == '^' && FUNCTOR(ARG(0,t)) == '+' && INTEGERP(ARG(1,t)))
return 1;
if(FUNCTOR(t) != '*')
return 0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u) == '^')
u = ARG(0,u);
if(FUNCTOR(u) == '+')
return 1;
}
return 0;
}
/*________________________________________________________________________*/
static int contains_fract(term t)
/* if t contains a fraction, but not counting fractional exponents,
return 1; else return 0. */
{ unsigned short n;
int i;
if(ATOMIC(t))
return 0;
if(FRACTION(t))
return 1;
if(FUNCTOR(t) == '^')
return contains_fract(ARG(0,t));
n = ARITY(t);
for(i=0;i<n;i++)
{ if(contains_fract(ARG(i,t)))
return 1;
}
return 0;
}
/*_____________________________________________________________________*/
static int log_in_sum(term power)
/* return 1 if power is a sum, one of whose summands is a log, ln, or logb,
or a product one of whose factors is a log, ln, or logb.
*/
{ int i,j;
unsigned short n = ARITY(power);
term w;
if(FUNCTOR(power) != '+')
return 0;
for(i=0;i<n;i++)
{ w = ARG(i,power);
if(NEGATIVE(w))
w = ARG(0,w);
if(FUNCTOR(w) == LOG ||
FUNCTOR(w) == LOGB ||
FUNCTOR(w) == LN
)
return 1;
if(FUNCTOR(w) == '*')
{ for(j=0;j<ARITY(w);j++)
{ if(FUNCTOR(ARG(j,w)) == LOG ||
FUNCTOR(ARG(j,w)) == LOGB ||
FUNCTOR(ARG(j,w)) == LN
)
return 1;
}
}
}
return 0;
}
/*______________________________________________________________________*/
static int one_nonconstant_log(term t)
/* return 1 if t is a product containing one LN, LOG, or LOGB factor,
and all other factors do not contain the eigenvariable. The LN factor
may or may not contain it. */
{ term x = get_eigenvariable();
term u;
int i,count=0;
unsigned short n = ARITY(t);
if(FUNCTOR(t) != '*')
return 0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u) == LOGB || FUNCTOR(u) == LN || FUNCTOR(u) == LOG)
{ ++count;
if(count > 1)
return 0;
continue;
}
if(contains(u,FUNCTOR(x)))
return 0;
}
return 1;
}
/*________________________________________________________________________*/
static int r_gcd(term num, term denom, term *ans)
/* reduce num/denom by cancelling a gcd, also if num and denom are both
roots, sqrts, or raised to the same power.
*/
{ term p,q;
int err;
if(FUNCTOR(num) == '*' &&
contains_sum_as_factor(num) &&
contains_sum_as_factor(denom) &&
!reduce_by_gcd(num,denom,&p,&q)
)
{ *ans = make_fraction(p,q);
return 0;
}
if(FUNCTOR(denom) == '*' &&
contains_sum_as_factor(num) &&
contains_sum_as_factor(denom) &&
!reduce_by_gcd(denom,num,&p,&q)
)
{ *ans = make_fraction(q,p);
return 0;
}
if(FUNCTOR(num) == '+' && FUNCTOR(denom) == '+' &&
!cancelgcd_aux(num,denom,&p,&q)
)
/* this doesn't actually cancel the gcd but just factors it out */
{ term canceled;
if(! cancel(p,q,&canceled,ans))
return 0;
*ans = make_fraction(p,q);
return 0;
}
if(FUNCTOR(num) == SQRT && FUNCTOR(denom) == SQRT)
{ err = r_gcd(ARG(0,num),ARG(0,denom),&p);
if(err)
return 1;
polyval(p,&q);
*ans = make_sqrt(q);
return 0;
}
if(FUNCTOR(num) == ROOT && FUNCTOR(denom) == ROOT && equals(ARG(0,num),ARG(0,denom)))
{ err = r_gcd(ARG(1,num),ARG(1,denom),&p);
if(err)
return 1;
polyval(p,&q);
*ans = make_root(ARG(0,num),q);
return 0;
}
if(FUNCTOR(num) == '^' && FUNCTOR(denom) == '^' && equals(ARG(1,num),ARG(1,denom)))
{ err = r_gcd(ARG(0,num),ARG(0,denom),&p);
if(err)
return 1;
polyval(p,&q);
*ans = make_power(q,ARG(1,num));
return 0;
}
return 1;
}
/*_________________________________________________________*/
int is_complex(term t)
/* return the number of occurrences of complexi in t,
or of variables with type DCOMPLEX. */
{ unsigned short n;
int i,count = 0;
if(OBJECT(t))
return 0;
if(ATOMIC(t))
{ if(equals(t,complexi))
return 1;
if(TYPE(t) == DCOMPLEX)
return 1;
return 0;
}
n = ARITY(t);
for(i=0;i<n;i++)
count += is_complex(ARG(i,t));
return count;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists