Sindbad~EG File Manager
/* definite integration */
/*
7.12.92 original date
10.26.99 last modified.
8.26.04 Corrected oddintegrand.
*/
#include <string.h>
#include <assert.h>
#include <search.h>
#define TRIGCALC_DLL
#include "globals.h"
#include "calc.h"
#include "domain.h"
#include "eqn.h"
#include "numint.h"
#include "sigma.h"
#include "prover.h"
#include "deval.h"
#include "mathmode.h" /* get_mathmode */
#include "errbuf.h"
#include "defint.h"
#include "pvalaux.h" /* obviously_nonnegative */
#include "order.h" /* additive_sortargs */
#include "improper.h" /* split */
#include "psubst.h"
static void numerical_order(term);
static int parity(term, term);
static int zeroesofabs(term t, term x, term *ans);
static int parity_aux(unsigned short);
/* operators in this file go on the definite integration menu.
They are expected to take three lines on the menu, and the
justification strings they produce also take three lines. These
justification strings are written here on three lines relying on
Turbo C to concatenate adjacent string literals to a single string,
so this may require change when porting. The length of those
three strings is carefully chosen so that all together the three will
not exceed 4*(MAXREASONSTRING) (which at this writing is 4*21),
but each one is several characters longer than MAXREASONSTRING in
case that should increase one or two characters. */
/*_______________________________________________________________*/
MEXPORT_TRIGCALC int switchlimits(term t, term arg, term *next, char *reason)
/* switch limits in a definite integral (or the negation of an integral) */
{ term u,x,a,b;
int err;
if(FUNCTOR(t) != INTEGRAL)
return 1;
if(ARITY(t) != 4)
return 1;
u = ARG(0,t);
x = ARG(1,t);
a = ARG(2,t);
b = ARG(3,t);
if(get_mathmode() == AUTOMODE)
{ err = infer(lessthan(b,a));
if(err) /* don't do it in auto mode unless b < a */
return 1;
}
tneg(definite_integral(u,x,b,a),next);
strcpy(reason, "$$integral(u,t,a,b) = - integral(u,t,b,a)$$");
SETCOLOR(*next,YELLOW);
return 0;
}
/*_______________________________________________________________*/
MEXPORT_TRIGCALC int additivity(term t, term arg, term *next, char *reason)
/* additivity of definite integral */
{ term s,u,x,a,b,c;
unsigned short n;
int i,j,k;
if(FUNCTOR(t) != '+')
return 1;
n = ARITY(t);
k= 0; /* count the definite integrals */
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,t)) == INTEGRAL && ARITY(ARG(i,t))==4)
++k;
}
if(k < 2)
return 1;
for(i=0;i<n;i++)
{ for(j=0;j<n;j++)
/* check whether ARG(i,t) and ARG(j,t) combine */
{ if(j==i) continue;
if(FUNCTOR(ARG(i,t)) == INTEGRAL && ARITY(ARG(i,t)) == 4
&& FUNCTOR(ARG(j,t)) == INTEGRAL && ARITY(ARG(j,t)) == 4
)
{ u = ARG(0,ARG(i,t));
x = ARG(1,ARG(i,t));
a = ARG(2,ARG(i,t));
b = ARG(3,ARG(i,t));
c = ARG(3,ARG(j,t));
if(equals(x,ARG(1,ARG(j,t))) &&
equals(u,ARG(0,ARG(j,t))) &&
equals(b,ARG(2,ARG(j,t)))
)
{ s = definite_integral(u,x,a,c);
break;
}
}
}
if(j < n) /* found a match */
break; /* leave the i-loop */
}
if(i==n)
return 1; /* no match found */
if(n==2)
*next = s;
else
{ int min = i<j ? i : j;
int max = i<j ? j : i;
*next = make_term('+',(unsigned short)(n-1));
for(k=0;k<min;k++)
ARGREP(*next,k,ARG(k,t));
ARGREP(*next,min,s);
for(k=min+1;k<max;k++)
ARGREP(*next,k,ARG(k,t));
for(k=max;k<n-1;k++)
ARGREP(*next,k,ARG(k+1,t));
}
SETCOLOR(*next,YELLOW);
strcpy(reason, "$$integral(u,x,a,b) + integral(u,x,b,c) = integral(u,x,a,c)$$");
return 0;
}
/*______________________________________________________________________*/
int insertpoint_aux(term t, term arg, term *next, int flag)
/* do the work of insertpoint; if flag is zero, check
that the intermediate point(s) in arg lie between the limits
of integration, otherwise do not check it. Presumes that
MathXpert can infer either a <= b or b <= a, where a and b
are the limits of integration.
*/
{ unsigned short n; /* number of new integrals */
unsigned short k;
term a,b,x,u,v,w,r,temp,p,q,s;
int i,j,err,nzeroes,savebinderflag;
int leftendpointflag, rightendpointflag;
u = ARG(0,t); /* the integrand */
x = ARG(1,t); /* the variable of integration */
a = ARG(2,t);
b = ARG(3,t);
if(FUNCTOR(arg) == ILLEGAL && contains(u,ABS))
{ nzeroes = zeroesofabs(t,x,&arg);
if(nzeroes <= 0)
return 1;
}
else if(FUNCTOR(arg) == ILLEGAL && IMPROPER(t))
{ /* called on improper integrals in auto mode */
savebinderflag = get_lpt_binderflag();
set_lpt_binderflag(0);
v = lpt(domain(u));
set_lpt_binderflag(savebinderflag);
if(equals(v,true))
return 1;
if(FUNCTOR(v) == '<' && equals(ARG(0,v),a) && equals(ARG(1,v),x))
{ /* singular at left endpoint only */
if(!equals(b,infinity))
return 1;
arg = split(a,b);
}
else if(FUNCTOR(v) == '<' && equals(ARG(1,v),b) && equals(ARG(0,v),x))
{ if(!equals(a,minusinfinity))
return 1;
arg = split(a,b);
}
else if(FUNCTOR(v) == NE && equals(ARG(0,v),x))
{ r = ARG(1,v);
if(contains(r,FUNCTOR(x)))
return 1;
if(ISINFINITE(a) && ISINFINITE(b))
{ q = split(r,b);
w = split(a,r);
arg = and3(w,r,q);
}
else if(ISINFINITE(b))
{ if(equals(r,a))
arg = split(a,b);
else
{ q = split(r,b);
arg = and(r,q);
}
}
else if(ISINFINITE(a))
{ if(equals(r,b))
arg = split(a,b);
else
{ q = split(a,r);
arg = and(q,a);
}
}
else if(equals(r,a) || equals(r,b))
return 1;
else
arg = r;
}
else if(FUNCTOR(v) == AND && ARITY(v) == 2 &&
FUNCTOR(ARG(0,v)) == '<' && equals(ARG(0,ARG(0,v)),a) && equals(ARG(1,ARG(0,v)),x) &&
FUNCTOR(ARG(1,v)) == '<' && equals(ARG(0,ARG(1,v)),x) && equals(ARG(1,ARG(1,v)),b)
)
/* singular at left and right endpoints only */
arg = split(a,b);
else if(FUNCTOR(v) == AND)
{ arg = make_term(AND,ARITY(v));
k = 0;
leftendpointflag = rightendpointflag = 0;
for(i=0;i<ARITY(arg);i++)
{ w = ARG(i,v);
if(FUNCTOR(w) != NE)
{ if(FUNCTOR(w) == '<' && equals(ARG(0,w),a) && equals(ARG(1,w),x))
leftendpointflag = 1; /* singular at left endpoint */
if(FUNCTOR(w) == '<' && equals(ARG(1,w),b) && equals(ARG(0,w),x))
rightendpointflag = 1; /* singular at right endpoint */
}
if(!equals(ARG(0,w),x))
{ RELEASE(arg);
return 1;
}
if(contains(ARG(1,w),FUNCTOR(x)))
{ RELEASE(arg);
return 1;
}
if(equals(ARG(1,w),a))
continue;
if(equals(ARG(1,w),b))
continue;
ARGREP(arg,k,ARG(1,w));
++k;
}
if(k==0)
{ RELEASE(arg);
return 1;
}
if(k==1)
{ temp = ARG(0,arg);
RELEASE(arg);
if(ISINFINITE(a) && ISINFINITE(b))
{ w = split(a,temp);
q = split(temp,b);
arg = and3(w,temp,q);
}
else if(ISINFINITE(a))
{ if(equals(temp,b))
arg = split(a,b);
else
{ q = split(a,temp);
arg = and(q,temp);
}
}
else if(ISINFINITE(b))
{ if(equals(temp,a))
arg = split(a,b);
else
{ q = split(temp,b);
arg = and(temp,q);
}
}
else
arg = temp;
}
else
{ SETFUNCTOR(arg,AND,k);
additive_sortargs(arg);
if((ISINFINITE(a) || leftendpointflag) && (ISINFINITE(b) || rightendpointflag))
{ temp = make_term(AND,(unsigned short)(2*k+1));
r = split(a,ARG(0,arg));
ARGREP(temp,0,r);
for(i=0;i<k;i++)
{ v = ARG(i,arg);
w = i+1 < k ? ARG(i+1,arg) : b;
p = split(v,w);
ARGREP(temp,2*i+1,v);
ARGREP(temp,2*i+2,p);
}
arg = temp;
}
else if(ISINFINITE(a) || leftendpointflag)
{ temp = make_term(AND,(unsigned short)(2*k));
/* don't split the last interval */
for(i=0;i<k;i++)
{ v = ARG(i,arg);
w = i==0 ? a : ARG(i-1,arg);
p = split(v,w);
ARGREP(temp,2*i,p);
ARGREP(temp,2*i+1,v);
}
arg = temp;
}
else if(ISINFINITE(b) || rightendpointflag)
{ temp = make_term(AND, (unsigned short)(2*k));
/* don't split the first interval */
for(i=0;i<k;i++)
{ v = ARG(i,arg);
w = i==k-1 ? b : ARG(i+1,arg);
p = split(v,w);
ARGREP(temp, 2*i,v);
ARGREP(temp, 2*i+1,p);
}
arg = temp;
}
else /* neither a nor b is infinite and the function
isn't singular at either endpoint */
{ temp = make_term(AND, (unsigned short)(2*k-1));
for(i=0;i<k-1;i++)
{ v = ARG(i,arg);
w = ARG(i+1,arg);
p = split(v,w);
ARGREP(temp,2*i,v);
ARGREP(temp,2*i + 1, p);
}
ARGREP(temp, 2*k-2,ARG(k-1,arg));
arg = temp;
}
}
}
else
return 1;
}
if(FUNCTOR(arg) == ILLEGAL)
return 1; /* integral was not labelled IMPROPER */
if(FUNCTOR(arg) == AND)
{ n = (unsigned short)(1 + ARITY(arg));
additive_sortargs(arg);
if(infer(le(a,b))) /* that is, if the inference fails */
{ if(!infer(le(b,a)))
{ /* b <= a, so reverse the order of arguments of arg */
temp = make_term(AND,ARITY(arg));
for(j=0;j<ARITY(arg);j++)
ARGREP(temp,j,ARG(ARITY(arg)-j-1,arg));
arg = temp;
}
else
return 1; /* assert(0); /* calling function must ensure that the order of the limits of
integration can be decided */
}
*next = make_term('+',n);
for(i=0;i<n;i++)
{ if(i==0)
{ s = ARG(0,arg);
w = a;
}
else if(i==n-1)
{ w = ARG(n-2,arg);
s = b;
}
else
{ w = ARG(i-1,arg);
s = ARG(i,arg);
}
if(equals(b,infinity) && equals(a,minusinfinity))
flag = 1;
if(!flag)
{ if(equals(b,infinity))
err = check(lessthan(a,s));
else if(equals(a,minusinfinity))
err = check(lessthan(s,b));
else if(i+1 < n)
err = check(and(lessthan(a,s),lessthan(s,b)));
else if(i+1 == n)
err = 0;
if(err)
{ errbuf(0,english(785));
return 1;
}
}
v = definite_integral(u,x,w,s);
if(IMPROPER(t))
SETIMPROPER(v);
ARGREP(*next,i,v);
}
}
else /* only one intermediate point */
{ if(equals(arg,a) || equals(arg,b))
{ errbuf(0,english(785));
/* The new point must be between the limits of integration */
return 1;
}
if(!flag)
{ err = check(and(lessthan(a,arg),lessthan(arg,b)));
if(err)
{ errbuf(0,english(785));
return 1;
}
}
v = definite_integral(u,x,a,arg);
w = definite_integral(u,x,arg,b);
if(IMPROPER(t))
{ SETIMPROPER(v);
SETIMPROPER(w);
}
*next = sum(v,w);
}
HIGHLIGHT(*next);
return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int insertpoint(term t, term arg, term *next, char *reason)
/* integral(u,x,a,c) = integral(u,x,a,arg) + integral(u,x,arg,c) */
/* arg is the new point, or it can also be a LIST of points, in
which case more than two integrals will result on the right
In menu mode or selection mode, the user supplies arg.
This operator is used in automode only on improper integrals, and
on integrals containing ABS. If the integrand is an ABS, then
it is called indirectly from breakabsint, see below.
In automode or menumode, it
checks that the new point is between the old limits of
integration. Without this, it will be applied to the leftmost
integral when there are two, with ludicrous results if the point
is intended to break up the second interval. In term selection
mode it does not check this.
*/
{ int err;
term a,b;
int mathmode;
short savenextassumption;
if(FUNCTOR(t) != INTEGRAL || ARITY(t) != 4)
return 1; /* only works on definite integrals */
a = ARG(2,t);
b = ARG(3,t);
savenextassumption = get_nextassumption();
if(!equals(b,infinity) && !equals(a,minusinfinity) && /* then no point in trying to infer the order of a,b */
infer(le(a,b)) && infer(le(b,a)) /* that is, neither thing can be inferred */
)
assume(le(a,b));
mathmode = get_mathmode();
if(mathmode == SELECTIONMODE || mathmode == AUTOMODE)
err = insertpoint_aux(t,arg,next,1);
else /* MENUMODE, using the operations menu. See comments above */
err = insertpoint_aux(t,arg,next,0);
if(err)
{ set_nextassumption(savenextassumption);
return 1;
}
strcpy(reason, "$$integral(u,x,a,c) = integral(u,x,a,b) + integral(u,x,b,c)$$");
return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int breakabsint(term t, term arg, term *next, char *reason)
/* break integral(abs(f(t)),t,a,b) into two or more integrals at the
zeroes of f(t) between a and b, if MathXpert can find them.
*/
{ unsigned short n; /* number of new integrals */
unsigned short m,k;
term a,c,x,u,v,w,temp;
int i,err;
int goforit = 0;
if(FUNCTOR(t) != INTEGRAL || ARITY(t) != 4)
return 1; /* only works on definite integrals */
u = ARG(0,t); /* the integrand */
x = ARG(1,t); /* the variable of integration */
a = ARG(2,t);
c = ARG(3,t);
/* This operator cannot take an arg from the user,
it constructs its own arg. */
if(FUNCTOR(u) == ABS)
{ goforit = 1;
v = u;
}
if(FUNCTOR(u) == '*')
{ m = ARITY(u);
for(i=0;i<m;i++)
{ v = ARG(i,u);
if(FUNCTOR(v) == ABS)
{ goforit = 1;
break;
}
}
}
if(!goforit)
return 1; /* didn't find ABS anywhere */
w = equation(ARG(0,v),zero);
err = ssolve(w,x,&temp);
RELEASE(w);
if(err)
return 1; /* can't solve the equation for the desired points */
if(equals(temp,false) || equals(temp,true))
return 1; /* integrand has one sign throughout the interval, so
abspos or absneg should work. */
if(FUNCTOR(temp) == '=')
{ arg = ARG(1,temp);
err = check(and(lessthan(a,arg),lessthan(arg,c)));
if(err)
return 1;
}
if(FUNCTOR(temp) == OR) /* more than one solution */
{ n = ARITY(temp);
arg = make_term(AND,n);
k=0;
for(i=0;i<n;i++)
{ w = ARG(i,temp);
if(FUNCTOR(w) == MULTIPLICITY)
w = ARG(0,w);
assert(FUNCTOR(w) == '=');
if(equals(ARG(1,w),a) || equals(ARG(1,w),c))
continue;
err = check(and(lessthan(a,ARG(1,w)),lessthan(ARG(1,w),c)));
if(err)
continue;
ARGREP(arg,k,ARG(1,w));
++k;
}
if(k==0)
{ RELEASE(arg);
return 1;
}
if(k==1)
{ temp = ARG(0,arg);
RELEASE(arg);
arg = temp;
}
else
{ SETFUNCTOR(arg,AND,k);
numerical_order(arg);
}
}
err = insertpoint_aux(t,arg,next,1);
if(err)
return 1;
strcpy(reason, english(680)); /* break �|f(t)| dt */
return 0;
}
/*______________________________________________________________*/
MEXPORT_TRIGCALC int evalbar(term t, term arg, term *next, char *reason)
/* eliminate EVAL; EVAL(u,x,a,b) goes to u(b) - u(a) */
/* except if the lower limit a is an equality x=c then it goes to u(b)-u(c) */
{ term u,x,a,b,p,q;
if(FUNCTOR(t) != EVAL)
return 1;
u = ARG(0,t);
x = ARG(1,t);
a = ARG(2,t);
if(FUNCTOR(a) == '=')
{ assert(equals(ARG(0,a),x));
a = ARG(1,a);
}
b = ARG(3,t);
subst(a,x,u,&p);
subst(b,x,u,&q);
*next = sum(q,tnegate(p));
SETCOLOR(*next,YELLOW);
strcpy(reason, "$$eval(f(t),t,a,b) = f(b)-f(a)$$");
return 0;
}
/*______________________________________________________________*/
MEXPORT_TRIGCALC int evalbarln(term t, term arg, term *next, char *reason)
/* eliminate EVAL; EVAL(ln u,x,a,b) goes to ln(u(b)/u(a)) */
/* except if the lower limit a is an equality x=c then it goes to u(b)-u(c) */
{ term u,x,a,b,p,q;
if(FUNCTOR(t) != EVAL)
return 1;
u = ARG(0,t);
x = ARG(1,t);
a = ARG(2,t);
if(FUNCTOR(u) != LN)
return 1;
if(FUNCTOR(a) == '=')
{ assert(equals(ARG(0,a),x));
a = ARG(1,a);
}
b = ARG(3,t);
subst(a,x,ARG(0,u),&p);
subst(b,x,ARG(0,u),&q);
*next = ln1(make_fraction(q,p));
SETCOLOR(*next,YELLOW);
strcpy(reason, "$$eval(ln f(t),t,a,b) = ln(f(b)/f(a))$$");
return 0;
}
/*______________________________________________________________*/
MEXPORT_TRIGCALC int pureintegratenumerically(term t, term arg, term *next, char *reason)
/* Numerical integration, no parameters allowed */
{ int nfree;
term *atomlist;
if(FUNCTOR(t) != INTEGRAL || ARITY(t) != 4)
return 1;
nfree = freevars(t,&atomlist);
free2(atomlist);
if(nfree)
return 1;
return integratenumerically(t,arg,next,reason);
}
/*______________________________________________________________*/
MEXPORT_TRIGCALC int integratenumerically(term t, term arg, term *next, char *reason)
{ int err;
term u,x,v;
double a,b,ans;
if(FUNCTOR(t) != INTEGRAL || ARITY(t) != 4)
return 1;
u = ARG(0,t);
x = ARG(1,t);
err = eval_aux(t,arg,&v,reason); /* substitute parameter value if any
in limits of integral */
if(err)
{ errbuf(0, english(1286));
/* Upper and lower limits must be or evaluate to numbers. */
return 1;
}
strcpy(reason, english(1424)); /* numerical integration */
err = deval(ARG(2,t),&a);
if(err)
{ errbuf(0, english(784));
/* Can't compute lower limit of integral. */
return 1;
}
err = deval(ARG(3,t),&b);
if(err)
{ errbuf(0, english(794));
/* Can't compute upper limit of integral. */
return 1;
}
if(contains(u,DIFF))
{ errbuf(0, english(1425));
/* You must first evaluate the derivative in the integrand. */
return 1;
}
if(contains(u,LIMIT))
{ errbuf(0, english(1426));
return 1;
}
if(contains(u,INTEGRAL))
{ errbuf(0, english(1427));
return 1;
}
err = numint(u,x,a,b,&ans);
if(err)
{ return 1;
}
*next = make_double(ans);
SETCOLOR(*next,YELLOW);
return 0; /* eval_aux has set the reason string */
}
/*___________________________________________________________*/
/* numerical order comparison function for use in qsort */
static int ttcompare(const void *a, const void *b)
{ short ans;
tcompare( *(term *)a, *(term *)b,&ans);
return ans;
}
/*___________________________________________________________*/
/* order comparison function for use in qsort which works
if the difference of the inputs is numerical. Otherwise
it will just return some arbitrary value.
*/
static int sscompare(const void *a, const void *b)
{ short ans;
term temp;
term aa = * (term *)a;
term bb = * (term *)b;
if(seminumerical(aa) && seminumerical(bb))
{ tcompare( *(term *)a, *(term *)b,&ans);
return ans;
}
polyval(sum(aa,tnegate(bb)),&temp);
if(seminumerical(temp))
{ tcompare(temp,zero,&ans);
return ans;
}
return -1;
}
/*___________________________________________________________*/
static void numerical_order(term t)
/* put the args of t in correct ascending numerical order if
all of them are seminumerical. If the pairwise differences are
seminumerical, the args will also be correctly ordered. Otherwise
nothing is predictable about the order of args of t. */
{ unsigned short n = ARITY(t);
int i;
for(i=0;i<n;i++)
{ if(!seminumerical(ARG(i,t)))
break;
}
if(i==n) /* all args seminumerical */
qsort(ARGPTR(t),n,sizeof(term),ttcompare);
else
qsort(ARGPTR(t),n,sizeof(term),sscompare);
}
/*___________________________________________________________*/
MEXPORT_TRIGCALC int oddintegrand(term t, term arg, term *next, char *reason)
/* integral(u,x,-a,a) = 0 (u odd)
*/
{ term a,b,u,x;
if(FUNCTOR(t) != INTEGRAL || ARITY(t) != 4)
return 1; /* it only works on definite integrals */
u = ARG(0,t); /* the integrand */
x = ARG(1,t); /* the variable of integration */
a = ARG(2,t); /* the lower limit */
b = ARG(3,t); /* the upper limit */
if(NEGATIVE(a) && !equals(b,ARG(0,a)))
return 1;
if(NEGATIVE(b) && !equals(a,ARG(0,b)))
return 1;
if(!NEGATIVE(a) && !NEGATIVE(b))
return 1;
if(parity(u,x) != -1)
{ errbuf(0, english(811));
/* u(x) = -u(-x) isn't true for this integrand. */
return 1;
}
if(IMPROPER(t) && !obviously_nonnegative(u) && infer(nonnegative(u)))
{ errbuf(0, english(2232));
errbuf(1, english(2233));
/* This operation cannot be applied to an improper integral
unless the integrand is nonnegative. */
return 1;
}
*next = zero;
SETCOLOR(*next,YELLOW);
strcpy(reason, english(1173));
/* odd integrand */
return 0;
}
/*___________________________________________________________*/
static int get_parent(term x, term t, term *ans)
/* return in *ans the parent of the leftmost occurrence of x in t,
if x occurs in t. Return 0 for success. If x does not occur in t,
return 1.
*/
{ unsigned short n;
int i,err;
if(ATOMIC(t))
return 0;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(equals(x,ARG(i,t)))
{ *ans = t;
return 0;
}
err = get_parent(x,ARG(i,t),ans);
if(!err)
return 0;
}
return 1;
}
/*___________________________________________________________*/
static int even_aux(term t, term x)
/* return 1 if t is of the form f((x+a)^2) + f((x-a)^2) or
the same with * instead of +. These functions are even, in
spite of the fact that not all their subterms are even.
Return 0 if t is not of the specified form.
*/
{ unsigned short f = FUNCTOR(t);
unsigned short n;
int i,err;
term a,p,q,test,test2,test3;
int savenvariables;
short savenextassumption;
term v0;
if(FRACTION(t) && !contains(ARG(0,t),FUNCTOR(x)))
return even_aux(ARG(1,t),x);
if(FRACTION(t) && !contains(ARG(1,t),FUNCTOR(x)))
return even_aux(ARG(0,t),x);
if(f != '+' && f != '*')
return 0;
if(ARITY(t) != 2)
return 0;
/* Now identify the subterm x+a or x-a */
err = get_parent(x,ARG(0,t),&p);
if(err)
return 0;
if(FUNCTOR(p) != '+')
return 0;
n = ARITY(p);
if(equals(ARG(0,p),x))
{ if(n == 2)
a = ARG(1,p);
else
{ a = make_term('+',(unsigned short)(n-1));
for(i=1;i<n;i++)
ARGREP(a,(unsigned short)(i-1),ARG(i,p));
}
}
else if(n == 2 && NEGATIVE(ARG(1,p)) && equals(x,ARG(0,ARG(1,p))))
a = tnegate(ARG(0,p));
else if(n == 2 && equals(ARG(1,p),x))
a = ARG(0,p);
err = get_parent(p,ARG(0,t),&q);
/* check whether p occurs to an even power; if not we can save
allocating memory to do the substitutions below. */
if(FUNCTOR(q) != '^')
return 0;
if(!iseven(ARG(1,q)))
return 0;
savenvariables = get_nvariables();
savenextassumption = get_nextassumption();
v0 = getnewvar(t,"abcdxyz");
psubst(v0,make_power(p,two),ARG(0,t),&test);
if(contains(test,FUNCTOR(x)))
{ err = 1;
goto out;
}
q = sum(x,tnegate(a));
psubst(v0,make_power(q,two),ARG(1,t),&test2);
if(contains(test2,FUNCTOR(x)))
{ psubst(v0,make_power(sum(a,tnegate(x)),two),test2,&test3);
if(contains(test3,FUNCTOR(x)))
{ err = 1;
goto out;
}
}
err = equals(test,test3) ? 0 : 1;
out:
set_nvariables(savenvariables);
set_nextassumption(savenextassumption);
return err;
}
/*___________________________________________________________*/
MEXPORT_TRIGCALC int evenintegrand(term t, term arg, term *next, char *reason)
/*
�a �a
| u dx =2| u dx (u even)
�-a �0
*/
{ term a,b,u,x;
if(FUNCTOR(t) != INTEGRAL || ARITY(t) != 4)
return 1; /* it only works on definite integrals */
u = ARG(0,t); /* the integrand */
x = ARG(1,t); /* the variable of integration */
a = ARG(2,t); /* the lower limit */
b = ARG(3,t); /* the upper limit */
if(NEGATIVE(a) && !equals(b,ARG(0,a)))
return 1;
if(NEGATIVE(b) && !equals(a,ARG(0,b)))
return 1;
if(!NEGATIVE(a) && !NEGATIVE(b))
return 1;
if(parity(u,x) == 1) /* all subterms are even */
goto success;
else if(even_aux(u,x))
goto success;
else
{ errbuf(0, english(813));
/* u(x) = u(-x) isn't true for this integrand. */
return 1;
}
success:
*next = product(two,definite_integral(u,x,zero,b));
SETCOLOR(ARG(0,*next),YELLOW);
SETCOLOR(ARG(2,ARG(1,*next)),YELLOW);
strcpy(reason, english(1174)); /* even integrand */
return 0;
}
/*_____________________________________________________________*/
static int parity(term t, term x)
/* Return 1 if t is an even function of x, -1 if t is an odd function
of x, 0 if it is neither. Zero counts as even, not odd. */
{ unsigned short f,n;
int i,p,q,err;
term s;
polyval(t,&s);
/* otherwise we might get wrong answers from zero summands etc. */
if(ISATOM(s) && equals(s,x))
return -1;
if(ATOMIC(s))
return 1; /* constants are even, including zero */
f = FUNCTOR(s);
n = ARITY(s);
if(n==1)
{ p = parity(ARG(0,s),x);
if(p==0 || p==1)
return p; /* f(g(x)) is even if g is even */
/* Now g is odd so f(g(-x)) = f(-g(x)) = �f(g(x), parity same as f */
return parity_aux(f);
}
switch(f)
{ case '+':
/* a sum of odd/even functions is odd/even */
for(i=0;i<n;i++)
{ p = parity(ARG(i,s),x);
if(p==0)
return 0;
if(i==0)
q=p;
else if(p != q)
return 0;
}
return p;
case '/': /* fall-through */
case '*':
q = 1;
for(i=0;i<n;i++)
{ p = parity(ARG(i,s),x);
if(p==0)
return 0;
q *= p;
}
return q;
case '^':
if(!contains(ARG(0,s),FUNCTOR(x)))
{ p = parity(ARG(1,s),x);
if(p == 1)
return 1;
}
p = parity(ARG(0,s),x);
if(p==0)
return 0;
if(INTEGERP(ARG(1,s)))
{ if(ISEVEN(ARG(1,s)))
return 1;
else
return p;
}
else if(FRACTION(ARG(1,s)))
return 0;
else
{ err = infer(even(ARG(1,s)));
if(!err)
return 1;
err = infer(odd(ARG(1,s)));
if(!err)
return -1;
}
return 0;
case ROOT: return 0;
case LOGB: return 0;
case BESSELJ:
return parity(make_power(ARG(1,s),ARG(0,s)),x);
/* the same conditions hold for x� as for j(n,x) */
}
return 0;
}
/*_________________________________________________________________*/
static int parity_aux(unsigned short f)
/* f is a unary functor. Return 1 if f is an even function, -1 if it's odd,
zero if neither */
{ switch(f)
{ case SIN: /* fall-through */
case CSC:
case COT:
case TAN: return -1;
case COS: return 1;
case SEC: return 1;
case ABS: return 1;
case DET: return 1;
case SINH: return -1;
case COSH: return 1;
case TANH: return -1;
}
return 0;
}
/*_______________________________________________________*/
MEXPORT_TRIGCALC int integraltolimit(term t, term arg, term *next, char *reason)
/* convert improper integral to limit of integral at infinity */
{ term u,x,a,b,s;
int err;
if(FUNCTOR(t) != INTEGRAL || ARITY(t) != 4)
return 1;
a = ARG(2,t);
b = ARG(3,t);
x = ARG(1,t);
u = ARG(0,t);
if(!equals(b,infinity))
return 1;
if(equals(a,minusinfinity))
{ errbuf(0,english(2291));
errbuf(1,english(2292));
/* When both limits are infinite, you must break the integral first.
The limits at the two ends must exist separately. */
return 1;
}
err = infer(domain(u));
if(err)
{ errbuf(0, english(2279));
errbuf(1, english(2280));
/* The integrand is not defined on the entire interval of integration.
You should break it into two or more integrals first. */
return 1;
}
s = getnewvar(t,"tzusr");
*next = limit(arrow(s,infinity),definite_integral(u,x,a,s));
HIGHLIGHT(*next);
strcpy(reason,"$$integral(u,x,a,infinity) = lim(t->infinity,integral(u,x,a,t))$$");
return 0;
}
/*___________________________________________________________*/
MEXPORT_TRIGCALC int integraltolimit2(term t, term arg, term *next, char *reason)
/* convert improper integral to limit of integral at minusinfinity */
{ term u,x,a,b,s;
int err;
if(FUNCTOR(t) != INTEGRAL || ARITY(t) != 4)
return 1;
a = ARG(2,t);
b = ARG(3,t);
x = ARG(1,t);
u = ARG(0,t);
if(!equals(a,minusinfinity))
return 1;
if(equals(b,infinity))
{ errbuf(0,english(2291));
errbuf(1,english(2292));
/* When both limits are infinite, you must break the integral first.
The limits at the two ends must exist separately. */
return 1;
}
err = infer(domain(u));
if(err)
{ errbuf(0, english(2279));
errbuf(1, english(2280));
/* The integrand is not defined on the entire interval of integration.
You should break it into two or more integrals first. */
return 1;
}
s = getnewvar(t,"tzusr");
*next = limit(arrow(s,minusinfinity), definite_integral(u,x,s,b));
HIGHLIGHT(*next);
strcpy(reason,"$$integral(u,x,-infinity,b) = lim(t->-infinity,integral(u,x,t,b))$$");
return 0;
}
/*___________________________________________________________*/
MEXPORT_TRIGCALC int integraltolimit3(term t, term arg, term *next, char *reason)
/* convert improper integral to limit of integral at left endpoint */
{ term u,x,a,b,s,v;
int err,savebinderflag;
short savenextassumption;
double z;
if(FUNCTOR(t) != INTEGRAL || ARITY(t) != 4)
return 1;
a = ARG(2,t);
b = ARG(3,t);
if(ISINFINITE(a) || ISINFINITE(b))
return 1;
x = ARG(1,t);
u = ARG(0,t);
subst(a,x,u,&v);
deval(v,&z);
if(z != BADVAL)
return 1;
savenextassumption = get_nextassumption();
assume(lessthan(a,x));
savebinderflag = get_lpt_binderflag();
set_lpt_binderflag(0);
err = infer(domain(u));
set_lpt_binderflag(savebinderflag);
set_nextassumption(savenextassumption);
if(err)
{ errbuf(0, english(2279));
errbuf(1, english(2281));
/* The integrand is undefined somewhere besides the left endpoint.
You should break it into two or more integrals first. */
return 1;
}
s = getnewvar(t,"tzusr");
*next = limit3(arrow(s,a),right, definite_integral(u,x,s,b));
HIGHLIGHT(*next);
strcpy(reason, "$$integral(u,x,a,b) = lim(t->a+,integral(u,x,t,b))$$");
return 0;
}
/*___________________________________________________________*/
MEXPORT_TRIGCALC int integrateemptyinterval(term t, term arg, term *next, char *reason)
/* integral(f(x),x,a,a)=0 */
{ term a,b;
if(FUNCTOR(t) != INTEGRAL || ARITY(t) != 4)
return 1;
a = ARG(2,t);
b = ARG(3,t);
if(!equals(a,b))
return 1;
*next = zero;
HIGHLIGHT(*next);
strcpy(reason, "$$integral(u,x,a,a) = 0$$");
return 0;
}
/*___________________________________________________________*/
MEXPORT_TRIGCALC int integraltolimit4(term t, term arg, term *next, char *reason)
/* convert improper integral to limit of integral at right endpoint */
/* Integrand must be undefined at the right endpoint. */
{ term u,x,a,b,s,v;
double z;
int err,savebinderflag;
short savenextassumption;
if(FUNCTOR(t) != INTEGRAL || ARITY(t) != 4)
return 1;
a = ARG(2,t);
b = ARG(3,t);
if(ISINFINITE(a) || ISINFINITE(b))
return 1;
x = ARG(1,t);
u = ARG(0,t);
subst(b,x,u,&v);
deval(v,&z);
if(z != BADVAL)
return 1;
savenextassumption = get_nextassumption();
assume(lessthan(x,b));
savebinderflag = get_lpt_binderflag();
set_lpt_binderflag(0);
err = infer(domain(u));
set_lpt_binderflag(savebinderflag);
set_nextassumption(savenextassumption);
if(err)
{ errbuf(0, english(2279));
errbuf(1, english(2282));
/* The integrand is undefined somewhere besides the right endpoint.
You should break it into two or more integrals first. */
return 1;
}
s = getnewvar(t,"tzusr");
*next = limit3(arrow(s,b),left, definite_integral(u,x,a,s));
HIGHLIGHT(*next);
strcpy(reason, "$$integral(u,x,a,b) = lim(t->b-,integral(u,x,s,t))$$");
return 0;
}
/*____________________________________________________________*/
static int zeroesofabs(term t, term x, term *ans)
/* t contains ABS; if possible, return *ans as an AND of
the values of x for which the subterms of t with functor ABS are zero,
or a single value if there is only one such value of x.
Example, if t = e^-abs(x), return *ans = zero.
Return the number of such values found. Return -1 for err,
in case the equation could not be solved.
*/
{ unsigned short n;
int k,i,err,flag=0,count;
term mid,u;
unsigned short f = FUNCTOR(t);
if(ATOMIC(t))
return 0;
if(f == ABS)
{ if(equals(ARG(0,t),x))
{ *ans = zero;
return 1;
}
err = ssolve(equation(ARG(0,t),zero),x,&mid);
if(err)
return -1;
/* Now mid is an equation or list of equations. Strip off the
values on the right side of those equations. */
if(FUNCTOR(mid) == '=' && equals(ARG(0,mid),x))
{ *ans = ARG(1,mid);
return 1;
}
if(FUNCTOR(mid) == AND)
{ n = ARITY(mid);
*ans = make_term(AND,n);
for(i=0;i<n;i++)
{ u = ARG(i,mid);
if(FUNCTOR(u) != '=' || !equals(ARG(0,u),x))
return -1;
ARGREP(*ans,i,ARG(1,u));
}
return n;
}
return -1;
}
n = ARITY(t);
count = 0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(!contains(u,ABS))
continue;
k = zeroesofabs(u,x,&mid);
if(k < 0)
return -1;
count += k;
if(!flag)
*ans = mid;
else if(FUNCTOR(*ans) != AND && FUNCTOR(mid) != AND)
*ans = and(*ans,mid);
else
*ans = topflatten(and(*ans,mid));
++flag;
}
if(count > 1 && (FUNCTOR(*ans) != AND || ARITY(*ans) != count))
assert(0);
return count;
}
# if 0
/*___________________________________________________________*/
MEXPORT_TRIGCALC int improperintpower(term t, term arg, term *next, char *reason)
/* improper integral at infinity of a power of x */
/* integral(x^n,x,a,infinity) = infinity if n >= -1 */
{ term u,x,a,b,s,v;
if(FUNCTOR(t) != INTEGRAL || ARITY(t) != 4)
return 1;
a = ARG(2,t);
b = ARG(3,t;
x = ARG(1,t);
u = ARG(0,t);
if(FUNCTOR(u) != '^' || !equals(x,ARG(0,u)))
return 1;
v = ARG(1,u);
if(!equals(b,infinity))
return 1;
if(INTEGERP(v) || RATIONALP(v))
*next = infinity;
return 0;
}
#endif
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists