Sindbad~EG File Manager
/* Integration by substitution for MathXpert */
/* M. Beeson, integration by substitution for MathXpert
11.1.91 Original date
3.23.99 last modified
12.30.99 added the dated line in intsub
1.4.00 added reject_sub and code that calls it
6.16.00 added contains_sq and code in getsub that calls it.
10.6.00 modified betterbyparts
6.16.04 modified change_integration_limits to make it handle the case when
a definite integral is transformed to an improper integral, with a
new upper limit like tan(pi/2), which should become infinity.
8.28.04 Modified intsub to fail if arg doesn't contain the variable of integration, line 1751
8.29.04 corrected yesterday's modification.
3.10.06 changed m and n to longs in weierstrass_ok.
4.23.13 changed i >=0 to i> 0 at line 405
5.29.13 deleted call to set_nvariables at line 701, as it caused a crash.
5.29.13 modified betterbyparts in the last part
6.3.13 modified betterbyparts to kick in on ln(x)/ polynomial
and on integral(x^2/2^x,x)
6.8.13 Added some code to getsub so it will try e^(x/2) in integral(e^(x/2)/(1+e^x)^2 instead of u = 1+e^x
6.10.13 lowered MAXRECURSE from 20 to 12.
9.26.14 changed wait() to wait1()
12.10.14 made checksub use polyvallogflag
modified possible_sub to find substitutions ln(1 + e^(-t))
modified linear_context to reject a=-1 and b=0.
3.18.23 added braces line 1393.
corrected parentheses line 2026
6.13.24 added some conditions near where rejectintsub is called, to allow intsub to
work when the topic is integration_by_substitution, or when it's not in automode
And modified choosesubstitution to reject an INTEGRAL as an arg.
modified intsub to reject INTEGRAL arg without an error message.
8.2.24 Eliminated wait1 after display_progress.
10.8.24 Added intsubwithdisplay
10.8.24 erased call to maybe_display_progress around line 1195 and
corrected a call to maybe_display_progress around line 1189.
12.10.24 called clear_error_buffer in intsubwithdisplay
*/
#include <string.h>
#include <math.h>
#include <assert.h>
#include "globals.h"
#include "graphstr.h"
#include "mpdoc.h"
#include "ops.h"
#include "calc.h"
#include "mpmem.h"
#include "checkarg.h"
#include "exec.h"
#include "order.h"
#include "factor.h"
#include "algaux.h"
#include "cancel.h"
#include "deriv.h"
#include "polynoms.h"
#include "autosub.h"
#include "eqn.h"
#include "match.h"
#include "mtext.h"
#include "optable.h"
#include "nextstep.h" /* opseq */
#include "integral.h"
#include "trig.h"
#include "prover.h"
#include "progress.h"
#include "symbols.h"
#include "intsub.h"
#include "cflags.h" /* inq_display_on() etc. */
#include "automode.h" /* TRIGFUNCTOR2 */
#include "deval.h"
#include "pvalaux.h"
#include "trigsimp.h" /* trigsimp */
#include "islinear.h"
#include "psubst.h"
#include "trigpoly.h" /* trigrat */
#include "errbuf.h"
#include "mstring.h"
#include "gcdsub.h"
#include "dispfunc.h"
#include "sqrts.h" /* restore_sqrts */
#include "tdefn.h" /* _int_by_substitution */
static int biggest_common(term,term,term,term,term *);
static int rejectintsub(term u, term x);
static int enlarge_sub(term v,term x,term u,term def,term *ans);
static int linear_context(term t, term u, term *ans);
static int rejectit(term integrand,term arg);
static int evil_fractexps(term t);
static int stoploop(term);
static int reject_sub(term,term,term);
static int get_sqrtsub(term v, term x, term *def);
static int get_quadratic_sub(term v, term x, term *def);
static int active_integral(term p, term *ans);
static int active_integral2(term p, term *ans);
static int active_integral3(term p, term *ans);
static int get_linear_sub(term,term,term*);
static int get_linear_sub2(term,term,term*);
static int contains_trig2(term t, term x);
static int contains_diff(term u, term x);
static int ismultipleof(term t, term x);
static int contains_exp(term t, term x);
static int too_complicated(term t, term x);
static int integral_table(term t, term x, term *ans);
static int integrate_trigrecip(term t, term x, term *ans);
static void maybe_display_progress(term u, term def);
static int atomic_trig(term t, term x);
static int impossiblesub(term u, term x);
static int simple_integral2(int recursion_depth, term u, term x, term *ans);
static int functionof(term w, term x, long m);
/*_______________________________________________________________________*/
typedef struct stl { term data;
struct stl *link;
} termlist1; /* simple linked list of terms */
/* by contrast with termlist defined in prover.h
which is doubly linked */
/*_______________________________________________________________________*/
static int getsub(term v, term x, term *next, term *sub);
static int checksub(term u, term x, term newvar, term def, term *ans);
static int weierstrass_aux(term, term, term, term *);
static int change_integration_limits(term, term, term, term, term, term, term *);
static int stopsub(term v, term x, term *ans);
static int fract_exp(term v, term x);
static void list_possibilities(int flag, term integrand, term v, term x, termlist1 *list, termlist1 **lastnode);
static int possible_sub(unsigned short f, int i, term u, term x);
/*_______________________________________________________________________*/
/* return main functor contained in derivatives of functors listed in functors.h */
static unsigned short dfunctor(unsigned short f)
{ if(f <= ATAN)
return '/';
switch(f)
{ case SIN: return COS;
case COS: return SIN;
case SEC: return TAN;
case TAN: return SEC;
case CSC: return COT;
case COT: return CSC;
case SQRT: return SQRT;
case ROOT: return ROOT;
case SINH: return COSH;
case COSH: return SINH;
case TANH: return COSH;
case COTH: return CSCH;
case CSCH: return CSCH;
case SECH: return TANH;
case ERFC: /* fall-through */
case ERF: return '^';
case LN: return '/';
case ABSFUNCTOR: return ABSFUNCTOR;
case GAMMA: return DIGAMMA;
case DIGAMMA: /* fall-through */
case POLYGAMMA: return POLYGAMMA;
}
return 0;
}
/*_______________________________________________________________________*/
int autochoosesubstitution(term t, term arg, term *next, char *reason)
/* same as if choosesubstitution is used in auto mode, but can be done
in menu mode or by term selection. Computer chooses a substitution. */
{ SETFUNCTOR(arg,ILLEGAL,0);
return choosesubstitution(t,arg,next,reason);
}
/*_______________________________________________________________________*/
int choosesubstitution(term t, term arg, term *next, char *reason)
/* In menu mode, accepts the user's substitution and displays it. It stores the integral
under "pending", and makes the substitution the current expression.
In auto mode, generates the (correct) substitution itself.
checkarg is supposed to verify that t isn't dependent on the user's letter.
*/
{ term u,x,def,temp,leftcopy,rightcopy;
int err;
int currentline;
if(FUNCTOR(t) != INTEGRAL || FUNCTOR(arg) == INTEGRAL)
return 1;
if(PRIME(t) && get_mathmode()==AUTOMODE)
return 1;
/* the PRIME bit means integration by substition has
already been tried unsuccessfully on this integral. So don't
try it again. However, it MIGHT have failed only because
'betterbyparts' says you should use parts, in which case
the user should be allowed to do it by substitution in menu mode.
Example: cos x ln(sin x). */
if(contains(t,SUM))
{ errbuf(0,english(1509));
/* First get the indexed sum out of the integral. */
return 1;
}
x = ARG(1,t);
if(FUNCTOR(arg) == ILLEGAL)
{ err = rejectintsub(ARG(0,t),x); /* don't use subst where not appropriate */
if(!err)
return 1;
err = getsub(ARG(0,t),x,&temp,&arg);
if(err)
return 1;
u = ARG(0,arg);
}
else
{ if(FUNCTOR(arg) != '=')
{ u = getnewvar(t,"uvwsxyzt");
if(FUNCTOR(u) == ILLEGAL)
{ errbuf(0, english(1448));
/* Too many subscripted variables, can't make more. */
return 1;
}
arg = equation(u,arg);
}
else
u = ARG(0,arg);
permcopy(ARG(0,arg),&leftcopy);
permcopy(ARG(1,arg),&rightcopy);
let(leftcopy,rightcopy);
SETDEPENDENT(ARG(0,arg));
}
def = ARG(1,arg);
assert(ISATOM(u));
SETDEPENDENT(u); /* let sets this bit in the term it enters in
defns[nextdefn].l, but it needs to be set
here so that the term du/dx entered in the
history array has its dependent bit set */
*next = equation(u,def);
currentline = get_currentline();
pushpending(history(currentline),currentline);
HIGHLIGHT(*next);
strcpy(reason, english(536)); /* definition */
inhibit(choosesubstitution); /* released by trysubstitution */
inhibit(factordenominator);
return 0;
}
/*_______________________________________________________________________*/
/* Below we have to identify the integral that is being worked on,
because we need the variable of integration. This will usually be the
leftmost integral in pending->prop which is not marked
CANTFACTOR or PRIME; PRIME marks integrals on which integration-by-
substitution has been tried unsuccessfully, and CANTFACTOR marks
integrals on which everything has been tried unsuccessfully.
To do this, we pass pending->prop to the following function.
However: the active integral is NOT always the one described above.
Consider integrating sin 2x + sin 3x. If we put u=2x and differentiate
this equation, then showcallingproblem, then put v=3x to tackle the
second integral, pending will be the sum of the two integrals, but
we want to get the SECOND integral as the active integral.
And furthermore: if automode can't find a substitution the user may
still be able to, or at least may still try, and therefore if ALL
integrals in p are marked PRIME, we still should return some active
integral. Hence the call to active_integral3.
*/
static int active_integral(term p, term *ans)
{ int err = active_integral2(p,ans);
if(!err)
return 0;
/* Now before giving up look for ANY integral,
whether marked CANTFACTOR or PRIME or not */
return active_integral3(p,ans);
}
/*____________________________________________________________*/
static int active_integral2(term p, term *ans)
/* return 0 for success, and in *ans return the leftmost
integral in p which is not PRIME or CANTFACTOR, and whose
variable of integration is contained in the most recent
let_defn's right side. */
{ int i, err;
int nextdefn = get_nextdefn();
defn d;
unsigned short n;
if(ATOMIC(p))
return 1;
if(nextdefn == 0)
return 1;
d = get_defn(nextdefn-1);
if(FUNCTOR(p)==INTEGRAL && !CANTFACTOR(p) && !PRIME(p)
&& contains(d.right,FUNCTOR(ARG(1,p)))
)
{ *ans = p;
return 0;
}
n = ARITY(p);
for(i=0;i<n;i++)
{ err = active_integral2(ARG(i,p),ans);
if(!err)
return 0;
}
return 1;
}
/*____________________________________________________________*/
static int active_integral3(term p, term *ans)
/* return 0 for success, and in *ans return the leftmost
integral in p whose variable of integration is contained
in the most recent let_defn's right side. */
{ int i, err;
int nextdefn = get_nextdefn();
defn d;
unsigned short n;
if(ATOMIC(p))
return 1;
if(nextdefn == 0)
return 1;
d = get_defn(nextdefn-1);
if(FUNCTOR(p)==INTEGRAL &&
contains(d.right,FUNCTOR(ARG(1,p)))
)
{ *ans = p;
return 0;
}
n = ARITY(p);
for(i=0;i<n;i++)
{ err = active_integral3(ARG(i,p),ans);
if(!err)
return 0;
}
return 1;
}
/*_______________________________________________________________________*/
/* Listed on menus as "differentiate the equation" */
int difsubstitution(term t, term arg, term *next, char *reason)
{ term x,integral;
int err;
assumption *pending;
if(FUNCTOR(t) != '=')
return 1;
if(!ATOMIC(ARG(0,t)))
return 1;
pending = get_pending();
if(pending == NULL)
return 1;
err = active_integral(pending->prop,&integral); /* see above */
if(err)
return 1; /* no active integral pending */
x = ARG(1,integral);
*next = equation(diff(ARG(0,t),x),diff(ARG(1,t),x));
HIGHLIGHT(*next);
strcpy(reason, english(679)); /* differentiate the equation */
return 0;
}
/*_______________________________________________________________________*/
int showcallingproblem(term t, term arg, term *next, char *reason)
{ int err;
int currentline = get_currentline();
int nextdefn = get_nextdefn();
defn d;
if(nextdefn == 0)
return 1;
if(get_mathmode() == AUTOMODE)
/* In automode, this operator should work only if
the most recent substitution has been differentiated
already */
{ int i;
term u,w;
d = get_defn(nextdefn-1);
u = d.left;
for(i=currentline;i>=0;i--)
{ w = history(i);
if(FUNCTOR(w) == '=' && FUNCTOR(ARG(0,w)) == DIFF
&& equals(ARG(0,ARG(0,w)),u)
&& !contains(ARG(1,w),FUNCTOR(u))
)
break; /* yes, the substitution has been differentiated */
}
if(i<0)
return 1; /* doesn't work, the substitution hasn't
been differentiated yet */
}
err = poppending(next);
if(err)
return 1;
strcpy(reason, english(773)); /* previous expression */
return 0;
}
/*_______________________________________________________________________*/
int trysubstitution(term t, term arg, term *next, char *reason)
/* On menus as "integrand = f(u) \times du/dx", */
/* t must be integral(v,x); there must be a let_defn recorded
of the form u = def(x); there must be a previous line of the
computation of the form du/dx = du_dx; then v/du_dx must be
writable as a function of def; */
{ term x,def,u,w,temp;
int i,err;
int currentline;
operation *opseq;
controldata cd;
int saveit;
defn d;
operation op;
actualop *ops;
if(FUNCTOR(t) != INTEGRAL)
return 1;
x = ARG(1,t);
w = ARG(0,t);
if(get_nextdefn()==0)
{ errbuf(0, english(699));
/* No substitution has been defined */
return 1;
}
if(contains(w,DIFF))
{ return 1;
/* When there are TWO integrals, e.g. sin(2x) + sin(3x),
and the first one is done the slow way by human chooses substitution,
and you don't finish the first integral, but leave it in the
form integral(sin u (du/dx)/2 dx,x), and then set v = 3x and
finally call trysubstitution, this stops it from working on
the FIRST integral. Whew! */
}
currentline = get_currentline();
if(get_mathmode() == AUTOMODE)
{ /* don't use this operator twice for the same use of choosesub */
/* e.g. in sin(2x) + sin(3x), you have to make a NEW substitution
to deal with the second integral */
get_controldata(&cd);
opseq = cd.opseq;
for(i=currentline; i>0;i--) // opseq[0] is garbage since history[0] didn't come from an op
{ op = opseq[i];
ops = access_optable(op.men);
if((void *) ops[op.choice-1] == (void *) choosesubstitution)
break;
if((void *) ops[op.choice-1] == (void *) trysubstitution)
return 1;
}
}
d = get_defn(get_nextdefn()-1); /* most recent let_defn */
def = d.right;
u = d.left;
if(! ISATOM(u))
return 1;
for(i=currentline; i >= 0; i--)
{ temp = history(i);
if(FUNCTOR(temp) == '=' && equals(ARG(0,temp),diff(u,x)))
break;
}
if(i < 0)
{ char buffer[128];
strcpy(buffer,english(700));
/* You must first compute d*/
strcat(buffer,atom_string(u));
strcat(buffer,"/d");
strcat(buffer,atom_string(x));
errbuf(0,buffer);
return 1;
}
saveit = get_eigenindex();
set_eigenvariable(d.oldeigen);
err = checksub(w,x,u,def,&temp);
set_eigenvariable(saveit);
if(err)
{ errbuf(0,english(774));
/* Well, this substitution doesn't seem to work. */
release(choosesubstitution);
release(factordenominator);
return 1;
}
*next = ARITY(t)==2 ? integral(product(ARG(0,temp),diff(u,x)),x) :
definite_integral(product(ARG(0,temp),diff(u,x)),x,ARG(2,t),ARG(3,t));
HIGHLIGHT(*next);
strcpy(reason, english(777)); /* integrand=f(u) \times du/dx */
release(choosesubstitution);
release(factordenominator);
return 0;
}
/*_______________________________________________________________________*/
int changeintegrationvariable(term t, term arg, term *next, char *reason)
/* This is on the menus as
"\\int f(u) (du/dx) dx = \\int f(u) du"
*/
{ term v,u,x,rest,def;
unsigned short n;
int nextdefn;
defn d;
int sign=0;
int err,i,j;
if(FUNCTOR(t) != INTEGRAL)
return 1;
x = ARG(1,t);
v = ARG(0,t);
if(FUNCTOR(v) == DIFF && equals(ARG(1,v),x) && ISATOM(ARG(0,v)))
{ *next = integral(one,ARG(0,v));
strcpy(reason,"$\\int (du/dx) dx = \\int du$");
HIGHLIGHT(*next);
return 0;
}
if(FUNCTOR(v) == '-')
{ v = ARG(0,v);
sign = 1;
}
if(FUNCTOR(v) != '*')
return 1;
n = ARITY(v);
for(i=n-1;i>=0;i--)
{ if(FUNCTOR(ARG(i,v)) == DIFF && equals(ARG(1,ARG(i,v)),x))
{ u = ARG(0,ARG(i,v));
break;
}
}
if(i<0)
return 1;
if(n==2)
rest = ARG( (i ? 0 : 1),v);
else
{
rest = make_term('*',(unsigned short)(n-1));
for(j=0;j<i;j++)
ARGREP(rest,j,ARG(j,v));
for(j=i;j<n-1;j++)
ARGREP(rest,j,ARG(j+1,v));
}
if(contains(rest,FUNCTOR(x)))
return 1;
if(sign)
rest = tnegate(rest);
nextdefn = get_nextdefn();
if(ARITY(t) != 2)
{ for(i=nextdefn-1;i>=0;i--)
{ d = get_defn(i);
if(equals(d.left,u))
{ def= d.right;
break;
}
}
assert(i>=0); /* you must find the definition in question */
err = change_integration_limits(rest,ARG(1,t),u,def,ARG(2,t),ARG(3,t), next);
if(err)
return 1;
}
else
*next = integral(rest,u);
HIGHLIGHT(*next);
strcpy(reason,"$\\int f(u)(du/dx)dx = \\int du$");
return 0;
}
/*_______________________________________________________________________*/
static int contains_sq(unsigned short f, term t, term x)
/* if t has the form f^m(x) where m >= 2, or is a product,
one of whose factors has that form, then return 1; else return 0.
*/
{ unsigned short i,n;
if(FUNCTOR(t) == '^' && ISINTEGER(ARG(1,t)) && INTDATA(ARG(1,t)) >= 2 &&
FUNCTOR(ARG(0,t)) == f && equals(ARG(0,ARG(0,t)),x)
)
return 1;
if(FUNCTOR(t) != '*')
return 0;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(contains_sq(f,ARG(i,t),x))
return 1;
}
return 0;
}
/*_______________________________________________________________________*/
static int getsub(term v, term x, term *next, term *ans)
/* consider integral(v,x); find a substitution u = def
that will allow it to be written in the form integral(g(u),u)
(whether or not that integral can be done). Return 'u=def' in *ans
and integral(g(u),u) in *next. Return 0 for success, 1 for failure.
x is an atom.
getsub first checks for some special cases that cover a number of
common problems. If these don't work, it then
prepares a list of all substitutions to try.
These include subterms of v which pass 'possible_sub', and
in addition we throw in the gcd of powers of x that occur in v.
Then checksub is called on each of these substitutions in turn
until one works.
getsub looks first for subterms of v which have depth 1 in X; for example
sin(a^2) + x is acceptable (the depth of the sin(a^2) term is irrelevant).
Thus their derivatives have only one or two factors. For example
sin(cos x) will be rejected as a trial substitution on this basis.
Problem: the above will get u = 3x given sin(3x/2); this
is fixed by ignoring constant denominators in possible_sub. In other
words, before returning a term of depth 1 in x, tack on a constant
denominator if that's the context of the term of depth 1.
But, if no simple substitution is found, eventually getsub will try
EVERY subterm of v.
Cleans up the heap after all that, using reset_heap, so in particular
there's no use to traverse the linked lists freeing nodes
*/
{ term u,w,temp,def,a,b,d,leftcopy,rightcopy,nn,c,uu,trash,s;
int err,err2,flag,gcdflag;
term p,q;
int i,oldeigen,r,ratflag;
unsigned short h,k;
term stashassumptions;
int savenvariables = get_nvariables();
short savenextassumption = get_nextassumption();
int savenextdefn = get_nextdefn();
void *saveit;
void *tempnode;
termlist1 listhead; /* dummy list head node */
termlist1 *marker;
termlist1 *trailer;
termlist1 *lastnode;
err = betterbyparts(v,x); /* don't tackle x^n e^x for example */
if(!err)
{ errbuf(0,english(815));
/* It would be better to use integration by parts. */
/* You need this message if user chooses
'Computer makes substitution' */
return 1;
}
if(contains(v,SUM))
{ errbuf(0, english(1509));
/* First get the indexed sum outside the integral. */
return 1;
}
if(impossiblesub(v,x))
return 1;
err = stopsub(v,x,&temp); /* trig functions with different arguments? */
if(!err)
{ /* usually trig functions with different args means it can't
be done by substitution. But consider cos x cos(sin x),
which certainly can be done. Also cos x/ cos(sin x) can be done. */
if(FUNCTOR(v) == '*' && (TRIGFUNCTOR(FUNCTOR(temp)) || TRIGHFUNCTOR(FUNCTOR(temp))))
def = temp;
else if(FUNCTOR(v) == '/' && ARITY(ARG(1,v)) == 1 && !equals(ARG(0,ARG(1,v)),x))
{ a = ARG(0,v);
b = ARG(1,v);
if(!TRIGFUNCTOR(FUNCTOR(b)) && !TRIGHFUNCTOR(FUNCTOR(b)))
return 1;
def = ARG(0,b);
}
else
return 1; /* functors other than * or /, or products
not containing a term like cos(sin...) */
u = getnewvar(product(v,x),"uvwsxyzt");
if(FUNCTOR(u) == ILLEGAL)
{ errbuf(0, english(1448));
/* Too many subscripted variables, can't make more. */
return 1;
}
oldeigen = get_eigenindex();
let(u,def);
set_eigenvariable(oldeigen); /* keep it the same during checksub */
SETDEPENDENT(u);
err = checksub(v,x,u,def,next);
set_nextdefn(savenextdefn);
if(err)
goto fail;
else
{ *ans = equation(u,def);
goto out;
}
}
u = getnewvar(product(v,x),"uvwsxyzt"); // so now there's one more variable than when we started
if(FUNCTOR(u) == ILLEGAL)
{ errbuf(0, english(1448));
/* Too many subscripted variables, can't make more. */
return 1;
}
saveit = heapmax();
/* First thing to try: ignoring any powers of x that may be
multiplied into v directly, try the gcd of all other powers of
x occurring in v. Examples: x^4/(x^10 + 16) yields x^5;
1/(sqrt x + root(3,x)) yields x^(1/6); sin(x^2) yields x^2
(which transforms the integrand to sin(u)/u, an improvement)
*/
def = get_gcdsub(v,x);
if(equals(def,x) || ZERO(def) || ONE(def))
gcdflag = 0; /* doesn't work */
else if( (FUNCTOR(def) == SQRT ||
(FUNCTOR(def)=='^' && ( FUNCTOR(ARG(1,def)) == '/'
|| (FUNCTOR(ARG(1,def)) == '-' && FUNCTOR(ARG(0,ARG(1,def)))=='/')
)
) /* def contains a fractional exponent */
)
&& !fract_exp(v,x) /* original integrand did not have one */
)
gcdflag = 0; /* don't use it if it creates a fractional exponent
where none was before */
else
{ gcdflag = 1;
/* checksub may have to make inferences; to do these correctly
it must know the definition of u; therefore we must, at least
temporarily, let_define u. This is only temporary, so we
don't put u and def into permspace first, to avoid using up
permspace with many trial substitutions */
oldeigen = get_eigenindex();
let(u,def);
SETDEPENDENT(u);
set_eigenvariable(oldeigen);
maybe_display_progress(u,def);
err = checksub(v,x,u,def,next);
if(!err)
{ err = enlarge_sub(v,x,u,def,&temp);
if(!err)
{ set_nextdefn(savenextdefn);
let(u,temp);
SETDEPENDENT(u);
set_eigenvariable(oldeigen);
err = checksub(v,x,u,temp,next);
/* without calling checksub here, next is wrong */
if(!err)
*ans = equation(u,temp);
}
if(err) /* either from enlarge_sub or from checksub */
{ *ans = equation(u,def);
err = 0; /* we DID find a substitution */
}
set_nextdefn(savenextdefn); /* remove the temporary defn of u */
goto out;
}
set_nextdefn(savenextdefn); /* undo the 'let' above */
set_nextassumption(savenextassumption);
}
reset_heap(saveit); /* Nothing has been accomplished so far,
so clean up memory that has been used. */
/* Catch simple examples of the form (du/dx) u^n or (du/dx)/u^ */
/* Also examples of the form (du/dx) e^u or (du/dx) f(u) */
/* Also examples of the form (du/dx) sqrt u */
/* such as cos x sqrt(sin x) */
/* Otherwise it stupidly chooses the wrong factor, e.g. u = 2x+1
in (2x+1)(x^2+x+1) */
err = get_linear_sub(v,x,&b); /* common linear subexpression? if so use it first */
if(!err)
{ oldeigen = get_eigenindex();
let(u,b);
err2 = 0;
SETDEPENDENT(u);
set_eigenvariable(oldeigen); /* let may change the eigenvariable */
err = enlarge_sub(v,x,u,b,&temp);
if(!err)
{ set_nextdefn(savenextdefn);
let(u,temp);
SETDEPENDENT(u);
set_eigenvariable(oldeigen);
maybe_display_progress(u,def);
err = checksub(v,x,u,temp,next);
/* without calling checksub here, next is wrong */
if(!err)
{ *ans = equation(u,temp);
set_nextdefn(savenextdefn);
goto out;
}
}
else /* enlarge_sub failed */
{ maybe_display_progress(u,def);
err2 = checksub(v,x,u,b,next); /* needed to create next */
if(!err2)
{ *ans = equation(u,b);
err = 0;
set_nextdefn(savenextdefn);
goto out;
}
}
}
reset_heap(saveit);
err = get_linear_sub2(v,x,&b); /* integrands like x^2 (1-x)^9 */
if(!err)
{ oldeigen = get_eigenindex();
let(u,b);
SETDEPENDENT(u);
set_eigenvariable(oldeigen); /* let may change the eigenvariable */
maybe_display_progress(u,def);
err2 = checksub(v,x,u,b,next); /* needed to create next */
if(!err2)
{ *ans = equation(u,b);
set_nextdefn(savenextdefn);
goto out;
}
}
if((FUNCTOR(v) == '*' && ARITY(v) == 2) || FUNCTOR(v) == '/')
{ char localbuf[DIMREASONBUFFER];
a = ARG(0,v);
b = ARG(1,v);
if(FUNCTOR(a) == '^' && constant(ARG(0,a)))
{ psubst(u,a,b,&temp);
if(!contains(temp,FUNCTOR(x)))
{ oldeigen = get_eigenindex();
let(u,a);
SETDEPENDENT(u);
set_eigenvariable(oldeigen); /* let may change the eigenvariable */
maybe_display_progress(u,a);
err = checksub(v,x,u,a,next);
set_nextdefn(savenextdefn);
if(!err)
{ *ans = equation(u,a);
goto out;
}
}
}
if(FUNCTOR(b) == '^' && constant(ARG(1,b)))
b = ARG(0,b);
if(FUNCTOR(b) == SQRT)
b = ARG(0,b);
if(FUNCTOR(b) == ROOT && constant(ARG(0,b)))
b = ARG(1,b);
if(FUNCTOR(b) == '^' && equals(ARG(0,b),eulere))
b = ARG(1,b);
if(!too_complicated(b,x))
{ d=derivative(b,x);
if(FUNCTOR(d) == '+')
{ err = contentfactor(d,zero,&temp,localbuf);
/* example, (x-3)/(x^2+6x+1), deriv of denom needs to
be content-factored before it can be cancelled with the num */
if(!err)
d = temp;
}
err= cancel(a,d,&trash,&temp);
if(!err)
{ oldeigen = get_eigenindex();
if(FUNCTOR(a) == '^' && equals(ARG(0,a),eulere) &&
!(FUNCTOR(b) == '+' && equals(a,ARG(0,b)))
)
{ /* use u = e^x rather than u = e^(2x)+1 to integrate
e^x sqrt(e^(2x)+1) */
if(equals(ARG(1,a),x))
b = a;
else if(FUNCTOR(ARG(1,a)) == '*')
/* example, e^(3x)/sqrt(1-e^(2x)) */
{ twoparts(ARG(1,a),x,&c,&s);
if(isinteger(c))
b = make_power(eulere,s);
}
}
let(u,b);
SETDEPENDENT(u);
set_eigenvariable(oldeigen); /* let may change the eigenvariable */
maybe_display_progress(u,b);
err = checksub(v,x,u,b,next);
set_nextdefn(savenextdefn);
if(!err)
{ *ans = equation(u,b);
goto out;
}
}
destroy_term(d); /* made by cancel, so guaranteed to be in fresh space */
}
}
reset_heap(saveit); /* still nothing accomplished */
set_nextassumption(savenextassumption);
/* Also trap examples of the form (du/dx)/(poly(u)) where u = x^n,
for example x^4/(x^10 + 16); or (du/dx)(poly(u)) */
if((FUNCTOR(v) == '*' && ARITY(v) == 2) || FUNCTOR(v) == '/')
{ a = ARG(0,v);
b = ARG(1,v);
if(equals(a,x))
{ uu = make_power(x,two);
err = psubst(u,uu,b,&c);
/* Watch out! for example on x/sqrt(1+x) we do NOT
want to substitute u = x^2, creating 1/sqrt(1+sqrt(u))
which is intractable. Don't do it if psubst created
fractional exponents. If it did, err will be 1.
*/
if(err != 1 && !contains(c,FUNCTOR(x)))
{ *ans = equation(u,uu);
if(FUNCTOR(v) == '*')
*next = integral(make_fraction(c,two),u);
else if(FRACTION(c))
*next = integral(make_fraction(ARG(1,c),product(two,ARG(0,c))),u);
else
*next = integral(make_fraction(one,product(c,two)),u);
err = 0;
goto out;
}
}
else if(FUNCTOR(a) == '^' && equals(ARG(0,a),x))
{ polyval(sum(ARG(1,a),one),&nn);
uu = make_power(x,nn);
r = psubst(u,uu,b,&c);
if(r != 1 && !contains(c,FUNCTOR(x)))
/* r == 1 means fractional exponent created where none
was before, in which case we reject this substitution. */
{ *ans = equation(u,uu);
if(FUNCTOR(v) == '*')
*next = integral(c,u);
else
*next = integral(reciprocal(c),u);
err = 0;
goto out;
}
}
}
reset_heap(saveit); /* still nothing accomplished */
set_nextassumption(savenextassumption);
/* Also trap examples of the form f'(x)/(trigalg(x))
where f is a trig function, e.g. (sin x)/( sin^2 x - cos^2 x)
Trigalg means an algebraic function of trig functions of x */
if((FRACTION(v) || (FUNCTOR(v) == '*' && ARITY(v) == 2))
&& trigalg2(v,x) && contains_trig(v)
)
{ int sign = 1;
a = ARG(0,v);
b = ARG(1,v);
h = FUNCTOR(a);
if(h == SIN && equals(ARG(0,a),x))
{ uu = cos1(x);
sign = -1;
}
else if(h == COS && equals(ARG(0,a),x))
uu = sin1(x);
else if(h == '^' && equals(ARG(1,a),two) &&
FUNCTOR(ARG(0,a)) == SEC &&
equals(ARG(0,ARG(0,a)),x)
)
uu = tan1(x);
else if(h == '^' && equals(ARG(1,a),two) &&
FUNCTOR(ARG(0,a)) == CSC &&
equals(ARG(0,ARG(0,a)),x)
)
{ uu = cot1(x);
sign = -1;
}
else
uu = zero;
if(!ZERO(uu))
{ err = psubst(u,uu,b,&c);
if(err != 1 && !contains(c,FUNCTOR(x)))
{ *ans = equation(u,uu);
if(sign == 1)
*next = integral(FRACTION(v) ? reciprocal(c) : c,u);
else
*next = tnegate(integral(FRACTION(v) ? reciprocal(c) : c,u));
err = 0;
goto out;
}
}
}
reset_heap(saveit); /* still nothing accomplished */
set_nextassumption(savenextassumption);
/* Also trap integrands of the form f(tan x)/(cos^2 x g(tan x)) and find u = tan x,
and similarly with sin^2 x and cot x */
if( FRACTION(v) && contains_sq(COS, ARG(1,v),x) && contains(v,TAN))
{ err = cancel(ARG(1,v), make_power(cos1(x),two),&trash,&w);
if(!err)
{ uu = tan1(x);
err = psubst(u,uu,make_fraction(ARG(0,v),w),&c);
if(err != 1 && !contains(c,FUNCTOR(x)))
{ *ans = equation(u,uu);
*next = integral(c,u);
err = 0;
goto out;
}
}
}
reset_heap(saveit); /* still nothing accomplished */
set_nextassumption(savenextassumption);
if( FRACTION(v) && contains_sq(SIN, ARG(1,v),x) && contains(v,COT))
{ err = cancel(ARG(1,v), make_power(sin1(x),two),&trash,&w);
if(!err)
{ uu = cot1(x);
err = psubst(u,uu,make_fraction(ARG(0,v),w),&c);
if(err != 1 && !contains(c,FUNCTOR(x)))
{ *ans = equation(u,uu);
*next = integral(c,u);
err = 0;
goto out;
}
}
}
reset_heap(saveit); /* still nothing accomplished */
set_nextassumption(savenextassumption);
/* Also trap integrands of the form e^(ax+b) g(x)).
If we don't trap them now we may not
find u = ax+b, because if g is a ROOT or SQRT,
get_sqrtsub below may succeed producing a complicated integral
and the substitution u= e^(ax+b) will be missed.
Example: rationalizing substititions problem 51 after
three steps gives v = e^(x/2) / (1+e^x)^2
*/
if(FRACTION(v) || (FUNCTOR(v) == '*' && ARITY(v) == 2))
{ a = ARG(0,v);
b = ARG(1,v);
h = FUNCTOR(a);
if(h == '^' && equals(ARG(0,a),eulere) &&
contains(ARG(1,a),FUNCTOR(x)) &&
is_linear_in(ARG(1,a),x)
)
{ uu = a;
/* ARG(1,a) is linear in x, and we need the coefficient p of x.
Can't use islinear because it fails in case v = x/2
*/
w = derivative(ARG(1,a),x);
subst(one,x,w,&q);
polyval(q,&p); /* at last, the coefficient we need */
islinear(ARG(1,a),x,&p,&q);
err = psubst(u,uu,b,&c);
if(err != 1 && !contains(c,FUNCTOR(x)))
{ *ans = equation(u,uu);
if(FRACTION(v))
*next = product(reciprocal(p),integral(reciprocal(c),u));
else
*next = product(reciprocal(p),integral(c,u));
err = 0;
goto out;
}
}
}
/* Also trap integrands of the form e^f(x) f'(x); we want u = f(x).
For example with f(x) = x ln x, we find the integral to be x^x.
*/
if(FUNCTOR(v) == '*' && ARITY(v) == 2)
{ term w,cancelled;
for(i=0;i<2;i++)
{ /* handle either order of arguments */
a = ARG(i,v);
b = ARG(i ? 0 : 1,v);
h = FUNCTOR(a);
if(h == '^' && equals(ARG(0,a),eulere) &&
contains(ARG(1,a),FUNCTOR(x))
)
{ uu = derivative(ARG(1,a),x);
if(equals(uu,b))
{ c = make_power(eulere,u);
copy(ARG(1,a),&w);
*ans = equation(u,w);
*next = integral(make_power(eulere,u),u);
err = 0;
goto out;
}
if(!cancel(b,uu,&cancelled,&w) && !contains(w,FUNCTOR(x)))
{ c = product(w,make_power(eulere,u));
copy(ARG(1,a),&w);
*ans = equation(u,w);
*next = integral(c,u);
err = 0;
goto out;
}
}
}
}
/* Also trap integrands of the form f'(x)/e^f(x); we want u = f(x). */
if(FRACTION(v))
{ term w,cancelled;
a = ARG(1,v);
b = ARG(0,v);
h = FUNCTOR(a);
if(h == '^' && equals(ARG(0,a),eulere) &&
contains(ARG(1,a),FUNCTOR(x))
)
{ uu = derivative(ARG(1,a),x);
if(equals(uu,b))
{ c = make_power(eulere,u);
copy(ARG(1,a),&w);
*ans = equation(u,w);
*next = integral(make_power(eulere,tnegate(u)),u);
err = 0;
goto out;
}
if(!cancel(b,uu,&cancelled,&w) && !contains(w,FUNCTOR(x)))
{ c = product(w,make_power(eulere,tnegate(u)));
copy(ARG(1,a),&w);
*ans = equation(u,w);
*next = integral(c,u);
err = 0;
goto out;
}
}
}
reset_heap(saveit); /* still nothing accomplished */
set_nextassumption(savenextassumption);
err = get_sqrtsub(v,x,&def); /* look for a SQRT or ROOT subterm */
if(!err && !equals(def,v))
{ oldeigen = get_eigenindex();
let(u,def);
SETDEPENDENT(u);
set_eigenvariable(oldeigen);
maybe_display_progress(u,def);
err = checksub(v,x,u,def,next);
if(!err)
{ *ans = equation(u,def);
set_nextdefn(savenextdefn);
goto out;
}
set_nextdefn(savenextdefn);
}
reset_heap(saveit); /* still nothing accomplished */
set_nextassumption(savenextassumption);
ratflag = rational_function(v,x);
if(ratflag &&
FUNCTOR(ARG(1,v)) == '+' &&
ARITY(ARG(1,v)) == 2 &&
!get_quadratic_sub(ARG(1,v),x,&def) &&
!equals(def,v) && !equals(def,x)
)
/* find u = sqrt(a) x in 1/(ax^2+1) */
{ oldeigen = get_eigenindex();
let(u,def);
SETDEPENDENT(u);
set_eigenvariable(oldeigen);
maybe_display_progress(u,def);
err = checksub(v,x,u,def,next);
if(!err)
{ *ans = equation(u,def);
set_nextdefn(savenextdefn);
goto out;
}
set_nextdefn(savenextdefn);
}
reset_heap(saveit); /* still nothing accomplished */
set_nextassumption(savenextassumption);
/* Now prepare a linked list of possible substitutions */
listhead.link = NULL;
for(flag = 0;flag < 2; ++flag)
{ list_possibilities(flag,v,v,x,&listhead,&lastnode);
if(lastnode == NULL)
return 1; /* out of memory in list_possibilities */
marker = listhead.link; /* pointer to first actual substitution */
err = 1;
/* The following loop is a 'while' instead of a 'for' because
we need to break out of an inner loop with a goto, and if it were
a 'for' then we would need a break, a test outside the inner loop,
and a continue to accomplish that result, which would be equally
'unstructured' as this code. */
while(marker != NULL)
{ if(gcdflag && equals(marker->data,def)) /* we tried this one already */
{ marker = marker->link;
continue;
}
/* Now check if this is a duplicate: */
trailer = listhead.link;
while (trailer != marker)
{ if(equals(trailer->data,marker->data)
|| (FUNCTOR(marker->data) == '-' && equals(trailer->data,ARG(0,marker->data)))
|| (FUNCTOR(trailer->data) == '-' && equals(marker->data,ARG(0,trailer->data)))
)
{ /* tried this (or its negation) before so don't do it again */
goto end_of_loop;
/* go back to the test of the outer while-loop */
}
else
trailer = trailer->link;
}
if(stoploop(marker->data)) /* catch loops like u = x-1, v = u+1 */
{ marker = marker->link;
continue;
}
if(reject_sub(marker->data,v,x))
/* don't do u = 2x if (x^2+1) is in the denom, for example */
{ marker = marker->link;
continue;
}
tempnode = heapmax();
/* if checksub fails, we'll reset the heap back to here.
Otherwise we run out of memory on big problems */
oldeigen = get_eigenindex();
let(u,marker->data);
SETDEPENDENT(u);
set_eigenvariable(oldeigen); /* let has reset it, but
we want 'constant' in
checksub to keep the old
eigenvariable non-constant
*/
maybe_display_progress(u,marker->data);
err = checksub(v,x,u,marker->data,next);
set_nextdefn(savenextdefn);
if(err)
{ reset_heap(tempnode);
set_nextassumption(savenextassumption);
}
if(!err)
{ err = enlarge_sub(v,x,u,marker->data,&temp);
if(!err && !checksub(v,x,u,temp,next))
/* without calling checksub here, next is wrong */
{ maybe_display_progress(u,temp);
*ans = equation(u,temp);
}
else
{
*ans = equation(u,marker->data);
err = 0; /* we DID find a substitution */
}
break;
}
end_of_loop:
marker = marker->link;
}
if(!err)
break; /* got a good substitution, don't go on to flag = 1 */
}
out:
// end_display_progress();
if(err)
reset_heap(saveit);
else
{ int nextassumption = get_nextassumption();
if(nextassumption != savenextassumption)
{ k = (unsigned short)(nextassumption - savenextassumption);
stashassumptions = make_term(AND,k);
for(i=0;i<k;i++)
ARGREP(stashassumptions,i,get_assumption(nextassumption-k+i));
save_and_reset(and3(*next,*ans,stashassumptions),saveit,&temp);
}
else
save_and_reset(and(*next,*ans),saveit,&temp);
*next = ARG(0,temp);
*ans = ARG(1,temp);
if(nextassumption != savenextassumption)
{ stashassumptions = ARG(2,temp);
set_nextassumption(savenextassumption);
for(i=0;i<k;i++)
assume(ARG(i,stashassumptions));
}
permcopy(ARG(0,*ans),&leftcopy);
permcopy(ARG(1,*ans),&rightcopy);
let(leftcopy,rightcopy); /* AFTER save_and_reset */
SETDEPENDENT(ARG(0,*ans));
/* *ans and *next (that is, the heads of those terms)
are either on the stack or were put on the heap
before heapmax was called, so aren't touched by save_and_reset */
}
if(!err)
return 0;
fail:
/* nothing worked, so get rid of the variable u */
// end_display_progress();
set_nvariables(savenvariables);
set_nextdefn(savenextdefn);
set_nextassumption(savenextassumption);
return 1; /* final failure */
}
/*_____________________________________________________________________*/
static void list_possibilities(int flag, term integrand, term v, term x, termlist1 *list, termlist1 **lastnode)
/* create (or add to) a linked list of all subterms of v which satisfy
possible_sub, in the right order to try them. Return a pointer to the last
node of the list created in **lastnode. The initial node pointed to
by listhead is presumed to exist already and to have a NULL link field,
i.e. to be the last node of a list.
If flag == 0 then we want easy substitutions (satisfying possible_sub
and with the functor of the derivative visible in the integrand);
else take all subexpressions.
'integrand' passes the original integrand; this is used to reject
certain possible substitutions, such as u = x+3 in (x+3)/(x^2+6x)^2
*/
{ int i,kk;
unsigned short h,f,g,n;
int polyflag=0;
term arg,c,s;
termlist1 *last = NULL;
if(ATOMIC(v))
{ *lastnode = list; /* no new node was added */
return;
}
n = ARITY(v);
f = FUNCTOR(v);
if(f == '+')
polyflag = ispolyin(v,x);
/* we'll use this to reject linear substitutions */
/* e.g. don't substitute u = 4x when integrating 1/sqrt(x^2 + 4x + 2) */
for(i=0;i<n;i++)
{ arg = ARG(i,v);
if(ATOMIC(arg))
continue;
if(rejectit(integrand,arg))
continue;
if(f == '+' && polyflag && contains(v,'^') && !contains(arg,'^'))
continue;
if(contains(arg,FUNCTOR(x)))
{ if(FUNCTOR(arg) == '*' && !ispolyin(arg,x))
{ twoparts(arg,x,&c,&s);
arg = s; /* example: if arg was 2e^x replace it by e^x */
}
kk = possible_sub(f,i,arg,x);
if(FUNCTOR(arg) == '^' && equals(ARG(0,arg),eulere) && !equals(ARG(1,arg),x))
{ if(iscomplex(arg))
arg = make_power(eulere, product(complexi,x)); /* e^ix */
else
arg = make_power(eulere,x); /* don't use e^2t, use e^t instead */
}
if((kk && !flag) || (!kk && flag))
{ g = FUNCTOR(arg);
if(g == SQRT || g == ROOT || g == SG)
h = 0; /* don't reject any SQRT or ROOT possibility without
trying it, it can work without any other SQRT
in the integrand. */
else
h = dfunctor(g);
/* for speed, QUICKLY check if the
derivative of arg can POSSIBLY occur in v;
we can rule that out if h doesn't occur,
except in a few cases. Note that h == '/'
is needed in the next line to prevent
u = ln x from being rejected e.g. in cos(ln x)
*/
if(h == 0 || g == '/' || g == '*' || g == '+' || h == '/' ||
(g == '^' && equals(two,ARG(1,arg)))
|| contains(integrand,h)
)
{ /* make a new node, put arg in it, tack it on the list */
list->link = (termlist1 *) mallocate(sizeof(termlist1));
if(list->link==NULL)
{ nospace();
*lastnode = NULL;
return;
}
list = list->link;
list->data = arg;
list->link = NULL;
last = list;
}
}
}
}
if(!polyflag)
{ for(i=0;i<n;i++)
{ list_possibilities(flag,integrand,ARG(i,v),x,list,&last);
list = last;
}
}
*lastnode = last == NULL ? list : last;
}
/*______________________________________________________________*/
static int contains_exp(term u, term x)
/* return 1 if u contains a subterm e^v where v contains x */
/* x must be an atom */
{ unsigned short n;
int i;
if(ATOMIC(u))
return 0;
if(FUNCTOR(u) == '^' && equals(ARG(0,u),eulere))
return contains(ARG(1,u),FUNCTOR(x));
n = ARITY(u);
for(i=0;i<n;i++)
{ if(contains_exp(ARG(i,u),x))
return 1;
}
return 0;
}
/*______________________________________________________________*/
static int possible_sub(unsigned short f, int i, term u, term x)
/* return 1 if u (occurring as i-th arg of functor f)
is worth trying as a substitution when integrating
with respect to x. Specifically:
u = g(poly in x) with g unary,
u = ln(...) where ... doesn't contain e^(h(x))
NOT u = sqrt(...) or root(n,...) where ... doesn't contain e^(h(x))
because these have already been tried by get_sqrtsub.
u = a^b with b constant,
u = e^ \pm x or e^( \pm cx)
u = a in a^b, or a in \sqrta or root(n,a),
denominators of fractions,
any polynomials.
Return 0 if u is not worth trying.
We may assume u is not atomic and does contain x. */
{ unsigned short g = FUNCTOR(u);
unsigned short n = ARITY(u);
int count = 0;
if(f=='+' && FUNCTOR(u) == '-' && equals(ARG(0,u),x))
return 0; /* don't use u = -x when integrand is f(a-x) */
if(mvpoly(u) && !equals(u,x))
return 1;
if(n==1 && g != ROOT && g != SQRT && ispolyin(ARG(0,u),x))
return 1; /* u = g(polynomial in x) */
if(g == '^' && equals(ARG(0,u),eulere))
{ term temp = ARG(1,u);
term c,s;
if(NEGATIVE(temp))
temp = ARG(0,temp);
if(equals(temp,x))
return 1; /* e^x or e^(-x) */
if(FUNCTOR(temp) == '*')
{
twoparts(temp,x,&c,&s);
if(equals(s,x))
return 1;
}
return 0; /* reject e^(x^2), e^(2x-1), etc. */
}
if(f=='^' && ispolyin(u,x))
return 1; /* try either arg of an exponent which is a poly */
if(f == '/' && i == 1) /* try denom of a fraction */
return 1;
if(g == LN && !contains_exp(u,x))
return 1;
if(g == LN && FUNCTOR(ARG(0,u)) == '+' && (f == '*' || f == '/'))
return 1; // example, when integrand is ln(1+e^-t)/(1+e^t) or (e^(-t) ln(1+ e^(-t))/(1+e^(-t))
if(g == '/' && !contains(ARG(1,u),FUNCTOR(x)))
{ /* ignore constant denominators as in sin(3x/2) */
return possible_sub(f,i,ARG(0,u),x);
}
if(g == '*') /* take products with only one non-constant arg */
{ for(i=0;i<n;i++)
{ if(depends(ARG(i,u),x) )
{ if(count)
return 0;
++count;
}
}
if(count == 1)
return 1;
}
return 0;
}
/*______________________________________________________________________k_*/
static int integral_table(term t, term x, term *ans)
/* calculate integral(t,x) by one-step table lookup, after possibly
pulling out constants and signs, and return the
answer in *ans. Return 0 for success, 1 for failure. */
/* Used by integratebyparts */
{ int err;
term temp,c,u,base,power;
unsigned short n;
unsigned short f = FUNCTOR(t);
actualop o;
char reason[256]; /* just a local buffer */
int i;
term ii; /* for integral(t,x) */
if(f == '-')
{ err = integral_table(ARG(0,t),x,&temp);
if(err)
return 1;
*ans = tnegate(temp);
return 0;
}
if(f == '*')
{ twoparts(t,x,&c,&u);
if(!ONE(c))
{ err = integral_table(u,x,&temp);
if(err)
return 1;
*ans = product(c,temp);
return 0;
}
}
ii = integral(t,x);
if(ONE(t))
return intident(ii,zero,ans,reason);
if(equals(t,x))
return intident(ii,zero,ans,reason);
if( !depends(t,x))
return intconst(ii,zero,ans,reason);
if(ispolyin(t,x))
return intpoly(ii,zero,ans,reason);
if(f == '+')
{ n = ARITY(t);
*ans = make_term('+',n);
for(i=0;i<n;i++)
{ err = integral_table(ARG(i,t),x,ARGPTR(*ans)+i);
if(err)
return 1;
}
return 0; /* in which case only the last reason will be given */
}
if(f == '/')
{ err = integrate_trigrecip(t,x,ans);
if(!err)
return 0;
err = intrecip(ii,zero,ans,reason);
if(!err)
return 0;
err = intinversepower(ii,zero,ans,reason);
if(!err)
return 0;
err = inttoatan(ii,zero,ans,reason);
if(!err)
return 0;
err = inttoasin(ii,zero,ans,reason);
if(!err)
return 0;
err = inttolnratio1(ii,zero,ans,reason);
if(!err)
return 0;
err = inttolnratio2(ii,zero,ans,reason);
if(!err)
return 0;
if(contains(ARG(1,t),SQRT))
{ err = inttoasin(ii,zero,ans,reason);
if(!err)
return 0;
err = inttolnratio3(ii,zero,ans,reason);
if(!err)
return 0;
err = inttoacos(ii,zero,ans,reason);
if(!err)
return 0;
}
return 1;
}
switch(f)
{ case DIFF:
o = fundamentaltheorem;
break;
case '*' :
if(ARITY(t) == 2)
{ unsigned short g = FUNCTOR(ARG(0,u));
unsigned short h = FUNCTOR(ARG(1,u));
if((g == SEC && h == TAN) || (g == TAN && h == SEC))
o = inttosec;
else if((g == CSC && h == COT) || (g == COT && h == CSC))
o = inttocsc;
else
return 1;
}
else
return 1;
break;
case '^' :
base = ARG(0,t);
power = ARG(1,t);
if(equals(base,x) && !depends(power,x))
{ o = intpower;
break;
}
else if(equals(power,two))
{ switch(FUNCTOR(ARG(0,t)))
{ case CSC:
o = intcscsq;
break;
case SEC:
o = intsecsq;
break;
case TAN:
o = inttansq;
break;
case COT:
o = intcotsq;
break;
default:
return 1; /* failure */
}
}
else if(equals(base,eulere))
{ if(equals(power,x))
{ o = intexp1; /* \\int e^t dt = e^t */
break;
}
if(FUNCTOR(power) == '*')
{ o = intexp2; /* \\int e^at dt =(1/a) e^(at) */
break;
}
if(NEGATIVE(power) && equals(ARG(0,power),x))
{ o = intexp3; /* \\int e^(-t)dt = -e^(-t) */
break;
}
if(NEGATIVE(power))
{ o = intexp4; /* \\int e^(-at)dt = -(1/a) e^(-at) */
break;
}
if(FRACTION(power))
{ o = intexp5; /* \\int e^(t/a)dt = a e^(t/a) */
break;
}
o = inttoerf; /* \\int e^(-t^2) dt = \sqrt \pi/2 Erf(t) */
break;
}
else
{ o = intexp6; /* \\int c^t dt = (1/ln c) c^t */
break;
}
break;
case COS :
o = intcos;
break;
case SIN :
o = intsin;
break;
case TAN :
o = inttan;
break;
case COT :
o = intcot;
break;
case SEC :
o = intsec;
break;
case CSC :
o = intcsc;
break;
case LN :
o = intln;
break;
case COSH:
o = intcosh;
break;
case SINH:
o = intsinh;
break;
case TANH:
o = inttanh;
break;
case ACOS:
o = intacos;
break;
case ATAN:
o = intatan;
break;
case ASIN:
o = intasin;
break;
case ACOT:
o = intacot;
break;
/* ACSC and ASEC not included because there are
two formulas with side conditions for them */
default :
return 1;
}
err = (*o)(ii,zero,ans,reason);
if (err)
return 1;
return 0;
}
/*__________________________________________________________________*/
static int rejectintsub(term u, term x)
/* return 0 if u should NOT be integrated by substitution with respect to x.
For example if u = (x-3)(x+2), substitution won't lead anywhere, but
if u = (x-3)^n(x+2) it WILL. Since intsub is tried BEFORE
expandintegrand and multiplyoutintegrand, we must reject cases
where these operators should be used instead. Be careful NOT to
reject cases like x(x^2-1)^99.
We do want to reject (1+x)^2/x; we probably want to reject (1+x^2)^2 /x^3 too.
What we do is reject any quotient of a polynomial or polynomial power by
x or a power of x. These can all be done by expanding the numerator and
dividing.
*/
{ int i,err;
int flag = 0, flag2 = 0;
term exp1,exp2,a,b,base,v;
term num,denom;
unsigned short n,f;
f = FUNCTOR(u);
if(f == '/')
{ denom = ARG(1,u);
num = ARG(0,u);
if(equals(denom,x) || (FUNCTOR(denom) == '^' && equals(ARG(0,denom),x) && INTEGERP(ARG(1,denom))))
{ if(FUNCTOR(num) == '^' && ISINTEGER(ARG(1,num)))
num = ARG(0,num);
if(ispolyin(num,x))
return 0;
}
}
if(f == '^' && !contains(ARG(1,u),FUNCTOR(x)))
/* examples, (ax+b)^n or sec^2 3x */
/* the call to linearsqrt catches (1+ sqrt x)^n, which SHOULD be done
by substitution, before it is rejected by linear_context */
/* but don't reject e^\sqrtx */
{ if(linearsqrt(ARG(0,u),x))
return 1; /* it SHOULD be done by substitution */
return !linear_context(ARG(0,u),x,&v);
/* returning 1 if it IS linear, so we should not reject by returning 0 */
}
if(f == ABSFUNCTOR)
{ u = ARG(0,u);
f = FUNCTOR(u);
}
if(f == '*')
{ n = ARITY(u);
for(i=0;i<n;i++)
{ if(!mvpoly(ARG(i,u)))
break;
}
if(i==n) /* a product of polynomials */
return 0;
/* Consider for example (x-3)^n(x-1). Substitution should
be used. Consider more generally
(x-3)^n(x-1)^m. Now substitution should certainly be used.
After that it will be u^n (x-a)^m; here substitution should
NOT be used, at least if m <= n. */
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,u)) == '^')
{ if (equals(x,ARG(0,ARG(i,u))))
{ exp1 = ARG(1,ARG(i,u));
flag = 1;
}
else
{ exp2 = ARG(1,ARG(i,u));
flag2 = 1;
base = ARG(0,ARG(i,u));
if(!mvpoly(base))
return 1; /* forget rejecting this here */
if(!ispolyin(base,x))
return 0; /* reject substitution */
}
}
else if(equals(ARG(i,u),x))
{ flag = 1;
exp1 = one;
}
if(!mvpoly(ARG(i,u)))
return 1;
}
if(flag) /* there was a power of x */
{ if(!flag2)
return 0; /* no other power, don't use sub */
/* Now we have x^exp1 * base^exp2 */
if(!islinear(base,x,&a,&b))
return 1; /* go ahead and try substitution, no harm done */
/* Now we have x^exp1 * (ax+b)^exp2 */
/* Reject substitution unless exp2 is numerical and
less than exp1, or exp2 is integer and exp1 is not */
if(!INTEGERP(exp2))
return 0; /* reject substitution */
if(!INTEGERP(exp1))
return 1; /* go ahead and USE substitution */
/* Now both are integers */
err = infer(lessthan(exp2,exp1));
return err ? 0 : 1;
}
}
return 1;
}
/*__________________________________________________________________*/
int autointsub(term t, term arg, term *next, char *reason)
/* Computer selects a substitution and carries it out, producing
the transformed integral */
{ int err;
SETFUNCTOR(arg,ILLEGAL,0);
err = intsub(t,arg,next,reason);
if(err)
{ errbuf(0, "");
/* remove "That substitution doesn't eliminate x", which looks screwy
when the user hasn't entered any substitution. */
return 1;
}
return 0;
}
/*__________________________________________________________________*/
int intsubwithdisplay(term t, term arg, term *next, char *reason)
/* intsub, but with display of the trial substitutions */
{ int err;
display_on();
err = intsub(t, arg, next, reason);
display_off();
if(err == 0)
clear_error_buffer(); // remove errors from failed attempts
return err;
}
/*__________________________________________________________________*/
int intsub(term t, term arg, term *next, char *reason)
/* perform integration by substitution in one step--
not actually doing the integral, but putting in the new variable;
in menu mode it gets the arg from the user */
{ int err;
unsigned short f,n;
term u,x,newvar,leftcopy,rightcopy;
int savenextdefn,oldeigen;
int savenvariables;
f = FUNCTOR(t);
n = ARITY(t);
if(f != INTEGRAL || FUNCTOR(arg) == INTEGRAL)
return 1;
if(PRIME(t) && get_mathmode()==AUTOMODE)
return 1;
/* the PRIME bit means integration by substitution has already
been tried unsuccessfully on this integral. See the
explanation in choosesubstitution for the AUTOMODE part. */
u = ARG(0,t);
x = ARG(1,t);
if(contains(t,SUM))
{ errbuf(0,english(1509));
/* First get the indexed sum out of the integral. */
return 1;
}
if(contains_diff(u,x))
{ errbuf(0,english(1918)); /* First evaluate the derivative */
return 1;
}
if(FUNCTOR(arg) != ILLEGAL && !contains(arg,FUNCTOR(x)))
{ errbuf(0,english(2481));
/* The selected expression must contain the variable of integration. */
/* Without this clause, we get a crash when you select e.g. "tan w"
from one integral, and there is a previous integral with another variable.
So exec_aux tries intsub on the FIRST integral, and it crashes.
*/
return 1;
}
if(FUNCTOR(arg)==ILLEGAL)
{ if (get_mathmode() == AUTOMODE && get_currenttopic() != _int_by_substitution)
{ err = rejectintsub(u,x);
if(!err)
return 1; // it's better to use a different method
}
err = getsub(u,x,next,&arg);
if(err)
return 1;
newvar = ARG(0,arg);
SETDEPENDENT(newvar);
}
else /* menu or Term Selection mode, or called from Weierstrass substitution */
{ savenextdefn = get_nextdefn();
savenvariables = get_nvariables();
if(FUNCTOR(arg) != '=')
{ newvar = getnewvar(product(u,x),"uvwsxyzt");
if(FUNCTOR(newvar) == ILLEGAL)
{ errbuf(0, english(1448));
/* Too many subscripted variables, can't make more. */
return 1;
}
SETDEPENDENT(newvar);
arg = equation(newvar,arg);
}
else
newvar = ARG(0,arg);
oldeigen = get_eigenindex();
let(newvar,ARG(1,arg)); /* temporarily */
SETDEPENDENT(newvar);
set_eigenvariable(oldeigen); /* added 12.30.99 to make sure psubst works right during checksub */
err = checksub(u,x,ARG(0,arg),ARG(1,arg),next);
set_nextdefn(savenextdefn);
set_eigenvariable(oldeigen); /* Now probably superfluous but harmless */
if(err)
{ set_nvariables(savenvariables);
return 1;
}
else
{ permcopy(ARG(0,arg),&leftcopy);
permcopy(ARG(1,arg),&rightcopy);
let(leftcopy,rightcopy);
SETDEPENDENT(ARG(0,arg));
}
}
assert(ISATOM(newvar));
err = mstring(arg,reason);
if(err)
strcpy(reason,english(780)); /* substitution */
if(n != 2) /* a definite integral */
{ err = change_integration_limits(ARG(0,*next),x,newvar,ARG(1,arg),ARG(2,t),ARG(3,t),next);
if(err)
return 1;
}
HIGHLIGHT(*next);
return 0;
}
/*_____________________________________________________________________*/
static int contains_deriv(term u, term x)
/* return 1 if u contains a derivative with respect to x */
{ unsigned short n,i;
if(ATOMIC(u))
return 0;
if(FUNCTOR(u) == DIFF && equals(ARG(1,u),x))
return 1;
n = ARITY(u);
for(i=0;i<n;i++)
{ if(contains_deriv(ARG(i,u),x))
return 1;
}
return 0;
}
/*_____________________________________________________________________*/
static int checksub(term u, term x, term newvar, term def, term *ans)
/* simplify integral(u,x) by substitution to *ans;
newvar = def is an equation defining the new variable of integration
Return 0 for success, 1 if the substitution doesn't work,
or (in automode) creates a fractional exponent where none was before
(This is necessary to stop loops, e.g. on sqrt(x)/(1+x). )
Sometimes in menumode too it rejects new fractional exponents.
The variable has to be (at least temporarily) in the varlist for
this to work, and 'let' should have been called on it.
*/
{ int err,r,saveit, savelogflag, nvariables;
short savenextassumption;
term def1,v,w,temp,temp2,temp3,temp4,vnew,du,p,q;
assert(FUNCTOR(def) != ILLEGAL);
assert(ISATOM(newvar));
SETDEPENDENT(newvar);
/* intercept the Weierstrass substitution u = tan(x/2) */
if(FUNCTOR(def) == TAN && FRACTION(ARG(0,def)) &&
equals(ARG(0,ARG(0,def)),x) && equals(ARG(1,ARG(0,def)),two)
)
{ /* the Weierstrass substitution is being used */
term oneplususq;
err = weierstrass_aux(u,x,newvar,&v);
if(err)
return 1;
/* dx becomes 2 dt/(1+newvar^2) */
oneplususq = sum(one,make_power(newvar,two));
additive_sortargs(oneplususq);
*ans = integral(product(v ,make_fraction(two,oneplususq)),newvar);
return 0;
}
nvariables = get_nvariables();
savenextassumption = get_nextassumption();
subst(newvar,def,u,&temp); /* first make any obvious substitutions,
e.g. if u = 1/\sqrt((x+1)^2-c) and def = x+1;
without this polyval will expand the square */
u = temp;
saveit = get_polyvalfactorflag();
savelogflag = get_polyvallogflag();
set_polyvalfactorflag(1); /* otherwise we miss some cancellations,
for example if def = x^2 + 6x and u has
x+3 in the numerator */
set_polyvallogflag(1);
du = derivative(def,x);
q = make_fraction(u,du);
polyval(q,&v);
if(contains_signed_fractional_exponents(v) &&
!contains_signed_fractional_exponents(q) &&
!restore_sqrts(v,&p) /* remove the fractional exponents */
)
v = p;
if(!contains(v,FUNCTOR(x)))
{ /* done already */
*ans = integral(v,newvar);
return 0;
}
polyval(def,&def1); /* this makes sure that the psubst immediately
below does not miss a substitution just because e.g. the order
of variables is wrong, e.g. iff def = sqrt(4+x), then v will have it
in the form sqrt(x+4), so we'll miss it unless we polyval def also */
set_polyvalfactorflag(saveit);
set_polyvallogflag(savelogflag);
r = psubst(newvar,def1,v,&temp);
if(contains_deriv(temp,x))
return 1; /* du should not contain any unevaluated derivatives
with respect to x. */
if(r==1 && get_mathmode() == AUTOMODE)
{ /* New fractional exponent created. Generally this is a bad
idea, but SOMETIMES it is necessary, e.g. to integrate
sqrt(cos x) sin^3 x. We allow it if the fractional exponent
created has a polynomial base, and def1 is not a rational
function of x. */
if(rational_function(def1,x))
return 1;
if(FUNCTOR(def1) == '^' && mvpoly2(ARG(1,def1)) && mvpoly2(ARG(0,def1)))
return 1; /* example, x^n where n is a variable. We don't
want a substitution that creates u^(n/(n-1)) */
if(evil_fractexps(temp))
return 1;
}
if(r==0 || contains(temp,FUNCTOR(x)))
{ /* try harder: */
term def2,common,v2;
if(r==0)
temp = v;
if(contains(v,TAN) || contains(v,SEC) || contains(v,COT) || contains(v,COT))
{ w = trigsimp(temp,x);
if(!contains(w,FUNCTOR(x)))
{ *ans = integral(w,newvar);
return 0;
}
/* example, u = sec x in integral (sin(x)/cos^2(x))e^(sec x).
The previous few lines didn't work because w = 1/(cos(x) u) */
w = trigsimp(v,x);
if(!contains(w,FUNCTOR(x)))
{ *ans = integral(w,newvar);
return 0;
}
}
vnew = getnewvar(u,"abcduvpqr");
vaux(vnew);
set_valuepointers(&vnew);
err = biggest_common(x,temp,def1,vnew,&common); /* common is the largest common
subterm containing x, of def and v */
/* example: x^3(1-x^2)^(3/2) with u = 1-x^2;
so v = -x^2 u^(3/2) and invert_eqn fails because
can't take sqrt of x^2=1-u; but common will be x^2,
and the following code will work: */
/* In many cases, of course, common will just be x */
if(err)
goto fail;
if(!equals(common,x))
{
subst(vnew,common,def1,&def2);
subst(vnew,common,temp,&v2);
err = invert_eqn(def2,newvar,vnew,&temp4);
if(err)
goto fail;
subst(common,vnew,temp4,&temp2);
r = psubst(temp2,vnew,v2,&temp3);
}
else
{ err = invert_eqn(def1,newvar,x,&temp2);
if(err)
goto fail;
r = psubst(temp2,x,temp,&temp3);
}
if(r < 2 /* psubst failed or created fractional exponent */
|| contains(temp3,FUNCTOR(x)) /* or didn't eliminate x */
|| (get_mathmode() == AUTOMODE && !fract_exp(u,x) && !fract_exp(u,newvar) && fract_exp(temp3,newvar))
/* or there's a new fractional exponent anyway (but don't let that
stop you in term selection mode or menu mode) */
)
goto fail;
temp = temp3;
}
if(get_mathmode() == AUTOMODE &&
fract_exp(temp,x) && !fract_exp(u,x)
/* example, sqrt(x-2)/(x+2), with u = x-2 or x+2, we'll come
out with a fractional exponent, and we MUST make this substitution;
so only reject new fractional exponents if there also
were no roots or sqrts to begin with. Note that constant
roots or fractional exponents must be allowed: example,
u = sqrt(a) x/b in integrating 1/(ax^2+b)
*/
)
goto fail;
polyval(temp,&temp3); /* psubst can leave negative exponents in fractions */
*ans = integral(temp3,newvar);
return 0;
fail:
set_nvariables(nvariables);
set_nextassumption(savenextassumption);
if(get_mathmode() != AUTOMODE)
{ char buffer[128];
strcpy(buffer, english(781));
/* That substitution doesn't eliminate */
strcat(buffer, atom_string(x));
strcat(buffer, ".");
errbuf(0,buffer);
}
return 1;
}
/*__________________________________________________________________*/
int simpleint(term t, term arg, term *next, char *reason)
/* Do an indefinite integral in one step if it doesn't require
integration by parts. This is on the integration_by_parts menus as
"evaluate simple integral" */
{ int err;
if(FUNCTOR(t) != INTEGRAL)
return 1;
if(ARITY(t) != 2)
return 1;
err = simple_integral(ARG(0,t),ARG(1,t),next);
if(err)
{ errbuf(0,english(782));
/* That integral can't be done using */
errbuf(1, english(783));
/* only substitution and table lookup. */
return 1;
}
strcpy(reason, english(681)); /* evaluate integral */
HIGHLIGHT(*next);
return 0;
}
/*__________________________________________________________________*/
static int weierstrass_ok(term a, term b)
/* return -1 if there is an odd multiple of pi between a and b.
Return -2 if a and b are seminumerical, but too large to determine accurately
whether there's an odd multiple of pi between 2a and 2b.
return -3 if a or b is not seminumerical.
Otherwise, return
0 if neither 2a nor 2b is an odd multiple of pi_term,
1 if the small of 2a and 2b is an odd multiple of pi and the other is not
2 if the larger of the two is is an odd multiple of pi and the smaller is not
3 if they both are.
*/
{ double aval, bval,lo,hi;
long m,n;
int ans = 0;
if(seminumerical(a) && seminumerical(b) &&
!deval(a,&aval) && !deval(b,&bval) && aval != BADVAL && bval != BADVAL
)
{ aval = aval / PI_DECIMAL;
bval = bval / PI_DECIMAL;
if(fabs(aval) > 2.0e9 || fabs(bval) > 2.0e9)
return -2; // too little precision
// is there an odd integer between aval and bval ?
if(aval <= bval)
{ lo = aval;
hi = bval;
}
else
{ lo = bval;
hi = aval;
}
if(nearint(lo,&m) && (m&1)) // lo is an odd integer
ans |= 1;
else
m = (long) ceil(lo);
if(nearint(hi,&n) && (n&1)) // hi is an odd integer
ans |= 2;
else
n = (long) floor(hi);
if(ans == 3) // both lo and hi are odd integers
return (n == m+2) ? ans : -1; // that's ok if and only if they differ by 2
if(ans == 1 || ans == 2) // hi or lo is an odd integer, but not both
return (n <= m+2) ? ans : -1;
// now neither hi nor lo is an odd integer
if(n < m)
return ans; // all clear
if(n == m)
return (n&1) ? -1 : ans;
return -1; // one of n, m, (n+m)/2 is odd.
}
return -3;
}
/*___________________________________________________________________*/
int weierstrass(term t, term arg, term *next, char *reason)
/* Make the Weierstrass substitution described below */
{ term x,u;
int r;
if(FUNCTOR(t) != INTEGRAL)
return 1;
x = ARG(1,t);
u = getnewvar(t,"tuvwpqr");
if(FUNCTOR(u) == ILLEGAL)
{ errbuf(0, english(1448));
/* Too many subscripted variables, can't make more. */
return 1;
}
if(ARITY(t) == 4)
{ term a,b;
a = ARG(2,t);
b = ARG(3,t);
/* tan must be defined (and hence monotonic) on (a,b) for this to work. */
r = weierstrass_ok(a,b);
if(r < 0)
{ errbuf(0,english(r == -1 ? 2466 : 2467 ));
/* tan(t/2) is undefined somewhere in the interval of integration. */
/* MathXpert cannot verify that tan(t/2) is defined on the integral of integration. */
return 1;
}
}
arg = equation(u,tan1(make_fraction(x,two)));
if(PRIME(t))
/* intsub has already been tried and failed, but
weierstrass can still succeed, so we need to remove
the PRIME mark from t */
UNSETPRIME(t);
return intsub(t,arg,next,reason);
}
/*___________________________________________________________________*/
/* weierstrass_aux recursively carries out the Weierstrass substitution,
building the terms forsin, etc., only as needed.
Apply the Weierstrass substitution to term t;
u is a new variable; the substitution is u = tan(x/2) which makes
sin x = 2u/(u^2+1) and cos x = (1-u^2)/(u^2+1)
and hence tan x = 2u/(1-u^2) etc. Return the result of making these
substitutions in t in *ans, if successful in eliminating x from t;
return 0 for success, 1 for failure.
Make new copies of the terms substituted for sin x, cos x, etc.
at each occurrence, so as not to create a DAG; DAG's make trouble when
they are destroyed.
*/
static int weierstrass_aux(term t,term x,term u,term *ans)
{ unsigned short f = FUNCTOR(t);
unsigned short n;
int i,r;
if(ATOMIC(t))
{ *ans = t;
return equals(t,x) ? 1 : 0;
}
switch(f)
{ case SIN:
if(!equals(ARG(0,t),x))
return 1;
*ans = make_fraction(product(two,u),sum(make_power(u,two),one));
return 0;
case CSC:
if(!equals(ARG(0,t),x))
return 1;
*ans = make_fraction(sum(make_power(u,two),one),product(two,u));
return 0;
case COS:
if(!equals(ARG(0,t),x))
return 1;
*ans = make_fraction(sum(one,tnegate(make_power(u,two))),sum(make_power(u,two),one));
return 0;
case SEC:
if(!equals(ARG(0,t),x))
return 1;
*ans = make_fraction(sum(make_power(u,two),one),sum(one,tnegate(make_power(u,two))));
return 0;
case TAN:
if(!equals(ARG(0,t),x))
return 1;
*ans = make_fraction(product(two,u),sum(one,tnegate(make_power(u,two))));
return 0;
case COT:
if(!equals(ARG(0,t),x))
return 1;
*ans = make_fraction(sum(one,tnegate(make_power(u,two))),product(two,u));
return 0;
}
n = ARITY(t);
*ans = make_term(f,n);
for(i=0;i<n;i++)
{ r = weierstrass_aux(ARG(i,t),x,u,ARGPTR(*ans)+i);
if(r)
return 1;
}
return 0;
}
/*_____________________________________________________________________*/
static int change_integration_limits(term integrand,term x, term u, term def, term oldlo, term oldhi, term *next)
/* given the new integrand, the old variable x, the substitution u = def,
and the old limits, produce the new definite integral by expressing
the limits in terms of u */
{ term lo,hi,temp,dir;
int st = status(intsub);
int err;
if(equals(oldhi,infinity))
{ subst(oldhi,x,def,&temp);
polyval(temp,&hi);
if(contains(hi,INFINITYFUNCTOR))
{ err = limval(limit(arrow(x,infinity),def),&hi);
if(err)
return 1;
}
}
subst(oldhi,x,def,&temp);
polyval(temp,&hi);
err = check1(domain(hi));
if(err)
{ err = infer(le(oldlo,oldhi));
if(!err)
dir = left;
else
{ err = infer(le(oldhi,oldlo));
if(!err)
dir = right;
else
return 1;
}
err = limval(limit3(arrow(x,oldhi),dir,def),&hi);
if(err)
return 1;
}
else
if(equals(oldlo,minusinfinity))
{ subst(oldlo,x,def,&temp);
polyval(temp,&lo);
if(contains(lo,INFINITYFUNCTOR))
{ err = limval(limit(arrow(x,minusinfinity),def),&lo);
if(err)
return 1;
}
}
subst(oldlo,x,def,&temp);
polyval(temp,&lo);
err = check1(domain(lo));
if(err)
{ err = infer(le(oldlo,oldhi));
if(!err)
dir = right;
else
{ err = infer(le(oldhi,oldlo));
if(!err)
dir = left;
else
return 1;
}
err = limval(limit3(arrow(x,oldlo),dir,def),&lo);
if(err)
return 1;
}
if(st < KNOWN)
{ subst(oldlo,x,def,&lo);
subst(oldhi,x,def,&hi);
}
*next = definite_integral(integrand,u,lo,hi);
return 0;
}
/*_______________________________________________________________________*/
static int stopsub(term v, term x, term *ans)
/* If v contains trig functions with different args containing x,
or powers of e and trig functions with different args containing x,
return 0;
if it contains no trig functions or exponentials
with args containing x, return 1;
if it contains a single trig arg containing x,
return 2 with that arg in *ans;
if it contains a single exponential with power containing x
and not containing any trig functions,
return 3 with that arg in *ans;
Also return 3 if it contains a single exponential e^x and a
trig function with that same exponential for an arg,
as in e^x tan (e^x).
If in the process one of the trig functors encountered has a trig
functor for an argument, that argument (e.g. cos x in sin(cos x)) comes
back in *ans, when the return value is zero.
Remarks: we want to stop substitution on e^(2t) cos(3t) for example.
However, we do NOT want to stop substitution on e^t sqrt(9-t^2) for example,
so we need to distinguish between exponential args and trig args.
We also do NOT want to stop substitution on e^(1/cos x) sin x.
*/
{ int i,j,err,sofar;
unsigned short f,n,h;
term temp,u,cancelled;
if(ATOMIC(v))
return 1;
n = ARITY(v);
f = FUNCTOR(v);
if(f==SIN || f==COS || f == TAN || f == SEC || f == COT || f == CSC
|| f == SINH || f==COSH || f == TANH || f == SECH || f == COTH || f == CSCH
)
{ *ans = ARG(0,v);
if(contains_trig(ARG(0,v)))
return 0;
return 2;
}
if(f == '^' && equals(ARG(0,v),eulere) && !contains_trig2(ARG(1,v),x))
{ *ans = ARG(1,v);
return 3;
}
sofar = 1;
for(i=0;i<n;i++)
{ err = stopsub(ARG(i,v),x,&temp);
if(!err)
{ *ans = temp;
return 0;
}
if(err == 1)
continue;
if(err == 2 && sofar == 1)
{ sofar = 2;
*ans = temp;
continue;
}
if(err == 3 && sofar == 1)
{ sofar = 3;
*ans = temp;
continue;
}
if(err >= 2 && sofar >= 2) /* got one in this arg and had one already */
{ if(sofar == 3 && FUNCTOR(temp) == '^' &&
equals(ARG(0,temp),eulere) &&
ismultipleof(*ans,x) &&
ismultipleof(ARG(1,temp),x)
/* examples, e^x tan(e^x), or e^-x tan(e^x), or e^x tan(e^2x) */
)
return 3;
if(sofar == 3 && FUNCTOR(temp) == '+')
{ /* example, e^x sin(1+e^x) */
for(j=0;j<ARITY(temp);j++)
{ if(!contains(ARG(j,temp),FUNCTOR(x)))
continue;
if(FUNCTOR(ARG(j,temp)) == '^' &&
equals(ARG(0,ARG(j,temp)),eulere) &&
equals(ARG(1,ARG(j,temp)),*ans)
)
{ if(equals(*ans,x))
continue;
if(FUNCTOR(*ans) == '*' &&
!cancel(*ans,x,&cancelled,&u) &&
equals(cancelled,x) &&
!contains(u,FUNCTOR(x))
)
continue;
}
break;
}
if(j == ARITY(temp))
return 3;
}
if(!equals(*ans,temp) && !(err == 3 && sofar == 3))
{ h = FUNCTOR(temp);
if(TRIGFUNCTOR(h) || TRIGHFUNCTOR(h))
*ans = temp;
return 0;
}
else
continue;
}
}
return sofar;
}
/*________________________________________________________________________*/
static int fract_exp(term t, term x)
/* Return 1 if v contains a fractional power of a term containing
x (including a negative one or a SQRT or a ROOT of x)
Return 0 otherwise */
/* x must be an atom */
{ int i;
unsigned short n,f;
if(ATOMIC(t))
return 0;
assert(ISATOM(x));
n = ARITY(t);
if(FUNCTOR(t)=='^' && contains(ARG(0,t),FUNCTOR(x)))
{ f = FUNCTOR(ARG(1,t));
if(f == '-')
f = FUNCTOR(ARG(0,ARG(1,t)));
if(f == '/')
return 1;
}
if(FUNCTOR(t)== SQRT && contains(ARG(0,t),FUNCTOR(x)))
return 1;
if(FUNCTOR(t) == ROOT && contains(ARG(1,t),FUNCTOR(x)))
return 1;
for(i=0;i<n;i++)
{ if(fract_exp(ARG(i,t),x))
return 1;
}
return 0;
}
/*_______________________________________________________________*/
static int biggest_common(term x,term a,term b,term vnew, term *ans)
/*
Return in *ans the largest subterm of a containing x such that substituting
for this subterm will eliminate x from b, assuming that there is at most one
occurrence of x in a (but there can be more in b). Return 0 for success,
1 for failure. vnew is a 'new' variable, not involved in a or b.
Example: if a = 1-x^2 and b = -x^2 u then *ans = x^2
*/
{ unsigned short n;
int i;
term temp;
if(equals(a,x))
{ *ans =x;
return 0;
}
subst(vnew,a,b,&temp);
if(!contains(temp,FUNCTOR(x)))
{ *ans = a;
return 0;
}
n = ARITY(a);
for(i=0;i<n;i++)
{ temp = ARG(i,a);
if(!contains(temp,FUNCTOR(x)))
continue;
return biggest_common(x,temp,b,vnew,ans);
}
return 1;
}
/*________________________________________________________________*/
static int enlarge_sub(term v,term x,term u,term def,term *ans)
/* Precondition: u = def will work in integral(v,x).
Check whether a linear function of def, u = a*x + b, contained in v, will also work.
If so return 0, with a*def + b in *ans. If not return 1. */
{ term temp,temp2,ansu;
int err;
if(FUNCTOR(def) == '^' && INTEGERP(ARG(1,def)) && equals(ARG(0,def),x))
/* example: v = x^2/ sqrt(x^3-1), def = x^3 */
temp = remove_powers(v,x); /* example: temp = 1/sqrt(x^3-1) */
else
polyval(make_fraction(v, derivative(def,x)),&temp);
/* example: v = sec x tan x sqrt(1+sec x), def = sec x, temp = sqrt(1+sec x) */
subst(u,def,temp,&temp2); /* example 1: temp2 = 1/sqrt(u-1) */
if(contains(temp2,FUNCTOR(x)))
return 1; /* example: v = x ln x, def = ln x,
temp = x^2 ln x, temp2 = x^2u. Reject this. */
err = linear_context(temp2,u,&ansu); /* ansu = u-1 (example 1) */
if(err)
return 1;
subst(def,u,ansu,ans); /* *ans = x^3 -1 */
subst(u,*ans,temp,&temp2); /* 1/(sqrt u) */
return contains(temp2,FUNCTOR(x)); /* success, in the example */
}
/*_________________________________________________________________*/
static int linear_context(term t, term u, term *ans)
/* Assume u is an atom. Return 0 if t contains a subterm of the
form a*u +b where a and b don't contain u, and either b is nonzero
or a is not 1. But reject the case b = 0 and a = -1 by returning 2.
Return said subterm in *ans.
Oherwise return 1 if t doesn't contain such a subterm. */
{ term a, b;
unsigned short n;
int i,err;
if(ATOMIC(t))
return 1;
if(islinear(t,u,&a,&b))
{ *ans = t;
if(equals(a, minusone) && ZERO(b))
return 2;
return 0;
}
n = ARITY(t);
for(i=0;i<n;i++)
{ err = linear_context(ARG(i,t),u,ans);
if(err==2)
err = 0; // OK to have -u in a subterm
if(!err)
return 0;
}
return 1;
}
/*_________________________________________________________________*/
static int rejectrecip(term integrand, term x)
// return 1 to reject x^(-1) for a substitution in integrand
// return 0 not to reject
// at present, rejects if integrand contains u without a negative exponent
{ unsigned short n = ARITY(integrand);
int i;
if(FUNCTOR(integrand) == '^' && equals(ARG(0,integrand),x) && FUNCTOR(ARG(1,integrand)) != '-')
return 1;
if(ATOMIC(integrand))
return equals(x,integrand);
for(i=0;i<n;i++)
if(rejectrecip(ARG(i,integrand),x))
return 1;
return 0;
}
/*_________________________________________________________________*/
static int rejectit(term integrand,term arg)
/* return 1 if it's a bad idea to try the substitution u=arg to
integrate integrand, e.g. x+3 in (x+3)/(x^2+6x)^2 */
{ term temp,a,b,denom,u,v,w,t;
term x = get_eigenvariable();
int linearflag,err;
int nvariables;
if(!ISATOM(x))
return 1; /* assert(0) */
if(FUNCTOR(arg) == '^' && equals(ARG(1,arg),minusone) && equals(ARG(0,arg),x)) // u = x^(-1)
{ // example, problem 52 in rationalizing substitutions, integrand after first sub is (u + u^(-1))^(-1)/u
err = rejectrecip(integrand,x);
if(err)
return 1;
}
if(too_complicated(arg,x))
/* reject products in which two or more terms are nonconstant sums.
The derivative is way too complicated for this to work, and
if there are as many as four sums, it can run MathXpert out of memory.*/
return 1;
if(FUNCTOR(arg) == LN || FUNCTOR(arg) == LOG)
{ /* This often leads to trouble, but sometimes it works fine!
In general if the result contains eulere with a nonconstant
exponent, it will lead to trouble, don't do it. Here that
situation will show up if psubst alone isn't enough to
get rid of the old variable; if we really went ahead with
the substitution, the remaining old variables will become
exponential terms.
*/
v = ARG(0,arg);
temp = make_fraction(product(integrand,v), derivative(v,x));
polyval(temp,&u);
t = var0;
UNMETA(t);
nvariables = get_nvariables();
vaux(t);
psubst(t,arg,u,&v);
if(contains(v,FUNCTOR(x)))
/* don't give up, e.g. with integrand
ln(tan x)/(sin x cos x), don't reject u = ln(tan x)
even though psubst won't eliminate x from
v = t tan x/ (sec^2 x sin x cos x); trigsimp
will reduce that to t.
*/
{ w = trigsimp(v,x);
set_nvariables(nvariables); /* take t out of varlist */
if(!contains(w,FUNCTOR(x)))
return 0;
return 1;
}
else
{ set_nvariables(nvariables);
return 0;
}
}
if(FRACTION(integrand) && equals(arg,ARG(0,integrand)) && ispolyin(arg,x))
{ /* the only conceivable case in which this would be desirable
is e.g. (x+3)/f(x+3). If the numerator isn't linear,
even this won't work. */
if(islinear(arg,x,&a,&b))
{ subst(var0,arg,integrand,&temp);
/* OK to use var0 without UNMETA as only using subst */
if(!contains(temp,FUNCTOR(x)))
return 0; /* don't reject it */
}
return 1; /* all other cases, reject a polynomial in the num */
}
if(FRACTION(integrand) && equals(arg,ARG(1,integrand)) && ONE(ARG(0,integrand)))
return 1; /* No use trying just the denominator */
linearflag = islinear(arg,x,&a,&b);
if(linearflag && atomic_trig(integrand,x) > 0)
return 1; /* don't substitute u = 1-x in integral( (1-x)^2 cos x, x) */
if(linearflag && rational_function(integrand,x))
{ /* We have to watch out for "loops" like u = 1-x, v = 1-u, ...;
this isn't officially a loop because the letters have changed;
e.g. if the integrand is x^n(1-x)^m this would happen if not
for the following code. On the other hand there is the danger
of missing some valuable substitutions: for example, if m is
large and n is small in the formula just mentioned. The
rule we follow is this: First of all, after removing any powers
of x which occur as factors, the rest must be literally a
function of arg. Secondly, the power of x thus removed should
not exceed the power of u in the rest after substitution.
The restriction to rational_function integrands is needed; for
example x^2 sin(2x) will generate u = 2x with s = x^2 in the
code below and t = 1, so the code below would reject it.
*/
term p,r,s,q,t;
double z,w;
p = remove_powers(integrand,x); /* (1-x)^m in the example, arg = 1-x */
subst(var0,arg,p,&r); /* r = var0^m */
if(contains(r,FUNCTOR(x)))
return 1; /* reject it */
if(equals(p,integrand))
s = one;
else
polyval(make_fraction(integrand,p),&s); /* s = x^n in the example */
/* not just cancel as fractions may be involved */
/* s is the powers removed when p was created */
if(ATOMIC(s) || (FRACTION(s) && ATOMIC(ARG(1,s))))
return 0; /* don't reject, no powers of x or just one power,
were discarded */
q = remove_powers(r,var0);
if(equals(q,r))
t = one;
else
{ /* polyval(make_fraction(r,q),&t);
This code was incorrectly compiled or linked
as I observed 6.12.95, q is 'one' and
r is 1/var0^2, so make_fraction returns r,
but polyval receives an atom with functor '^'.
*/
term temp = make_fraction(r,q);
polyval(temp,&t);
}
/* Now s is the original "extra" powers, and t is the "extra"
powers in the new integrand (after the substitution).
If the exponent in s is >= that in t, reject this
substitution, it will make things worse.
*/
if(ATOMIC(t) || (FRACTION(t) && ATOMIC(ARG(1,t))))
/* s is already known to be not atomic, see above */
return 1; /* reject, t is simpler */
if(FUNCTOR(t) == '/' && FUNCTOR(ARG(1,t)) == '^')
{ denom = ARG(1,t);
assert(ONE(ARG(0,t)));
t = make_power(ARG(0,denom),tnegate(ARG(1,denom)));
}
if(FUNCTOR(s) == '/' && FUNCTOR(ARG(1,s)) == '^')
{ denom = ARG(1,s);
assert(ONE(ARG(0,s)));
s = make_power(ARG(0,denom),tnegate(ARG(1,denom)));
}
assert(FUNCTOR(t) == '^');
assert(FUNCTOR(s) == '^');
if(!seminumerical(ARG(1,t)) || !seminumerical(ARG(1,s)))
return 1; /* reject */
deval(ARG(1,t),&z);
deval(ARG(1,s),&w);
if(z == BADVAL || w == BADVAL)
return 1; /* reject */
if(fabs(w) < fabs(z))
return 0; /* accept */
return 1; /* else reject */
}
return 0;
}
/*___________________________________________________________*/
int betterbyparts(term u, term x)
/* return 0 if it's better not to use substitution on integral(u,x)
because it's a natural for integration by parts */
{ term a,b,q;
unsigned short f,g;
unsigned short n;
int i,err;
term c,s;
/* First trap the special integrands cos(ln x) and sin(ln x) */
if((FUNCTOR(u) == COS || FUNCTOR(u) == SIN)
&& FUNCTOR(ARG(0,u)) == LN && equals(ARG(0,ARG(0,u)),x)
)
return 0;
if( FRACTION(u) && FUNCTOR(ARG(0,u)) == LN && ispolyin(ARG(0,ARG(0,u)),x))
/* for example, ln(x)/ sqrt(x), which arises in integral test problem 9 */
{ a = ARG(0,ARG(0,u));
b = ARG(1,u); // the denominator
if(FUNCTOR(b) == SQRT || (FUNCTOR(b) == '^' && FRACTION(ARG(1,b)) && numerical(ARG(1,b))))
q = ARG(0,b);
else if(FUNCTOR(b)==ROOT && numerical(ARG(0,b)))
q = ARG(1,b);
else
return 1;
if(ispolyin(q,x))
return 0;
}
if( /* example, ln(x)/(1+x)^9 */
FRACTION(u) && FUNCTOR(ARG(0,u)) == LN && polypower(ARG(1,u),x) && !islinear(ARG(1,u),x,&c,&s)
/* the last condition stops a loop on integral( (ln x)/x, x) or integral(ln(1+x)/(1+x),x) */
)
return 0;
if(FRACTION(u))
{ term num = ARG(0,u);
term denom = ARG(1,u);
if(ismonomial(num,x,&c,&s) && FUNCTOR(denom) == '^' && seminumerical(ARG(0,denom)) && islinear(ARG(1,denom),x,&c,&s))
return 0; /* example: integral(x^2/2^x,x), which comes up in integral test problem 20 */
}
if (FUNCTOR(u) != '*')
return 1;
n = ARITY(u);
a = ARG(0,u);
b = ARG(1,u);
f = FUNCTOR(a);
g = FUNCTOR(b);
if(n == 2 && ispolyin(a,x) && ACOS <= g && g <= ATAN)
return 0; /* x^n arctrig(x) is better by parts; differentiating
the arctrig function we get an algebraic integrand */
if(equals(a,x) &&
( n > 2 || /* example: x sin x cos x */
( n == 2 && /* examples: xe^x; xe^(2x); xe^(-x) */
(
( g == '^' && !depends(ARG(0,b),x)) /* e^f(x) or 5^x for example */
|| ( TRIGFUNCTOR2(g) || TRIGHFUNCTOR(g))
)
)
)
)
/* there will some integrands (such as t sin (t^2)) that
pass these conditions but still can't be done by parts.
The only way to be sure is to check it: */
{ if(n > 2)
{ b = make_term('*',(unsigned short)(n-1));
for(i=0;i<n-1;i++)
ARGREP(b,i,ARG(i+1,u));
}
err = simple_integral(b,x,&q);
/* The original integral can be done by parts (without
an additional integration by parts) if this call
succeeds, so then it is 'betterbyparts'. */
if(!err)
return 0;
b = ARG(1,u); /* it was used for something else above */
/* But consider x e^x sin(x), in which we want to
block u = e^x which leads nowhere, even though the
integral is too hard for simple_integral. */
if(n == 3 &&
ispolyin(a,x) &&
FUNCTOR(b) == '^' && equals(ARG(0,b),eulere) &&
is_linear_in(ARG(1,b),x) &&
TRIGFUNCTOR(FUNCTOR(ARG(2,u))) &&
is_linear_in(ARG(0,ARG(2,u)),x)
)
return 0;
return 1;
}
if(n != 2)
return 1;
if(f == '^' && g == '^' &&
(equals(ARG(0,b),eulere) || !depends(ARG(0,b),x)) &&
equals(ARG(0,a),x) && INTEGERP(ARG(1,a)) &&
is_linear_in(ARG(1,b),x)
)
return 0; /* x^n e^x, x^n e^(-x), x^n e^(ax+b), x^3 3^x*/
if(equals(a,x) && g == '^' &&
(equals(ARG(0,b),eulere) || !depends(ARG(0,b),x)) &&
equals(ARG(0,a),x) && INTEGERP(ARG(1,a)) &&
is_linear_in(ARG(1,b),x)
)
return 0; /* x e^x, x e^(-x), xe^(ax+b), x 3^x*/
if( f == '^' && equals(ARG(0,a),x) && !depends(ARG(1,a),x) &&
(g == SINH || g == COSH)
)
return 0; /* x^n cosh x, x^n sinh x */
if((g == COS || g == SIN) && f == '^' &&
equals(ARG(0,a),eulere) && equals(ARG(1,a),x)
)
return 0; /* e^x cos x or e^x sin x */
/* e^x tan x is a mess no matter how you try it */
if(g == LN && equals(ARG(0,b),x))
return 0; /* du/dx ln x => u/x. Substitution isn't going to
help unless it's a perverse integral like
(t ln t - t) ln t which works with u = t ln t - t;
that wouldn't be found anyway as intsum would
break the integral into two summands. */
if(g == LN && ispolyin(a,x) && ispolyin(ARG(0,b),x))
/* integral( a ln(v),x) where a and v are polynomials, by parts
transforms to a rational function */
return 0;
if(g == LN ) /* example: cos x ln(sin x) */
{ term temp = derivative(ARG(0,b),x);
term cancelled,v,c,s;
int err;
err = cancel(temp,a,&cancelled,&v);
if(err)
return 1;
if(!contains(v,FUNCTOR(x)))
/* so the integrand is w' ln(w) up to a constant,
which transforms to w ln w - integral(w,x) */
return 0;
twoparts(v,x,&c,&s);
if(FUNCTOR(s) == '^' && equals(ARG(0,s),x) && !contains(ARG(1,s),FUNCTOR(x)))
return 0; // example: x^{-2} ln(1+x^2
return 1;
}
return 1;
}
/*__________________________________________________________________*/
int simple_integral(term u, term x, term *ans)
/* calculate integral(u,x) = *ans if it can be done without
integration by parts and without advanced integral tables.
Return value 0 means the integral was calculated.
*/
{ return simple_integral2(0,u,x,ans);
}
/*__________________________________________________________________*/
#define MAXRECURSE 12 /* maximum recursion depth for simple_integral */
static int simple_integral2(int recursion_depth, term u, term x, term *ans)
/* calculate integral(u,x) = *ans if it can be done without
integration by parts and without advanced integral tables.
Return value 0 means the integral was calculated.
The recursion_depth parameter increases at every call,
and when it reaches MAXRECURSE it stops the recursion. This
prevents infinite regresses when MathXpert thrashes around trying
to find a good substitution.
*/
{ int err,saveit,savedisplay,savemode;
term sub,temp,v,c,base, power,p,q,mid;
char localbuf[128];
int i;
int savenvariables = get_nvariables();
int savenextdefn = get_nextdefn();
int saveeigen = get_eigenindex();
unsigned short f = FUNCTOR(u);
unsigned short n = ARITY(u);
assert(ISATOM(x));
if(recursion_depth >= MAXRECURSE)
return 1;
++recursion_depth;
if(!depends(u,x))
{ *ans = product(u,x);
return 0;
}
if(equals(u,x))
{ *ans = product(make_fraction(one,two),make_power(x,two));
return 0;
}
if(f=='-')
{ err = simple_integral2(recursion_depth,ARG(0,u),x,&temp);
tneg(temp,ans);
return err;
}
/* Next pull out constants if any */
if(f=='*' || f == '/')
{ twoparts(u,x,&c,&v);
if(!ONE(c))
{ err = simple_integral2(recursion_depth,v,x,&temp);
if(err)
return err;
temp = product(c,temp);
/* Now temp can be e.g. 2 (1/2) integral...;
we want to combine the constants, without making
the whole thing a fraction with denominator 2 */
twoparts(temp,x,&c,&v);
polyval(c,&temp);
*ans = product(temp,v);
return 0;
}
}
switch(f)
{ case '+':
temp = make_term('+',n);
saveit = get_polyvalfactorflag();
for(i=0;i<n;i++)
{ err = simple_integral2(recursion_depth,ARG(i,u),x,ARGPTR(temp)+i);
if(err)
{ RELEASE(temp);
return 1;
}
}
set_polyvalfactorflag(0); /* turn off content-factoring in
polyval; otherwise x + x^2 integrates to x^2(1/2 + x/3) */
polyval(temp,ans);
set_polyvalfactorflag(saveit);
return 0;
case SQRT:
return simple_integral2(recursion_depth,make_power(ARG(0,u),make_fraction(one,two)),x,ans);
case ROOT:
return simple_integral2(recursion_depth,make_power(ARG(1,u),make_fraction(one,ARG(0,u))),x,ans);
case '^' :
base = ARG(0,u);
power = ARG(1,u);
if(equals(base,x) && !depends(power,x))
{ polyval(sum(power,one),&temp);
*ans = make_fraction(make_power(x,temp),temp);
return 0;
}
if(equals(base,eulere) || equals(power,x))
break; /* use integral_table */
if(!depends(base,x))
{ temp = make_power(eulere,product(power,ln1(base)));
if(FUNCTOR(ARG(1,temp))=='*')
sortargs(ARG(1,temp));
return simple_integral2(recursion_depth,temp,x,ans);
}
break; /* e.g. on sec^2 x */
case '/':
p = ARG(0,u);
q = ARG(1,u);
if(!contains_sqrt(q) && !stop_apart(u) && !apart3(u,&mid))
return simple_integral2(recursion_depth,mid,x,ans);
if(!depends(q,x))
{ err = simple_integral2(recursion_depth,p,x,&temp);
if(err)
return 1;
*ans = product(make_fraction(one,q),temp);
return 0;
}
break;
}
err = integral_table(u,x,ans);
if(!err)
return 0;
temp = integral(u,x);
SETFUNCTOR(sub,ILLEGAL,0);
savedisplay = inq_display_on();
display_off();
savemode = get_mathmode();
set_mathmode(AUTOMODE);
/* set mathmode to auto before calling intsub, otherwise it doesn't
necessarily reject new fractional exponents. Example:
integrating x^2 sin(x^3) by parts leads to trying to
integrate sin(x^3), which with u = x^3 leads to sin(u) / (3u^(2/3))
which will be rejected by checksub in automode. */
err = intsub(temp,sub,&mid,localbuf);
set_mathmode(savemode);
if(savedisplay)
display_on();
if(!err)
{ err = simple_integral2(recursion_depth,ARG(0,mid),ARG(1,mid),&temp);
if(!err) /* it worked! */
unwinddefinition(temp,zero,ans,localbuf);
/* Now (whether or not it worked)
get rid of the let_defns that intsub made */
set_nvariables(savenvariables);
set_nextdefn(savenextdefn);
set_eigenvariable(saveeigen); /* restore old eigenvariable */
if(!err)
return 0;
}
return 1; /* intsub is the last resort of this function */
}
/*______________________________________________________________*/
static int evil_fractexps(term t)
/* return 1 if t contains fractional exponents with a base
which is not an mvpoly, else return 0 */
{ unsigned short n;
int i;
term base,power;
if(ATOMIC(t))
return 0;
if(FUNCTOR(t) == '^')
{ base = ARG(0,t);
power = ARG(1,t);
if(NEGATIVE(power))
power = ARG(0,power);
if(FRACTION(power) && !mvpoly(base))
return 1;
}
n = ARITY(t);
for(i=0;i<n;i++)
{ if(evil_fractexps(ARG(i,t)))
return 1;
}
return 0;
}
/*______________________________________________________________*/
static int reject_sub(term def, term u, term x)
/* v = def is being considerd as a substitution where u is
the integrand, and x is the integration variable.
Return 1 if this should be rejected without further ado. For example,
if def is linear in x and u has (x^n+a) in the denominator.
*/
{ int i;
unsigned short n;
term p,q;
if(is_linear_in(def,x))
{ if(FRACTION(u))
u = product(ARG(0,u),ARG(1,u));
if(FUNCTOR(u) != '*')
return 0;
n = ARITY(u);
for(i=0;i<n;i++)
{ p = ARG(i,u);
if(FUNCTOR(p) != '+' || ARITY(p) != 2)
continue;
if(!contains(ARG(1,p),FUNCTOR(x)))
q = ARG(0,p);
else if(!contains(ARG(0,p),FUNCTOR(x)))
q = ARG(1,p);
else
return 1; /* both terms contain x. Completing the
square will be done separately so we don't
have to worry about blocking it here. */
if(FUNCTOR(q) == '^' && equals(ARG(0,q),x))
return 1;
}
return 0;
}
return 0;
}
/*______________________________________________________________*/
static int stoploop(term def)
/* v=def is being considered as a substitution. Stop loops like
u = x-1, v = u+1 by checking whether (1) def contains a
let-defined variable u, and (2) when the definition of u
is substituted in def, def simplifies to a variable, so that
the proposed definition is really just undoing the definition of u.
If not, then recursively unwind definitions of variables in def,
and again try to simplify to a variable.
Return 1 if such a "loop" is discovered, 0 if not.
Leave the eigenvariable unchanged in the end, although unwinding
definitions changes it during the execution of stoploop.
We now restrict the search to the case when def is linear,
because otherwise, in complicated cases stoploop runs out of memory.
Without stoploop, such examples harmlessly hit the length limit,
instead of crashing.
*/
{ int nextdefn = get_nextdefn();
int oldeigen = get_eigenindex();
int savefactorflag, savefactorflag2, savecomdenomflag, savelogflag,
savefunctionflag;
void *savenode;
defn d;
term u,p,q;
int i,err;
if(nextdefn == 0)
return 0;
if(!is_linear(def))
return 0;
savefactorflag = get_polyvalfactorflag();
savefactorflag2= get_polyvalfactorflag2();
savelogflag = get_polyvallogflag();
savecomdenomflag = get_polyvalcomdenomflag();
savelogflag = get_polyvallogflag();
savefunctionflag = get_polyvalfunctionflag();
set_polyvalfactorflag(0);
set_polyvalfactorflag2(0);
set_polyvallogflag(1);
set_polyvalcomdenomflag(0);
set_polyvallogflag(1);
set_polyvalfunctionflag(1);
savenode = heapmax();
start: /* label for recursion */
for(i=nextdefn-1; i>=0; i--)
{ d = get_defn(i);
u = d.left;
if(!ISATOM(u) || !contains(def,FUNCTOR(u)))
continue;
if(!is_linear(d.right))
continue;
subst(d.right,u,def,&p); /* example, def = u-1, d.right = x+1,
p = (x+1)-1 */
polyval(p,&q); /* in the example, q=x */
if(ISATOM(q))
{ set_eigenvariable(oldeigen);
set_polyvalfactorflag(savefactorflag);
set_polyvalfactorflag2(savefactorflag2);
set_polyvallogflag(savelogflag);
set_polyvalcomdenomflag(savecomdenomflag);
set_polyvallogflag(savelogflag);
set_polyvalfunctionflag(savefunctionflag);
reset_heap(savenode);
return 1;
}
else
{ /* unwind any definitions in def */
err = unwind(def,&def);
if(err)
goto out; /* no loop */
save_and_reset(def,savenode,&def);
goto start; /* recurse */
}
}
out:
set_eigenvariable(oldeigen);
set_eigenvariable(oldeigen);
set_polyvalfactorflag(savefactorflag);
set_polyvalfactorflag2(savefactorflag2);
set_polyvallogflag(savelogflag);
set_polyvalcomdenomflag(savecomdenomflag);
set_polyvallogflag(savelogflag);
set_polyvalfunctionflag(savefunctionflag);
reset_heap(savenode);
return 0;
}
/*___________________________________________________________________*/
int linearsqrt(term t, term x)
/* return 1 if t is a linear function of sqrt x or root(n,x) for some n
(with a non-trivial constant term; t must be a sum to succeed);
or a linear function of a fractional power x^(1/n). Return 0
for failure.
*/
{ unsigned short n = ARITY(t);
int i,flag;
int count = 0;
term c,s;
if(FUNCTOR(t) != '+')
return 0;
for(i=0;i<n;i++)
{ if(contains(ARG(i,t),FUNCTOR(x)))
{ flag = i;
++count;
}
if(count >= 2)
return 0;
}
if(count == 0)
return 0;
twoparts(ARG(flag,t),x,&c,&s);
if(FUNCTOR(s) == SQRT && equals(ARG(0,s),x))
return 1;
if(FUNCTOR(s) == ROOT && equals(ARG(1,s),x))
return 1;
if(FUNCTOR(s) == '^' && equals(ARG(0,s),x) &&
FRACTION(ARG(1,s)) && ONE(ARG(0,ARG(1,s)))
)
return 1;
return 0;
}
/*____________________________________________________________________*/
static int get_sqrtsub(term v, term x, term *def)
/* if v contains a subterm with functor SQRT or ROOT which
contains x, return it (or the first such) in *def, with return value 0.
Note that *def = v is allowed. Also take a subterm with an
exponent of 1/2 or 1/n.
*/
{ unsigned short f = FUNCTOR(v);
unsigned short n = ARITY(v);
int i,err;
if(ATOMIC(v))
return 1;
if(
(f == SQRT || f == ROOT) &&
contains(v,FUNCTOR(x)) &&
!contains_exp(v,x) /* don't find u = sqrt(1+2e^x), which will sometimes
work but leads to unsolvable integrals. */
)
{ *def = v;
return 0;
}
if(f == '^' && FRACTION(ARG(1,v)) &&
ONE(ARG(0,ARG(1,v))) && INTEGERP(ARG(1,ARG(1,v))) &&
contains(ARG(0,v),FUNCTOR(x)) &&
!contains_exp(v,x)
)
{ *def = v;
return 0;
}
for(i=0;i<n;i++)
{ err = get_sqrtsub(ARG(i,v),x,def);
if(!err)
return 0;
}
return 1;
}
/*____________________________________________________________________*/
static int get_quadratic_sub(term v, term x, term *def)
/* if v contains a subterm (algebraically, i.e. not inside functions)
of the form ax^2 \pm b, with a != 1, return
*def = sqrt(a/b) x so the new integrand will involve (u^2 \pm 1).
This is needed to integrate, for example, 1/(ax^2+1).
Return 0 for success, 1 if there is no such term.
*def = v is allowed (to facilitate recursion) and must be
checked for by the calling function.
*/
{ unsigned short f = FUNCTOR(v);
unsigned short n = ARITY(v);
int i,j,err,count;
term u,a,b,c,s, sqrtb,sqrta,p,q;
if(ATOMIC(v))
return 1;
if(n == 1 && f != '-' && f != ROOT)
return 1; /* don't look inside functions */
for(i=0;i<n;i++)
{ err = get_quadratic_sub(ARG(i,v),x,def);
if(!err)
return 0;
}
if(FUNCTOR(v) == '+')
{ /* First count the nonconstant terms */
count = 0;
for(i=0;i<n;i++)
{ if(contains(ARG(i,v),FUNCTOR(x)))
++count;
}
if(count != 1)
return 1;
/* look for a quadratic term in x */
for(i=0;i<n;i++)
{ u = ARG(i,v);
if(!contains(u,FUNCTOR(x)))
continue;
if(NEGATIVE(u))
u = ARG(0,u);
if(FUNCTOR(u) != '*' && FUNCTOR(u) != '/')
return 1;
twoparts(u,x,&a,&s);
if(ONE(a))
return 1;
if(FUNCTOR(s) == '^' && equals(ARG(0,s),x) && equals(ARG(1,s),two))
break;
}
if(i==n)
return 1;
if(n == 2)
{ b = ARG(i ? 0 : 1, v);
if(NEGATIVE(b))
b = ARG(0,b);
}
else
{ b = make_term('+',(unsigned short)(n-1));
for(j=0;j<n-1;j++)
ARGREP(b,j,ARG(j<i ? j : j+1,v));
}
if(!ONE(b) && !cancel(a,b,&p,&q))
{ if(FRACTION(q))
{ a = ARG(0,q);
b = ARG(1,q);
}
else
{ a = q;
b = one;
}
}
if(ONE(b)) /* it may have just been made == one */
{ err = sqrt_aux(a,&sqrta);
if(err)
sqrta = make_sqrt(a);
*def = product(sqrta,x);
}
else
/* The following code will make an assumption about the sign of a
and another about the sign of b; we don't try to get by with
assuming something about the sign of b/a only. */
{
err = sqrt_aux(a,&sqrta);
if(err)
sqrta = make_sqrt(a);
err = sqrt_aux(b,&sqrtb);
if(err)
sqrtb = make_sqrt(b);
c = make_fraction(sqrta,sqrtb);
if(ONE(c))
return 1;
if(FRACTION(c))
mfracts(c,x,def);
else
*def = product(c,x);
}
return 0;
}
return 1;
}
/*________________________________________________________________*/
static int literally_linear_in(term v, term x)
/* return 1 if v is a product, exactly one of whose factors is x,
or a sum, exactly one of whose summands is x or a product satisfying
literally_linear_in, or a negation thereof.
Return 0 otherwise.
*/
{ unsigned short n,f;
int i,count = 0;
term p;
n = ARITY(v);
f = FUNCTOR(v);
if(f != '+' && f != '*')
return 0;
for(i=0;i<n;i++)
{ p = ARG(i,v);
if(f == '+' && NEGATIVE(p))
p = ARG(0,p);
if(!contains(p,FUNCTOR(x)))
continue;
if(count)
return 0; /* more than one arg contains x */
++count;
if(f == '*' && !equals(p,x))
return 0;
if(f == '+' && !equals(p,x) &&
!(FUNCTOR(p) == '*' && literally_linear_in(p,x))
)
return 0;
}
if(count != 1)
return 0;
return 1;
}
/*________________________________________________________________*/
static int get_linear_sub_aux(term v,term x,term *ans)
/* Does v contain a linear expression ax+b with a not zero (1 is ok)
and b not zero? If so return it in *ans, returning 0.
If not return 1. Make b nonzero if possible.
*/
{ unsigned short n,f;
int i,err;
if(ATOMIC(v))
return 1;
f = FUNCTOR(v);
if((f == '+' || f == '*') && literally_linear_in(v,x))
{ *ans = v;
return 0;
}
n = ARITY(v);
for(i=0;i<n;i++)
{ err = get_linear_sub_aux(ARG(i,v),x,ans);
if(!err)
return 0;
}
return 1;
}
/*________________________________________________________________*/
static int get_linear_sub(term v,term x,term *ans)
/* Is there a linear expression ax+b such that every occurrence of
x in v is in an occurrence of ax+b? Example, v = ((3x+1)^2 + 2)/(3x+1).
If so return it in *ans, returning 0 for success.
Be sure not to return 3x from f(3x+1), but 3x+1.
Return 1 if there is no such expression.
*/
{ int err;
term temp;
err = get_linear_sub_aux(v,x,ans);
if(err || FUNCTOR(*ans) != '+') /* previous line can return *ans = 4x for example */
return 1;
subst(var0, *ans,v,&temp);
if(contains(temp,FUNCTOR(x)))
return 1;
return 0;
}
/*___________________________________________________________________*/
static int get_linear_sub2(term v,term x,term *ans)
/* If v is a product of powers of linear functions,
choose *ans to be the linear function with the
largest exponent. If one of them has a symbolic
exponent, choose that one. Return 0 for success
and 1 for failure.
This is used to handle integrands like (x-3)^4 (x-7)^21, where
we want to make the subsitution u = x-7 rather than u = x-3, so
that there will be fewer terms when we expand.
*/
{ unsigned short n;
long maxexp = 0;
term u, exp, base;
int i;
unsigned short symbolflag, flag;
int nsymbolexponents = 0;
if(FUNCTOR(v) != '*' && !FRACTION(v))
return 1;
n = ARITY(v);
for(i=0;i<n;i++)
{ u = ARG(i,v);
if(FUNCTOR(u) == '^')
{ exp = ARG(1,u);
base = ARG(0,u);
if(!INTEGERP(exp))
{ if(!isinteger(exp))
return 1;
if(nsymbolexponents)
return 1; /* two or more symbolic exponents */
++nsymbolexponents;
symbolflag = (unsigned short) i;
}
else /* exp is a specific integer */
{ if(INTDATA(exp) > maxexp && contains(base,'+'))
{ maxexp = INTDATA(exp);
flag = (unsigned short) i;
}
}
}
else
{ base = u;
exp = one;
}
if(!is_linear_in(base,x))
return 1;
}
if(nsymbolexponents)
{ *ans = ARG(0,ARG(symbolflag,v));
return contains(*ans,'+') ? 0 : 1;
}
if(maxexp == 0)
return 1;
*ans = ARG(0,ARG(flag,v));
return contains(*ans,'+') ? 0 : 1;
}
/*__________________________________________________________________________*/
static int contains_trig2(term t, term x)
/* return 1 if t contains a trig function whose arg contains x,
return 0 if not.
*/
{ unsigned short f,n;
int i;
if(ATOMIC(t))
return 0;
f = FUNCTOR(t);
if(TRIGFUNCTOR(f))
return contains(ARG(0,t),FUNCTOR(x));
n = ARITY(t);
for(i=0;i<n;i++)
{ if(contains_trig2(ARG(i,t),x))
return 1;
}
return 0;
}
/*____________________________________________________________________*/
static int contains_diff(term u, term x)
/* return 1 if u contains a derivative with respect to x */
{ unsigned short n;
int i;
if(ATOMIC(u))
return 0;
if(FUNCTOR(u) == DIFF) /* whether arity 2 or 3 */
return equals(ARG(1,u),x);
n = ARITY(u);
for(i=0;i<n;i++)
{ if(contains_diff(ARG(i,u),x))
return 1;
}
return 0;
}
/*___________________________________________________________________*/
static int ismultipleof(term t, term x)
/* return 1 if t is an multiple (positive or negative) of x */
{ term c,s;
if(NEGATIVE(t))
t = ARG(0,t);
if(FRACTION(t) && !contains(t,FUNCTOR(x)))
t = ARG(0,t);
if(FUNCTOR(t) == '*')
{ twoparts(t,x,&c,&s);
t = s;
}
if(equals(t,x))
return 1;
return 0;
}
/*_____________________________________________________________________*/
static int too_complicated(term t, term x)
/* return 1 if t is so complicated that we might run out of memory
taking its derivative, and besides the chances are slim that its derivative
would be present in the numerator or as another factor of the integrand.
x is the variable of integration. Return 0 if t is not too complicated.
*/
{ unsigned short n;
int i,count;
term u;
if(ATOMIC(t))
return 0;
n = ARITY(t);
if(FUNCTOR(t) == '*')
{ count = 0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u) == '+' && contains(u,FUNCTOR(x)))
++count;
if(count > 1)
return 1;
}
return 0;
}
for(i=0;i<n;i++)
{ if(too_complicated(ARG(i,t),x))
return 1;
}
return 0;
}
/*________________________________________________________________________*/
static int integrate_trigrecip(term t, term x, term *ans)
/* integrate 1/cos x, 1/cos^2 x, etc., returning 0 for success
with the integral in *ans, or 1 for failure with *ans garbage. */
{ term denom,temp;
int err;
unsigned short g;
if(ONE(ARG(0,t)))
{ denom = ARG(1,t);
g = FUNCTOR(denom);
if(
(g == COS && equals(ARG(0,denom),x)) ||
(g == '^' && equals(ARG(1,denom),two) && FUNCTOR(ARG(0,denom)) == COS && equals(ARG(0,ARG(0,denom)),x))
)
{ err = recip_aux(COS, SEC, t, &temp);
if(!err)
return integral_table(temp,x,ans);
}
if(
(g == SIN && equals(ARG(0,denom),x)) ||
(g == '^' && equals(ARG(1,denom),two) && FUNCTOR(ARG(0,denom)) == SIN && equals(ARG(0,ARG(0,denom)),x))
)
{ err = recip_aux(SIN, CSC, t, &temp);
if(!err)
return integral_table(temp,x,ans);
}
if(
(g == SEC && equals(ARG(0,denom),x)) ||
(g == '^' && equals(ARG(1,denom),two) && FUNCTOR(ARG(0,denom)) == SEC && equals(ARG(0,ARG(0,denom)),x))
)
{ err = recip_aux(SEC, COS, t, &temp);
if(!err)
return integral_table(temp,x,ans);
}
if(
(g == CSC && equals(ARG(0,denom),x)) ||
(g == '^' && equals(ARG(1,denom),two) && FUNCTOR(ARG(0,denom)) == CSC && equals(ARG(0,ARG(0,denom)),x))
)
{ err = recip_aux(CSC, SIN, t, &temp);
if(!err)
return integral_table(temp,x,ans);
}
if(
(g == COT && equals(ARG(0,denom),x)) ||
(g == '^' && equals(ARG(1,denom),two) && FUNCTOR(ARG(0,denom)) == COT && equals(ARG(0,ARG(0,denom)),x))
)
{ err = recip_aux(COT, TAN, t, &temp);
if(!err)
return integral_table(temp,x,ans);
}
if(
(g == TAN && equals(ARG(0,denom),x)) ||
(g == '^' && equals(ARG(1,denom),two) && FUNCTOR(ARG(0,denom)) == TAN && equals(ARG(0,ARG(0,denom)),x))
)
{ err = recip_aux(TAN, COT, t, &temp);
if(!err)
return integral_table(temp,x,ans);
}
}
return 1;
}
/*_____________________________________________________________________*/
#define PAUSE 1000 /* delay in milliseconds for user to contemplate the display */
static void maybe_display_progress(term u, term def)
{ if(!inq_display_on())
return;
term *varlist = get_varlist();
term x = varlist[0]; // the integration variable
term du = derivative(def,x);
display_progress(and(equation(u,def), equation(diff(u,x),du)),779);
}
/*__________________________________________________________*/
static int atomic_trig(term t, term x)
/* return the number of occurrences of trig functions
with argument x, provided all trig functions have arguments equal to
the atom x, or not containing x. Return -1 if a trig function
with non-atomic argument containing x is encountered in t.
*/
{ unsigned short i,n,f;
int p,ans;
if(ATOMIC(t))
return 0;
f = FUNCTOR(t);
if(TRIGFUNCTOR(f))
{ if(equals(ARG(0,t),x))
return 1;
if(contains(ARG(0,t),FUNCTOR(x)))
return -1;
return 0;
}
n = ARITY(t);
ans = 0;
for(i=0;i<n;i++)
{ p = atomic_trig(ARG(i,t),x);
if(p < 0)
return -1;
ans += p;
}
return ans;
}
/*_______________________________________________________________*/
static int impossiblesub(term u, term x)
/* return 1 if it's impossible (or undesirable) to do integral(u,x) by
substitution. This some prevents awkward-looking
failures, in which MathXpert tries several useless substitutions
before giving up.
We may be able to handle more cases here in the future, but you
have to be very careful that you don't rule out some good
solutions this way.
*/
{ unsigned short f,i,n;
term v,w;
long m;
f = FUNCTOR(u);
if(f == '-')
{ u = ARG(0,u);
f = FUNCTOR(u);
}
if(f == '^' && NUMBER(ARG(1,u)))
{ /* when can u^n dx be integrated by substitution?
v' would have to divide u^n, so either it would
have to be a power, in which case v is a power of x,
or it would have to divide u.
*/
if(impossiblesub(ARG(0,u),x))
{ /* that just leaves the case v is a power of x to
think about */
if(!contains(ARG(0,u),'^'))
return 1;
}
return 0;
}
if(f == '*' && ARITY(u) == 2 &&
FUNCTOR(ARG(0,u)) == '^' &&
equals(ARG(0,ARG(0,u)),x) &&
(FUNCTOR(ARG(1,u)) == SQRT ||
FUNCTOR(ARG(1,u)) == ROOT ||
(FUNCTOR(ARG(1,u)) == '^' && SIGNEDRATIONAL(ARG(1,ARG(1,u))))
)
)
{ if(FUNCTOR(ARG(1,u)) == ROOT)
w = ARG(1,ARG(1,u));
else
w = ARG(0,ARG(1,u));
v = ARG(1,ARG(0,u));
/* u = x^v sqrt(w), or x^v w^(p/q), or x^v root(..,w) */
/* The only substitutions that could possibly apply are a linear one
or u = a power of x. */
if(!contains(w,'^'))
{ if(FUNCTOR(w) != '+')
return 1; /* example, u = x^2 sqrt((3-x)(x-3))
in which otherwise the substitution x-3 is found; */
if(is_linear_in(w,x))
return 0; /* but u = x^2 sqrt(x-3) should NOT be rejected
as substitution for sqrt(x-3) works fine. */
}
if(mvpoly2(w) && contains(w,'+'))
{ /* in particular, no fractional exponents */
if(depends(v,x))
return 1; /* example, x^x sqrt(x+1) */
/* the only possibility is x^n where v congruent to 1 mod n */
/* example, x^3 sqrt((1-x^2)(1+x^2)), substitution is OK */
if(ISINTEGER(v))
/* example, x^2 sqrt(1+x^3), we want to return 0 because
substitution x^3 will work. But in most cases
x^n sqrt(f(x)) is impossible by substitution; only
in case f(x) is a function of x^(n+1) is it possible.
*/
{ m = INTDATA(v);
if( m==0)
return 1;
++m;
if(functionof(w,x,m))
return 0;
/* example: integral(x^n sqrt((x-a)^2 + b^2),x)
in which u = x-a should be substituted. */
if(FUNCTOR(w) == '+' &&
ARITY(w) == 2 &&
!contains(ARG(1,w),FUNCTOR(x)) &&
FUNCTOR(ARG(0,w)) == '^' &&
iseven(ARG(1,ARG(0,w)))
)
return 0;
return 1;
}
}
}
if(f == '*')
{ /* return 1 on a product of linear functions */
n = ARITY(u);
for(i=0;i<n;i++)
{ if(!is_linear_in(ARG(i,u),x))
break;
}
if(i==n)
return 1;
}
return 0;
}
/*____________________________________________________________*/
static int functionof(term w, term x, long m)
/* return 1 if w is a function of x^m, 0 if not.
Assumes m > 1
*/
{ unsigned short n,i;
if(FUNCTOR(w) == '^' &&
equals(ARG(0,w),x) &&
ISINTEGER(ARG(1,w))
)
{ if(INTDATA(ARG(1,w)) % m == 0)
return 1;
else
return 0;
}
if(equals(w,x))
return 0;
if(ATOMIC(w))
return 1;
n = ARITY(w);
for(i=0;i<n;i++)
{ if(!functionof(ARG(i,w),x,m))
return 0;
}
return 1;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists