Sindbad~EG File Manager
/*__________________________________________________________________*/
/*
M. Beeson. Limits by leading terms.
11.30.93 original date
11.12.98 last modified
*/
#include <assert.h>
#include <math.h>
#include "globals.h"
#include "ops.h"
#include "prover.h"
#include "polynoms.h"
#include "fraction.h"
#include "deriv.h"
#include "mplimits.h"
#include "deval.h"
#include "algaux.h"
#include "term2.h"
#include "pvalaux.h"
int second_term(term t, term x, term a, /* consider t as x->a */
term coef, term deg, /* assume it goes like coef *x^deg */
term *c, term *newdeg /* get the second-order term */
)
/*
This is only called if the first-order term (the one that goes like
coef *x^deg) is zero, e.g. on x - sqrt(x(x+2)) as x->infinity.
If there is no second term, i.e. t = coef x^leaddeg, then
return *c = *newdeg = zero. */
/* Return 0 for success, 1 for too-complicated, failure */
{ unsigned short i,f = FUNCTOR(t);
term u,v,p,m,q,n,k;
double zz;
unsigned short mm;
term aa[2],bb[2],cc[2],dd[2];
term tc,ts,exp1,exp2,exp3;
int err;
if(equals(t,x))
{ *c = zero;
*newdeg = zero;
return 0;
}
if(ATOMIC(t))
{ if(!seminumerical(deg))
return 1;
deval(deg,&zz);
if(zz > 0.0)
{ *newdeg = zero;
*c = t;
return 0;
}
else
{ *newdeg = *c = zero;
return 0;
}
}
switch(f)
{ case '-': err = second_term(ARG(0,t),x,a,coef,deg,&p,newdeg);
tneg(p,c);
return err;
case '^': if(equals(ARG(0,t),x) && equals(ARG(1,t),deg))
{ *newdeg = zero;
*c = zero;
return 0;
}
k = ARG(1,t);
u = ARG(0,t);
err = leading_term(u,x,a,&p,&m);
if(err)
return 1;
err = second_term(u,x,a,p,m,&q,&n);
if(err)
return 1;
/* (px^m + qx^n)^k has second term p^(m(k-1))q x^[(k-1)m+n] */
polyval(sum(product(sum(k,minusone),m),n),newdeg);
polyval(product3(k,make_power(p,product(m,sum(k,minusone))),q),c);
return 0;
case SQRT: u = ARG(0,t);
polyval(make_power(coef,two),&p);
polyval(product(two,deg),&m);
err = second_term(u,x,a,p,m,&q,&n);
if(err)
return 1;
/* sqrt(px^m + qx^n) = sqrt(px^m)sqrt(1+(q/p)x^(n-m)) =
sqrt(px^m)(1+q/(2p) x^(n-m)) =
sqrt(p) x^(m/2) + q/2sqrt(p) x^(n-m/2)
*/
if(ZERO(n) && ZERO(q))
{ *c = *newdeg = zero;
return 0;
}
polyval(sum(n, tnegate(make_fraction(m,two))),newdeg);
polyval(make_fraction(q,product(two, sqrt1(p))),c);
return 0;
case '*' : twoparts(t,x,&tc,&ts);
if(FUNCTOR(ts) != '*' || ARITY(ts) < ARITY(t))
{ err = second_term(ts,x,a,coef,deg,&q,newdeg);
if(err)
return 1;
polyval(product(tc,q),c);
return 0;
}
/* Now we have more than one nonconstant term */
/* It's possible that the second term is not
just what you'd expect from the product formula
for derivative, if there are 3 or more factors;
so we only products with 2 nonconstant factors. */
mm = ARITY(t);
if(mm > 2)
return 1;
for(i=0;i<mm;i++)
{ p = ARG(i,t);
err = leading_term(p,x,a,aa+i,bb+i);
if(err)
return 1;
err = second_term(p,x,a,aa[i],bb[i],cc+i,dd+i);
if(err)
return 1;
}
polyval(sum(bb[0],dd[1]),&exp1);
polyval(sum(bb[1],dd[0]),&exp2);
polyval(sum(exp1,tnegate(exp2)),&exp3);
if(ISZERO(exp3))
/* the two contributing terms have the same power */
{ *newdeg = exp1;
polyval(sum(product(aa[0], cc[1]),
product(aa[1],cc[0])
),c);
return 0;
}
if(!seminumerical(exp3))
return 1;
err = deval(exp3,&zz);
if(err)
return 1;
if(zz > 0.0) /* exp1 > exp2 */
{ *newdeg = exp1;
polyval(product(aa[0],cc[1]),c);
return 0;
}
if(zz < 0.0)
{ *newdeg = exp2;
polyval(product(aa[1],cc[0]),c);
return 0;
}
assert(0);
case '/':
/* 1/(first + 2nd) = (1/first)(1-2nd/first) =
1/first - 2nd/first^2 */
/* (r+s)/(first + second) = (r/first -r 2nd/first^2 + s/first) */
u = ARG(1,t);
err = leading_term(u,x,a,&p,&m);
if(err)
return 1;
err = second_term(u,x,a,p,m,&q,&n);
if(err)
return 1;
/* 1/(px^m + qx^n) = (1/p)x^-m (1/(1+(q/p)x^(n-m))) =
(1/p)x^-m (1-(q/p)x^(n-m)) =
px^-m - (q/p^2)x^(n-2m) */
if(ONE(ARG(0,t)))
{ if(ZERO(n) && ZERO(q))
{ *c = *newdeg = zero;
return 0; /* no second term */
}
polyval(sum(n,tnegate(product(two,m))),newdeg);
polyval(tnegate(make_fraction(q,make_power(p,two))),c);
return 0;
}
else
/* (rc x^r + sc x^s)/(px^m + qx^n) =
(rc x^r + sc x^s) [px^-m - (q/p^2)x^(n-2m)] =
rc p x^(r-m) + sc p x^(s-m) - rc q/p^2 x^(r + n - 2m)
*/
{ term r,s,rc,sc,new1,new2,dif,c1,temp;
err = leading_term(ARG(0,t),x,a,&rc,&r);
if(err)
return 1;
err = second_term(ARG(0,t),x,a,rc,r,&sc,&s);
if(err)
return 1;
if(ZERO(n) && ZERO(s) && ZERO(q) && ZERO(sc))
{ *newdeg = *c = zero;
return 0;
/* neither num nor denom has a second term */
}
if(ZERO(s) && ZERO(sc))
/* num has no second term */
{ temp = make_term('+',3);
ARGREP(temp,0,r);
ARGREP(temp,1,n);
ARGREP(temp,2,tnegate(product(two,m)));
polyval(temp,newdeg);
polyval(tnegate(make_fraction(product(rc,q),make_power(p,two))),c);
return 0;
}
if(ZERO(n) && ZERO(q))
/* denominator has no second term */
{ polyval(sum(s,tnegate(m)),newdeg);
polyval(make_fraction(sc,p),c);
return 0;
}
temp = make_term('+',3);
ARGREP(temp,0,r);
ARGREP(temp,1,n);
ARGREP(temp,2,tnegate(product(two,m)));
polyval(temp,&new1);
polyval(sum(s,tnegate(m)),&new2);
polyval(sum(new1,tnegate(new2)),&dif);
if(ISZERO(dif))
{ *newdeg = new1;
polyval(product(rc,make_fraction(q,make_power(p,two))),&c1);
polyval(sum(make_fraction(sc,p),tnegate(c1)),c);
return 0;
}
if(!seminumerical(dif))
return 1;
deval(dif,&zz);
if(zz > 0.0) /* new1 > new2 */
{ *newdeg = new1;
polyval(product(rc,make_fraction(q,make_power(p,two))),&c1);
tneg(c1,c);
return 0;
}
else if(zz < 0.0) /* new2 > new1 */
{ *newdeg = new2;
polyval(make_fraction(sc,p),c);
return 0;
}
assert(0);
}
case '+' : mm = ARITY(t);
for(i=0;i<mm;i++)
{ v = ARG(i,t);
err = leading_term(v,x,a,&q,&n);
if(err)
return 1;
polyval(sum(deg,tnegate(n)),&exp1);
if(ZERO(exp1))
{ err = second_term(v,x,a,coef,deg,&p,&m);
if(err)
return 1;
}
else
{ m = n;
p = q;
}
if(i==0)
{ *newdeg = m;
*c = p;
}
if(ZERO(p) && ZERO(m))
continue; /* this summand has no second term */
else
{ polyval(sum(*newdeg,tnegate(m)),&q);
if(ZERO(q))
polyval(sum(*c,p),c);
else
{ if(!seminumerical(q))
return 1;
err = deval(q,&zz);
if(err)
return 1;
if(zz < 0.0) /* discard *newdeg */
{ *newdeg = m;
*c = p;
}
}
}
}
return 0;
}
return 1;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists