Sindbad~EG File Manager
| Current Path : /home/beeson/ |
|
|
| Current File : //home/beeson/puiseux.c |
/*
M. Beeson. Limits by leading terms.
Original date 10.2.91
modified 3.30.99
1.13.00 modified leading_term1 at lines 235-255
1.29.06 exported lt_plus
6.8.13 corrected leading_term
12.8.14 changed 'makepoly' to 'polyform' at line 385 in leading_term1.
changed "four terms" to "three terms" for how many terms of Taylor series to compute.
8.8.24 changed math.h to sincos.h
*/
#include <assert.h>
#include "sincos.h"
#include "globals.h"
#include "ops.h"
#include "prover.h"
#include "mpmem.h"
#include "polynoms.h"
#include "fraction.h"
#include "deriv.h"
#include "mplimits.h"
#include "deval.h"
#include "term2.h"
#include "trig.h"
#include "evaltrig.h"
#include "cancel.h"
#include "pvalaux.h"
#include "probtype.h" /* get_problemtype */
#include "evalpoly.h"
static int lt_times(term,int, term, term, term *, term *);
static int lt_plus2(term *,int, term, term, term, term *, term *);
static int compose_leading_terms(unsigned short f,term u,term x,term a,term *c,term *deg);
static int adjust_values(term a,term x,term t);
/*_______________________________________________________________________*/
int leading_term(term t, term x, term a, term *c, term *deg)
/* Find c and deg such that t = c(x-a)^deg + higher order terms,
where c is nonzero. Deg comes out as
a positive or negative integer or rational (if the function
succeeds). If a = infinity or minusinfinity,
t = cx^deg + lower order terms.
Return zero for success,
1 for failure,
2 for domain error (point x = a is not in the closure of domain of t),
3 for function t(x) not differentiable at a, as in abs(x)/x.
It can return *c = bounded_oscillations.
Note: the coefficient c might still be actually equal to zero,
even though Mathpert doesn't simplify it to zero. We don't call
'check' here, in order not to make assumptions.
*/
{ int saveit = get_polyvalzeropowerflag();
int saveit2 = get_polyvalfunctionflag();
short savenextassumption = get_nextassumption();
int err;
unsigned short f = FUNCTOR(t);
/* leading term of ln(1+u) is the leading term of u */
if(f == LN && FUNCTOR(ARG(0,t)) == '+' && ARITY(ARG(0,t)) == 2 &&
(ISONE(ARG(0,ARG(0,t))) || ISONE(ARG(1,ARG(0,t))))
)
{ term v;
if(ISONE(ARG(0,ARG(0,t))))
v = ARG(1,ARG(0,t));
else
v = ARG(0,ARG(0,t));
err = leading_term(v,x,a,c,deg);
if(!err)
{ if(obviously_positive(*deg) && !NOTDEFINED(a))
return 0;
if(obviously_negative(*deg) && ISINFINITE(a))
return 0;
}
}
if((f == LN || f == LOGB || f == LOG) && ZERO(a))
return 1; /* without further ado. But e.g. ln(sin x) does go further. */
set_polyvalzeropowerflag(1);
set_polyvalfunctionflag(1);
err = leading_term1(t,x,a,c,deg);
if(!err && FUNCTOR(t) == '+' && ZERO(*c))
{ err = lt_plus2(ARGPTR(t),ARITY(t),x,a,*deg,c,deg);
/* e.g. sqrt x - x^(1/2) gets here,
as does x + �(x(x+2)) as x->-infinity */
}
set_polyvalzeropowerflag(saveit);
set_polyvalfunctionflag(saveit2);
set_nextassumption(savenextassumption); /* ssolve can make assumtions
during leading_term1 */
return err;
}
/*_______________________________________________________________________*/
static long factorials[] =
{ 1L,1L,2L,6L,24L,120L,720L,5040L, /* up to 7! */
40320L,362880L,3628800L, /* 8!, 9!, 10! */
39916800L,479001600L /* 11!, 12! */
}; /* 13! doesn't fit in four bytes */
/*_______________________________________________________________________*/
/* get the first nonzero term of the Taylor or Pusieux series of t if possible;
but succeed anyway if the coefficient of this term is zero, unlike
leading_term above which goes on to look for a higher power leading term.
That is, get a rational power of (x-a) which governs the behavior of t
in a neighborhood of a as a function of x; a can be infinity or minusinfinity,
in which case it's a power of x, not of x-a.
This function uses Taylor series approximations at finite points
so really gets the correct leading_term there, but at infinity, if the
leading terms cancel, this returns a zero coefficient and does not
look at lower-order terms.
Return zero for success, 1 for failure, 2 in case the point x = a
is not in the closure of the domain of t, e.g. when t = sqrt x and a = -1.
*/
int leading_term1(term t, term x, term a, term *c, term *deg)
/* Find c and deg such that t = c(x-a)^deg + higher order terms;
if t is a sum, we allow c = 0 if the leading terms of the summands
cancel out. Deg comes out as a (nonnegative or negative) integer
or rational (if the function succeeds). If a = infinity or minusinfinity,
t = cx^deg + lower order terms.
Return zero for success, 1 for failure.
We allow c to be returned as bounded_oscillations, for example
if a = infinity and t = sin x. This is also possible with
nonzero degree, e.g. t = x sin x at a = infinity
has c = bounded_oscillations and degree 1.
In case t is a sum and we WERE able to calculate the leading
terms of the summands, but the leading coefficients cancelled out,
return *c = zero, with the leading degree in *deg. If we couldn't
calculate the leading terms of the summands, make sure *c isn't zero.
If t involves a � or fractional power, the answer may be wrong on
one side of a, but will be correct on the other side. It may thus
return a leading term for a function which is only defined on one
side. For a = plus or minus infinity it will be correct.
It can also return wrong answers on functions defined by cases, e.g.
if the function is defined at a but it approaches a from only one side,
or even from neither side. Don't call it on such a function.
*/
{ int i,err,saveit,trash;
void *startnode;
unsigned short f,n;
int problemtype;
long k;
term u,d,v,uu,dd,p,mid,temp,cancelled,b,cc,m;
int nvars;
term *atomlist;
POLYnomial q;
double z,z2,w,saveval,da;
term zz;
if(ZERO(t))
return 1; /* illegal input anyway */
saveit = get_polyvalfunctionflag();
set_polyvalfunctionflag(1);
f = FUNCTOR(t);
n = ARITY(t);
if(!depends(t,x))
{ polyval(t,c); /* example: t = sqrt(6-x) where limit variable is h;
this has to become a fractional exponent so it
can cancel out in lim(h->0, sqrt(6-x+h)-sqrt(6-x)) */
*deg = zero;
goto succeed;
}
if(f == ABSFUNCTOR)
{ err = leading_term1(ARG(0,t),x,a,c,deg);
if(err)
return 1;
if(iseven(*deg) || equals(a,infinity) ||
(n==3 && equals(ARG(1,t),right))
)
{ if(!obviously_nonnegative(*c))
*c = abs1(*c);
return 0;
}
if(
(isodd(*deg) && equals(a,minusinfinity)) ||
(n == 3 && equals(ARG(1,t),left))
)
{ if(obviously_nonnegative(*c))
*c = tnegate(*c);
else
*c = tnegate(abs1(*c));
return 0;
}
err = infer(le(zero,ARG(0,t)));
if(!err)
return 0;
return 1;
}
if(TRIGFUNCTOR(f) && equals(ARG(0,t),x) && !seminumerical(a))
/* example: a=2(n+1)�/2, t=tan x */
{ if(ISINFINITE(a))
{ *c = bounded_oscillations;
*deg = zero;
goto succeed;
}
b = make_term(f,1);
ARGREP(b,0,a);
err = periodic(b,&cc); /* tan((2n+1)�/2) = tan(�/2) */
if(!err)
{ err = leading_term1(t,x,ARG(0,cc),c,deg);
if(err == 2)
goto domain_error;
if(err == 3)
goto not_differentiable;
if(err)
goto fail;
goto succeed;
}
nvars = variablesin(a,&atomlist);
m = atomlist[0];
free2(atomlist);
if(nvars == 1)
{ term p,q,temp;
if(FRACTION(a) && equals(ARG(1,a),two) &&
!cancel(ARG(0,a),pi_term,&p,&q) &&
/* example, leading term of cos(t) at t = (2n+1)pi/2;
This should come out with *c = (-1)^n and *deg = 1 */
FUNCTOR(q) == '+' && ARITY(q) == 2 && ONE(ARG(1,q)) &&
FUNCTOR(ARG(0,q)) == '*' && ARITY(ARG(0,q)) == 2 &&
INTEGERP(ARG(0,ARG(0,q))) && ISEVEN(ARG(0,ARG(0,q))) &&
isinteger(ARG(1,ARG(0,q)))
)
{ subst(zero,m,a,&temp);
polyval(temp,&cc);
err = leading_term(t,x,cc,c,deg);
if(err == 2)
goto domain_error;
if(err == 3)
goto not_differentiable;
if(err)
goto fail;
polyval(product(make_power(minusone,m),*c),&b);
*c = b;
goto succeed;
}
}
}
if(ISATOM(t) && equals(t,x))
{ if(ZERO(a)|| ISINFINITE(a))
{ *c = one;
*deg = one;
goto succeed;
}
if(seminumerical(a) && !deval(a,&z) && z != 0)
{ *c = a;
*deg = zero;
goto succeed;
}
if(!ZERO(a) && !NOTDEFINED(a) &&
(OBJECT(a) || immediate(nonzero(a)) == 1)
/* not 'check' instead of immediate as this can cause a loop:
check calls lpt calls reduce_ineq calls stdpart calls limval
calls leading_term calls leading_term1, loop.
*/
)
{ *c = a;
*deg = zero;
goto succeed;
}
goto fail;
}
if(ZERO(a) && ispolyin(t,x) && !makepoly(t,x,&mid))
{ for(i=0;i<ARITY(mid);i++)
{ if(!ZERO(ARG(i,mid)))
break;
}
if(i == ARITY(mid))
{ /* t was the zero polynomial */
*c = zero;
*deg = zero;
goto succeed;
}
*deg = make_int(i);
*c = ARG(i,mid);
goto succeed;
}
if(ISINFINITE(a) && ispolyin(t,x) && !makepoly(t,x,&mid))
{ i = ARITY(mid)-1;
*deg = make_int(i);
*c = ARG(i,mid);
goto succeed;
}
if(ispolyin(t,x) && seminumerical(a) && !deval(a,&w))
/* and a is not zero and not infinite */
{ /* divide out (x-a) as many times as possible until we get a
nonzero remainder, thus determining t = (x-a)^n q(x)
*/
POLYnomial xminusa,u,r;
term cc,d,uofa;
err = makepoly(sum(x,tnegate(a)),x,&xminusa);
if(!err)
err = makepoly(t,x,&u);
if(!err)
{ d = one;
for(i=0;i<=ARITY(u);i++)
{ pseudodiv(u,xminusa,&q,&r,&cc); /* cc * u = (x-a)^q + r */
if(ARITY(r) > 1 || !ZERO(ARG(0,r)))
break;
u = q;
if(!ONE(cc))
d = product(d,cc);
}
*deg = make_int(i);
if(ZERO(a))
uofa = ARG(ARITY(u)-1,u);
else if(NUMBER(a) && !deval(a,&da) && da != BADVAL && !devalpoly(u,da,&z))
{ if(nearint(z,&k))
uofa = make_int(k);
else
uofa = make_double(z);
}
else
uofa = evalpoly(u,a);
polyval(make_fraction(uofa,d),c);
return 0;
}
}
if(ZERO(a) && f == '^' && equals(x,ARG(0,t)))
goto powercase; /* in switch below, skip trying preliminary things */
if(OBJECT(t) && !ZERO(t))
{ *c = t;
*deg = zero;
goto succeed;
}
if(seminumerical(a) && !deval(a,&w))
{ saveval = VALUE(x);
SETVALUE(x,w);
err = adjust_values(a,x,t);
deval(t,&z);
if(z != BADVAL)
/* t evaluated at a isn't infinity */
{ if( !(nearint(z,&k) && k==0) )
/* and also not zero */
{ SETVALUE(x,saveval);
*deg = zero;
subst(a,x,t,&u);
polyval(u,c);
goto succeed;
}
/* Now t does evaluate to 0 at a. Remember that t may contain
other variables, but they have random values, so if we
get 0, it's probably really zero. */
/* Handle at least trig functions at their zeroes quickly */
SETVALUE(x,w + 0.001);
deval(t,&z2);
SETVALUE(x,w);
if(ARITY(t) == 1 && f != '-' &&
( equals(ARG(0,t),x) || FRACTION(ARG(0,t)) || FUNCTOR(ARG(0,t)) == '*') &&
( f==SIN || f==COS || f==TAN || f==COT || f==LN || f==SINH || f==TANH || f==ATAN || f==ASIN)
)
{ term q = ARG(0,t);
term r,s;
if(equals(q,x))
{ r = one;
s = x;
}
else /* FUNCTOR(q)== '*' || FRACTION(q) */
twoparts(q,x,&r,&s);
if(equals(s,x))
{ *deg = one;
*c = z2 > 0.0 ? r : tnegate(r);
goto succeed;
}
if(FUNCTOR(s) == '^' && INTEGERP(ARG(1,s)) && equals(x,ARG(0,s)))
{ *deg = ARG(1,s);
*c = z2 > 0.0 ? r : tnegate(r);
goto succeed;
}
}
}
}
switch(f)
{ case '*':
err = lt_times(t,n,x,a,c,deg);
if(err == 2)
goto domain_error;
if(err == 3)
goto not_differentiable;
if(err)
goto fail;
goto succeed;
case '+':
if(equals(a,infinity) || equals(a,minusinfinity) || ZERO(a))
{ err = polyform(t,x,&q); // not just makepoly
if(!err)
{ *deg = make_int(ARITY(q)-1);
if(ISINFINITE(a))
*c = ARG(ARITY(q)-1,q);
else /* if ZERO(a) */
{ for(i=0;i<ARITY(q);i++)
{ if(!ZERO(ARG(i,q)))
{ *deg = make_int(i);
*c = ARG(i,q);
break;
}
}
if(i==ARITY(q))
return 1; /* sum simplified to zero; fail */
}
RELEASE(q);
goto succeed;
}
}
err = lt_plus(ARGPTR(t),n,x,a,c,deg);
if(err == 2)
goto domain_error;
if(err == 3)
goto not_differentiable;
if(err)
{ *c = one; /* make sure it isn't zero */
goto fail;
/* there's no hope if we can't even calculate the
leading terms of the summands. */
}
if(!ZERO(*c))
/* leading terms of the sum did not cancel out! */
{ /* Of course, that may be only because Mathpert's
simplifier is too stupid to realize they
really do cancel out. So check it: */
if(OBJECT(*c))
goto succeed;
else if(seminumerical(*c))
{ deval(*c,&z);
if(z == BADVAL)
goto fail;
if(fabs(z) > VERYSMALL)
goto succeed;
*c = zero; /* probably it's different only by roundoff error */
/* and continue */
}
else if((problemtype = get_problemtype())== LIMITS ||
problemtype == LHOPITAL ||
problemtype == DIFFERENTIATE_FROM_DEFN
)
{ err = check1(ne(*c,zero));
if(!err)
goto succeed;
}
else
{ err = infer(ne(*c,zero));
if(!err)
goto succeed;
err = infer(equation(*c,zero));
if(err)
goto fail;
}
/* Now *c turned out to be zero after all, so continue */
}
/* But if they did, then what? */
/* if there are any fractions in the sum, convert
the sum to a fraction using common denominators. */
for(i=0;i<n;i++)
{ p = ARG(i,t);
if(FUNCTOR(p)=='-')
p = ARG(0,p);
if(FUNCTOR(p) == '/')
break;
}
if(i<n) /* fraction found */
{ naivecomdenom(t,&u);
if(FRACTION(u))
{ term num,denom;
polyval(ARG(0,u),&num);
polyval(ARG(1,u),&denom);
err = cancel(num,denom,&uu,&p);
if(err)
p = make_fraction(num,denom);
/* don't bother with factoring, gcds, etc. to save time */
err = leading_term(p,x,a,c,deg);
if(err == 2)
goto domain_error;
if(err == 3)
goto not_differentiable;
if(!err)
goto succeed;
}
goto fail; /* all our eggs in the common denom basket */
}
break;
/* No fractions, and cancelling leading terms. This
will go below to where we calculate derivatives. */
case '/':
err = leading_term(ARG(0,t),x,a,&u,&d);
if(err == 2)
goto domain_error;
if(err == 3)
goto not_differentiable;
if(!err)
{ err = leading_term(ARG(1,t),x,a,&uu,&dd);
if(err == 2)
goto domain_error;
if(err == 3)
goto not_differentiable;
if(!err &&
!equals(uu,bounded_oscillations) &&
!ZERO(uu) &&
(NUMBER(uu) || !infer(nonzero(uu)))
)
{ if(equals(u, bounded_oscillations))
*c = bounded_oscillations;
else
polyval(make_fraction(u,uu),c);
polyval(sum(d,tnegate(dd)),deg);
goto succeed;
}
}
goto fail;
/* failed to calculate leading term or num, or of denom */
/* I don't think L'Hopital's rule or anything else will help now;
if we can't calculate leading term of f, we probably can't
calculate leading term of f', f'', etc. either, although I
can't prove it. */
case '-' :
err = leading_term(ARG(0,t),x,a,&u,deg);
if(!err)
tneg(u,c);
set_polyvalfunctionflag(saveit);
return err;
case '^' :
powercase: /* can get here from above */
err = leading_term(ARG(0,t),x,a,&u,&d);
if(err == 2)
goto domain_error;
if(err == 3)
goto not_differentiable;
if(err)
goto fail;
if(INTEGERP(ARG(1,t)) || (RATIONALP(ARG(1,t)) && ISODD(ARG(1,ARG(1,t)))))
{ polyval(product(d,ARG(1,t)),deg);
if(equals(u, bounded_oscillations))
*c = bounded_oscillations;
else
polyval(make_power(u,ARG(1,t)),c);
}
else if(RATIONALP(ARG(1,t))) /* and the denom of the exponent is even */
{ polyval(product(d,ARG(1,t)),deg);
if(equals(u, bounded_oscillations))
*c = bounded_oscillations;
else if(seminumerical(u))
{ deval(u,&z);
if(z == BADVAL)
goto fail;
if(z > VERYSMALL)
polyval(make_power(u,ARG(1,t)),c);
else if(z < -VERYSMALL)
{ if(ZERO(*deg))
return 2; /* domain error */
polyval(make_power(strongnegate(u),ARG(1,t)),c);
}
else
goto fail; /* leading term is zero or within roundoff error of zero */
}
else if(NEGATIVE(u) && obviously_positive(ARG(0,u)))
/* example, leading term of sqrt(x^2-1) at a = -1;
u is -2 and we don't want to return
(-2)^(1/2) for the coefficient. The function
is defined on only one side of a. */
{ if(ZERO(d) || iseven(d))
/* example, leading term of x^2-2 at a = 1 */
goto domain_error;
polyval(make_power(ARG(0,u),ARG(1,t)),c);
}
else if(obviously_positive(u))
polyval(make_power(u,ARG(1,t)),c);
else if(!infer(lessthan(u,zero)))
{ if(ZERO(d) || iseven(d))
goto domain_error;
polyval(make_power(strongnegate(u),ARG(1,t)),c);
}
else if(!infer(lessthan(zero,u)))
polyval(make_power(u,ARG(1,t)),c);
else
goto fail; /* can't determine the sign of u */
if(equals(a,infinity))
goto succeed;
if(equals(a,minusinfinity) &&
!equals(*c, bounded_oscillations)
)
{ if(equals(*deg,two) || !infer(even(*deg)))
goto succeed;
polyval(tnegate(*c),c);
goto succeed;
}
goto succeed;
}
if(NEGATIVE(ARG(1,t)) && POSNUMBER(ARG(0,ARG(1,t))))
/* negative rational exponent */
/* if denominator of exponent is even, limit is only one-sided
but the leading term exists anyway. */
{ err = infer(positive(u)); /* (u^d)^(c) = u^(dc) requires u > 0 when c < 0 */
if(err)
goto fail;
polyval(product(d,ARG(1,t)),deg);
if(equals(u, bounded_oscillations))
goto fail;
/* lim(x->infinity, (sin(x) + a)^-1 depends
on the value of a. To do this we would have
to compute lim sups and lim infs */
else
polyval(make_power(u,ARG(1,t)),c);
goto succeed;
}
/* Now the exponent isn't a positive or negative number */
err = leading_term(ARG(1,t),x,a,&uu,&dd);
if(err == 2)
goto domain_error;
if(err == 3)
goto not_differentiable;
if(err || equals(uu, bounded_oscillations))
goto fail;
if(!ZERO(dd))
goto fail; /* can't handle e.g. x^x */
if(ONE(u))
*c = one;
else if(equals(u, bounded_oscillations))
{ err = infer(positive(uu));
if(err)
goto fail;
*c = bounded_oscillations;
}
else
polyval(make_power(u,uu),c);
polyval(product(d,uu),deg);
/* leading term of e.g. (ux)^(1/2) requires u>0 */
if(NEGATIVE(uu))
uu = ARG(0,uu);
if(FRACTION(uu) && INTEGERP(ARG(1,uu)) && ISEVEN(ARG(1,uu)))
{ if(INTEGERP(d) && ISODD(d))
err = check1(lessthan(zero,u));
if(err)
goto fail; /* expression is not defined! */
}
goto succeed;
case SQRT:
err = leading_term(ARG(0,t),x,a,&u,&d);
if(err == 2)
goto domain_error;
if(err == 3)
goto not_differentiable;
if(err)
goto fail;
if(ZERO(d))
{ /* then u must be nonnegative */
err = infer(lessthan(zero,u));
if(err)
goto domain_error;
}
/* Even if d is nonzero, the SQRT might still be
undefined on one or both sides, or even on a more
complicated set near the limit, but we go ahead and
return a leading term anyway. See the comments
at the top of the function.
*/
polyval(make_fraction(d,two),deg);
if(equals(u,bounded_oscillations))
*c = bounded_oscillations;
else if(seminumerical(u))
{ deval(u,&z);
if(z == BADVAL)
goto fail;
if(z > VERYSMALL)
polyval(make_power(u,make_fraction(one,two)),c);
else if(z < -VERYSMALL)
{ if(ZERO(*deg))
return 2; /* domain error */
polyval(make_power(strongnegate(u),make_fraction(one,two)),c);
}
else
goto fail; /* leading term is zero or within roundoff error of zero */
}
else if(NEGATIVE(u) && obviously_positive(ARG(0,u)))
/* example, leading term of sqrt(x^2-1) at a = -1;
u is -2 and we don't want to return
(-2)^(1/2) for the coefficient. The function
is defined on only one side of a. */
{ if(ZERO(d) || iseven(d))
goto domain_error;
polyval(make_power(ARG(0,u),make_fraction(one,two)),c);
}
else if(obviously_positive(u))
polyval(make_power(u,make_fraction(one,two)),c);
else if(!infer(lessthan(u,zero)))
{ if(ZERO(d) || iseven(d))
goto domain_error;
polyval(make_power(tnegate(u),make_fraction(one,two)),c);
}
else
goto fail; /* can't determine the sign of u */
/* careful, the leading term of sqrt(x^2) as x->-infinity
is not x but -x; */
if(equals(a,infinity))
goto succeed;
if(equals(a,minusinfinity) &&
!equals(*c, bounded_oscillations)
)
{ if(equals(*deg,two) || !infer(even(*deg)))
goto succeed;
polyval(tnegate(*c),c);
goto succeed;
}
goto succeed;
case ROOT:
return leading_term(make_power(ARG(1,t),reciprocal(ARG(0,t))),x,a,c,deg);
}
if(n==1 && !equals(ARG(0,t),x))
{ /* leading term of f(u(x)) is the composition of the
leading terms of f and u. Just taking the derivative
as below runs us out of memory e.g. on sec x^2. */
err = compose_leading_terms(f,ARG(0,t),x,a,c,deg);
set_polyvalfunctionflag(saveit);
return err;
}
if(equals(ARG(0,t),x) &&
(f == TAN || f == COT || f == SEC || f == CSC)
/* at a singularity, or we would have already returned. */
)
{ switch(f)
{ case TAN:
*c = minusone;
break;
case COT:
*c = one;
break;
case CSC:
/* if a is an even multiple of pi_term,
then *c = 1, else *c = -1 */
if(ZERO(a))
{ *c = one;
break;
}
err = cancel(a,pi_term,&cancelled,&temp);
if(err)
goto fail;
if(iseven(temp))
{ *c = one;
break;
}
if(isodd(temp))
{ *c = minusone;
break;
}
goto fail; /* can't determine if temp is even or odd */
case SEC:
/* if a is pi/2 plus an even multiple of pi_term,
then *c = -1, else *c = 1 */
polyval(sum(a,tnegate(make_fraction(pi_term,two))),&p);
if(ZERO(p))
{ *c = minusone;
break;
}
err = cancel(p,pi_term,&cancelled,&temp);
if(err)
goto fail;
if(iseven(temp))
{ *c = minusone;
break;
}
if(isodd(temp))
{ *c = one;
break;
}
goto fail; /* can't determine if temp is even or odd */
}
*deg = minusone;
goto succeed;
}
if(ISINFINITE(a))
goto fail; /* can't compute Taylor series at infinity */
adjust_values(a,x,t); /* try to make sure deval(t,&z) will succeed
when the value of x is near a by setting
values of other variables in t than x */
subst(a,x,t,&u);
startnode = heapmax();
if(!deval(u,&z) && z != BADVAL)
/* No subterm of t is undefined at x=a (for the default values
of any parameters there may be--note that adjust_values
tries to set them so t will be defined for x near a.
*/
{ polyval(u,&zz);
/* I once tried putting this BEFORE the deval above, but
it caused nospace errors, taking derivatives of
complicated things produced by setting x=1/t in
limits at infinity. Such transformed limits don't
enter this part of the code as it is because the
t in the denominator blocks the deval test. If we
couldn't get the leading term at infinity, we won't
be able to get it here probably and it should go to
lt_plus2, which only come AFTER this.
*/
if(ZERO(zz))
err = 1;
else if(OBJECT(zz))
err = 0;
else if(
(problemtype = get_problemtype())== LIMITS ||
problemtype == LHOPITAL ||
problemtype == DIFFERENTIATE_FROM_DEFN
)
err = check1(nonzero(zz));
else
{ err = infer(nonzero(zz));
if(err)
goto fail;
}
reset_heap(startnode); /* finished with zz */
if(err) /* zz was zero */
{ uu = t;
k=0;
for(i=1;i<4;i++) /* compute up to three more terms of the Taylor series */
{ uu = derivative(uu,x);
++k;
if(ZERO(a) &&
(FUNCTOR(uu) == '*' ||
(NEGATIVE(uu) && FUNCTOR(ARG(0,uu)) == '*')
)
)
{ err = powerin(NEGATIVE(uu) ? ARG(0,uu) : uu,x,&temp,&trash);
if(!err)
{ if(!ISINTEGER(temp))
{ save_and_reset(uu,startnode,&uu);
goto fail;
}
err = cancel(uu,make_power(x,temp),&cancelled,&v);
assert(!err);
uu = v;
k += INTDATA(temp);
}
}
save_and_reset(uu,startnode,&uu);
subst(a,x,uu,&u);
polyval(u,&zz);
if(OBJECT(zz) || (NEGATIVE(zz) && OBJECT(ARG(0,zz))))
err = ZERO(zz) ? 1 : 0;
else
{ if((problemtype = get_problemtype())== LIMITS ||
problemtype == LHOPITAL ||
problemtype == DIFFERENTIATE_FROM_DEFN
)
{ err = check1(domain(zz));
if(err)
goto not_differentiable;
err = check1(nonzero(zz));
}
else
{ err = infer(domain(zz));
if(err)
goto not_differentiable;
err = infer(nonzero(zz));
if(err)
return 1;
}
}
if(!err) /** zz is nonzero */
{ if(k==1)
{ *deg = one;
*c = zz;
goto succeed;
}
*deg = make_int(k);
if(k <= 12)
p = make_int(factorials[(int)k]);
else
p = factorial1(make_int(k));
polyval(make_fraction(zz,p),c);
goto succeed;
}
}
}
else if(!err) /* zz != 0 without computing derivatives */
{ *deg = zero;
polyval(u,c);
goto succeed;
}
}
fail:
set_polyvalfunctionflag(saveit);
return 1;
not_differentiable:
set_polyvalfunctionflag(saveit);
return 3;
domain_error:
set_polyvalfunctionflag(saveit);
return 2;
succeed:
set_polyvalfunctionflag(saveit);
return 0;
}
/*___________________________________________________________________*/
static int lt_times(term t,int n, term x, term a, term *c, term *deg)
/* t is a product of n terms. Get the leading term of the product.
Return 0 for success, 1 for failure, 2 for domain error (x = a is
not in the closure of the domain of t), 3 for not differentiable at a.
We assume bounded_oscillations times bounded_oscillations is
bounded_oscillations. Mathpert never returns bounded_oscillations
for a reciprocal with bounded_oscillations in the denom, so
you could never get cancelling bounded_oscillation terms.
*/
{ int i,err;
term coef = one;
term exp = zero;
term nextcoef,m,temp,temp2;
for(i=0;i<n;i++)
{ err = leading_term(ARG(i,t),x,a,&nextcoef,&m);
if(err)
return err;
if(i==0)
{ coef = nextcoef;
exp = m;
}
else
{ if(equals(coef,bounded_oscillations) ||
equals(nextcoef,bounded_oscillations)
)
temp = bounded_oscillations;
else
polyval(product(coef,nextcoef),&temp);
if(i > 1)
destroy_term(coef); /* left in fresh space by polyval */
coef = temp;
polyval(sum(exp,m),&temp2);
if(i > 1)
destroy_term(exp);
exp = temp2;
}
}
*c = coef;
*deg = exp;
return 0;
}
/*_______________________________________________________________________*/
int lt_plus(term *args,int n, term x, term a, term *c, term *deg)
/* args points to an array of n terms, the args of a sum.
Get the leading term of the sum--the term or sum of terms with the
least-power leading terms themselves. In case the leading terms
cancel, this function can return a zero coeficient. In case two
of the summands have bounded_oscillation leading terms of the same
(leading) degree, we fail, because we can't guarantee the terms
don't cancel, e.g. lim (x->infinity, sin(2x) - 2sin x cos x);
limval will return bounded_oscillations for both terms.
Return 0 for success, 1 for failure, 2 for domain error (x=a is not
in the closure of the domain of t), 3 for not-differentiable at a.
*/
{ int i,err;
term coef,exp,temp;
term nextcoef,m;
double mm, expm;
for(i=0;i<n;i++)
{ err = leading_term(args[i],x,a,&nextcoef,&m);
if(err)
return err;
if(!seminumerical(m))
return 1;
if(i==0)
{ coef = nextcoef;
exp = m;
}
else
{ err = deval(m,&mm);
if(err)
return 1;
err = deval(exp,&expm);
if(err)
return 1;
if( (mm < expm && !NOTDEFINED(a)) ||
/* LOWER powers dominate when a is finite */
(mm > expm && NOTDEFINED(a))
/* HIGHER powers dominate when a is infinite */
)
{ exp = m;
coef = nextcoef;
}
else if(fabs(mm-expm) < 1.0e-10) /* watch for roundoff error */
{ if(equals(nextcoef,bounded_oscillations) &&
equals(coef, bounded_oscillations)
)
return 1;
else if(equals(coef, bounded_oscillations) ||
equals(nextcoef, bounded_oscillations)
)
temp = bounded_oscillations;
else
polyval(sum(coef,nextcoef),&temp);
coef = temp;
}
}
}
*c = coef;
*deg = exp;
return 0;
}
/*_________________________________________________________________*/
int lhopital_warning(term t,term x, term a)
/* return 2 if t contains exponentials with exponents containing x,
returns 1 if t contains no such exponentials, but
does contain fractional powers or roots of a base which is zero when x=a.
Returns 3 if there are variables other than x in base of exponent.
Return 0 otherwise, meaning no
obvious reason not to try L'Hopital's rule */
{ int i,err,err2;
unsigned short n;
term u;
double z;
long k;
if(ATOMIC(t))
return 0; /* safe */
if(FUNCTOR(t)=='^')
{ if(depends(ARG(1,t),x))
return 2;
if(ISINTEGER(ARG(1,t)))
return lhopital_warning(ARG(0,t),x,a);
if(!depends(ARG(0,t),x))
return 0;
subst(x,a,ARG(0,t),&u);
err = deval(u,&z);
if(err) return 3; /* non-numerical terms not safe */
if(nearint(z,&k) && k==0)
return 1;
err = deval(ARG(1,t),&z);
if(err)
return 1;
return lhopital_warning(ARG(0,t),x,a);
}
n = ARITY(t);
err = 0;
for(i=0;i<n;i++)
{ err2 = lhopital_warning(ARG(i,t),x,a);
if(err2 > err)
err = err2;
}
return err;
}
/*____________________________________________________________________*/
static int compose_leading_terms(unsigned short f,term u,term x,term a,term *c,term *deg)
/* Called by leading_term when t is f(u) and f is unary
to calculate the leading term of f(u), that is,
f(u(x)) = c (x-a)^d + higher powers of (x-a)^d.
Note that f can be singular at u(a), e.g. lim(x->1,tan( (1/2) pi x)
produces a call with f = TAN, u = (1/2)pi x, a = 1, and
we need to find *d = -1, *c = -1.
*/
/* compose the leading terms of lambda x.f(x) and u */
{ term uu,v,cf,df,cu,du,uofa;
int err,sign,signc;
if(ISINFINITE(a))
{ err = leading_term(u,x,a,&cu,&du);
if(err)
return 1;
if(equals(cu,bounded_oscillations))
return 1; /* too complicated to mess with */
sign = get_sign(du);
signc = get_sign(cu);
if(sign > 0)
{ /* u -> infinity as x-> infinity, if cu > 0,
or minusinfinity if cu < 0,
and \pm infinity as x-> -infinity if defined
*/
if(equals(a,infinity))
{ if(signc > 0)
uofa = infinity;
else
uofa = minusinfinity;
}
else /* a is minusinfinity */
{ if(INTEGERP(du))
{ if(ISEVEN(du))
uofa = infinity;
else
uofa = minusinfinity;
}
else if(!infer(even(du)))
uofa = infinity;
else if(!infer(odd(du)))
uofa = minusinfinity;
else
return 1;
}
}
else if(sign < 0)
{ /* u->0 as x->infinity */
v = make_term(f,1);
ARGREP(v,0,x);
uofa = zero;
}
else /* if sign == 0 */
{ /* u -> uofa as x->infinity where uofa is neither
zero nor infinite
Example: sin( pi x/(x+1)). Here u = pi_term x/(x+1) -> pi
as x->infinity.
*/
polyval(sum(u,tnegate(cu)),&uu);
uofa = cu;
err = leading_term(uu,x,a,&cu,&du);
if(err)
return 1;
}
v = make_term(f,1);
ARGREP(v,0,x);
err = leading_term(v,x,uofa,&cf,&df);
if(err)
return 1;
if(!POSNUMBER(df) &&
!(NEGATIVE(df) &&
(
(INTEGERP(ARG(0,df)) && ISODD(ARG(0,df))) || (RATIONALP(ARG(0,df)) && ISODD(ARG(1,ARG(0,df)))))
)
&&
get_sign(cu) <= 0
)
return 1;
if(equals(cf,bounded_oscillations))
*c = bounded_oscillations;
else
polyval(product(cf,make_power(cu,df)),c);
polyval(product(df,du),deg);
return 0;
}
/* Now a is not infinite */
err = leading_term(u,x,a,&cu,&du);
if(err)
return 1;
if(equals(cu,bounded_oscillations))
return 1; /* too complicated */
sign = get_sign(du);
if(sign == 0)
{ polyval(sum(u,tnegate(cu)),&uu);
uofa = cu;
err = leading_term(uu,x,a,&cu,&du);
if(err)
return 1;
if(equals(cu, bounded_oscillations))
return 1;
}
if(sign > 0)
uofa = zero;
if(sign < 0)
{ sign = get_sign(cu);
if(sign==0)
return 1;
err = infer(even(du));
if(!err)
uofa = sign > 0 ? infinity : minusinfinity;
else
return 1; /* e.g. e.g. f(tan x), a = pi_term/2; tan has an
odd-order pole so we have to give up */
}
v = make_term(f,1);
ARGREP(v,0,x);
err = leading_term(v,x,uofa,&cf,&df);
if(err)
return 1;
if(!POSNUMBER(df) &&
!(NEGATIVE(df) &&
(
(INTEGERP(ARG(0,df)) && ISODD(ARG(0,df))) ||
(RATIONALP(ARG(0,df)) && ISODD(ARG(1,ARG(0,df)))))
)
&&
get_sign(cu) <= 0
)
return 1;
if(equals(cf,bounded_oscillations))
*c = bounded_oscillations;
else
polyval(product(cf,make_power(cu,df)),c);
polyval(product(df,du),deg);
return 0;
}
/*_______________________________________________________________________*/
static int lt_plus2(term *args,int n, term x, term a, term leaddeg, term *c, term *deg)
/* args points to an array of n terms, the args of a sum.
Get the leading term of the sum--the term or sum of terms with the
least-power leading terms themselves.
It is assumed that the leading terms of the summands cancel out, so
we have to go for the next term. Example: x - sqrt(x(x+1)).
The degree of the cancelling leading term is given by leaddeg.
*/
{ int i,err;
term coef,exp,temp;
term nextcoef,m;
double mm, expm;
for(i=0;i<n;i++)
{ err = leading_term(args[i],x,a,&nextcoef,&m);
if(equals(m,leaddeg))
{ err = second_term(args[i],x,a,nextcoef,m,&nextcoef,&m);
if(ZERO(nextcoef))
{ if(i==0)
{ coef = nextcoef;
exp = m;
}
continue; /* no second term, ignore this term */
}
if(err)
return 1;
}
if(err)
return 1;
if(!seminumerical(m))
return 1;
if(i==0)
{ coef = nextcoef;
exp = m;
}
else
{ err = deval(m,&mm);
if(err)
return 1;
err = deval(exp,&expm);
if(err)
return 1;
if( (mm < expm && !NOTDEFINED(a)) ||
/* LOWER powers dominate when a is finite */
(mm > expm && NOTDEFINED(a))
/* HIGHER powers dominate when a is infinite */
)
{ exp = m;
coef = nextcoef;
}
else if(fabs(mm-expm) < 1.0e-10)
{ if(equals(coef, bounded_oscillations))
{ if(equals(nextcoef,bounded_oscillations))
return 1;
temp = bounded_oscillations;
}
else
polyval(sum(coef,nextcoef),&temp);
coef = temp;
}
}
}
if(ZERO(coef))
return 1; /* second terms ALSO cancel, give up */
*c = coef;
*deg = exp;
return 0;
}
/*______________________________________________________________________*/
static int adjust_values(term a,term x,term t)
/* adjust values of other variables so that
deval will work on t when x is near a
(on one side or the other). Set the value of x itself to
the value of a.
For example if t is sqrt(1-(c+x)^2)- sqrt(1-c^2)),
and a is 0, the value of c must be between -1 and 1.
This is a hopeless problem to solve in general but
we tackle it brute force if there is just one other
variable, running the other variable
from -10 to 10 by 0.1, which is 200 values to check;
and it will certainly catch some examples. The case
of a limit with ONE extra variable arises in
differentiating from definition, so it's an
important case.
In graph problems, this function should do
nothing, otherwise it will change the values of the
parameters of the graph. It is called while calculating
singularities, since putative singularities are tested
by computing limits.
*/
{ term *atomlist;
double z,w;
int nvars;
term c;
int i,j;
int problemtype;
deval(a,&w);
if(w == BADVAL)
return 1; /* a must be evaluable already */
problemtype = get_problemtype();
if(GRAPHTYPE(problemtype))
return 1; /* do nothing, as explained above */
if(FUNCTOR(t) == LIMIT)
t = LIMITAND(t); /* otherwise the presence of 'left' or 'right'
in a 3-sided limit causes wrong results. */
nvars = variablesin(t,&atomlist);
/* a can contain variables itself which can also occur in t, but we don't want
to tinker their values, so check if this is the case and if so, remove them
from atomlist. */
for(i=0;i<nvars;i++)
{ if(contains(a,FUNCTOR(atomlist[i])))
{ for(j=i+1;j < nvars; j++)
atomlist[j-1] = atomlist[j];
--nvars;
}
}
if(nvars == 0)
{ free2(atomlist);
deval(t,&z);
return z == BADVAL ? 1 : 0;
}
SETVALUE(x,w);
if(nvars > 2)
{ free2(atomlist);
return 1; /* failure */
}
if(nvars == 1)
{ if(equals(atomlist[0],x))
{ deval(t,&z);
if(z != BADVAL)
return 0;
return 1;
}
}
if(nvars != 2)
return 1; /* assert(0) */
if(equals(atomlist[0],x))
c = atomlist[1];
else if(equals(atomlist[1],x))
c = atomlist[0];
else
{ free2(atomlist);
return 1; /* t doesn't contain x */
}
free2(atomlist);
for(w = -10.0; w <= 10.0; w += 0.1)
{ SETVALUE(c,w);
deval(t,&z);
if(z != BADVAL)
return 0;
}
return 1;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists