Sindbad~EG File Manager
/* MathXpert integration operators */
/*
M. Beeson
1.15.91 Original date
3.25.99 last modified
*/
#include <string.h>
#include <assert.h>
#define TRIGCALC_DLL
#include "globals.h"
#include "ops.h"
#include "calc.h"
#include "checkarg.h" /* for operator typedef */
#include "operator.h" /* for menu names */
#include "probtype.h"
#include "algaux.h"
#include "factor.h"
#include "getprob.h"
#include "integral.h"
#include "order.h" /* constant */
#include "symbols.h"
#include "mathmode.h" /* get_mathmode */
#include "pathtail.h" /* set_pathtail */
#include "fsubst.h" /* free_subst */
#include "deval.h" /* seminumerical */
#include "pvalaux.h" /* twoparts */
#include "errbuf.h"
#include "simpsums.h" /* collect */
static int completesquare1_aux( term left, term *x, term *y, term *ans, term *addthis);
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int fundamentaltheorem(term t, term arg, term *next, char *reason)
/* integral of a derivative or of a higher derivative */
{ if(FUNCTOR(t) != INTEGRAL)
return 1;
if(FUNCTOR(ARG(0,t)) != DIFF)
return 1;
if(ARITY(ARG(0,t)) == 2) /* ordinary derivative */
*next = ARG(0,ARG(0,t));
else if(ARITY(ARG(0,t)) == 3) /* higher derivative */
{ term n,nminusone;
int err;
nminusone = sum(ARG(2,ARG(0,t)),minusone);
err = value(nminusone,&n);
if(err)
n = nminusone;
*next = diff3(ARG(0,ARG(0,t)),ARG(1,t),n);
}
HIGHLIGHT(*next);
strcpy(reason, english(607)); /* fundamental theorem of calculus */
return 0;
}
/*_______________________________________________________________________*/
static int lci_aux(term t,term *x)
/* is t an integral, a constant times an integral, minus an
integral, or minus a constant times an integral ?
Return 1 if so, 0 if not. Return the variable of integration in *x.
*/
{ unsigned short f = FUNCTOR(t);
unsigned short n = ARITY(t);
int i,flag,count=0;
if(f==INTEGRAL && n==2)
{ *x = ARG(1,t);
return 1;
}
if(f == '*')
{ for(i=0;i<n;i++)
{ flag = lci_aux(ARG(i,t),x);
if(flag && count)
return 0; /* too many integrals */
else if(flag)
++count;
else if(!constant(ARG(i,t)))
return 0;
}
return 1;
}
if(f == '-')
return lci_aux(ARG(0,t),x);
return 0;
}
/*_______________________________________________________________________*/
/* Constants of integration are a tricky business: we don't ALWAYS
introduce one when an indefinite integration sign is eliminated.
When do we not? When the integral was part of a linear combination
of integrals (with constant coefficients) and some integral signs
still remain. Therefore, the operators themselves do NOT introduce
constants of integration. Instead, this must be done when the
operator is applied, by a function that has access to the context.
In top.c, after exec (in menumode) or one_step (in automode),
the function constants_of_integration is called.
This compares its two arguments 'old' and 'new', node by node. When
it finds a node where 'old' has an indefinite integral and 'new' does
not, it checks whether it is necessary to add a constant of integration.
If so, it adds one (in the term being returned).
This function is called only when the
operator is one that eliminates an integral, so the points of difference
between old and new must be at an indefinite integral.
The following examples can't be created in MathXpert anyway, since
indefinite integrals are always at the top level and hence can never
appear in a denominator.
Example 1: old = integral(x,x) / integral(x,x);
new = x^2/2 / x^2/2
The function should return (x^2/2 + c1 ) / (x^2/2 + c2)
Example 2: old = integral(x,x) /(integral(x^2,x) + integral(x,x))
new = x^2/2 / (integral(x^2,x) + x^2/2)
The function should return (x^2/2 + c1)/ (integral(x^2,x) + x^2/2)
Example 3: old = integral(cos ax,x) /(integral(x^2,x) + integral(cos ax,x))
new = (1/a sin(ax))/ (integral(x^2,x) + 1/a sin(ax))
The function should return (x^2/2 + c1) / (integral(x^2,x) + 1/a sin(ax) + c2)
This time c2 has to be created because c2 depends on a, which
integral(x^2,x) does not depend on. This example isn't yet
supported. As the code now stands, constants of integration can
come out with insufficient dependency information on other constants.
I think this will not lead to visible errors since you can't see
the dependency information of constants anyway. Besides, the
constants depend on the parameters only in their domains: that is,
a constant of integration represents a "step" function which is
constant on the connected components of its domain, so
differentiation will give zero anyway.
Example 4: old = integral(x^(1/2) + x^2,x)
new = integral(x^(1/2),x) + x^3/3 (result of intpoly)
No constant should be introduced.
Example 5: old = (1/2) (1 + integral(sin x, x)) + integral(cos x, x)
new = (1/2) (1 - cos x) + integral(cos x, x)
No constant should be introduced.
*/
static int ci_aux(term,term,term *,term *,term *); /* see below */
MEXPORT_TRIGCALC term constants_of_integration(term old, term new)
/* If an indefinite integral in old has been evaluated to make new,
then: if that integral occurred in
a linear combination of terms including at least one other indef. integral
(or constant times one)
a constant times a linear combination of terms as in example 5
then do nothing (that is, return new). Otherwise, throw in a constant of
integration and return the resulting term. */
{ term p,c,ans,x,q;
int k;
k = ci_aux(old,new,&p,&q,&x); /* see below */
if(k<2)
{ return new; /* p not found (k==0)
or another integral present (k==1) */
}
c = constant_of_integration(q,x);
HIGHLIGHT(c);
free_subst(sum(p,c),p,new,&ans);
if(FUNCTOR(p) != '+' && FUNCTOR(p) != '*')
HIGHLIGHT(ans);
release(expand); /* possibly inhibited by partialfractions. We need to
release it when the integrals are done, so for
example args of logs can be expanded. */
return ans;
}
/*__________________________________________________________________________*/
static int ci_aux(term old,term new,term *ans, term *params, term *c)
/* Search for and return in *ans a term which corresponds to
an integral that was evaluated in old. Return 2 to mean that
we should replace this term by itself plus a constant of integration.
The term in old that corresponds to *ans should thus be an
integral, a constant times an integral, or a linear combination of such terms.
Return value 0 means such a term not found;
1 means found, but another integral remains unevaluated in the linear
combination; 2 means this is the only one, so a constant of integration
is needed. Here "integral" means "indefinite integral".
If k==2 it also returns the variable of integration in *c.
If there is more than one variable of integration, as when two integrals
in two different variables are done at the same line, then both *c
is returned as an AND of the variables of integration.
If k==2 then in *params it should return a term containing any
extra variables on which the constant of integration should depend.
*params may contain the variable of integration as well.
*/
{ term u,v,w1,w2,x;
int i,j,k,flag,flag2,flag3,marker;
unsigned short f = FUNCTOR(old);
unsigned short n = ARITY(old);
unsigned short m = ARITY(new);
if(ATOMIC(old))
{ *ans = new;
return 0;
}
if(FUNCTOR(new)==INTEGRAL && m==2)
{ *ans = new;
return 0;
}
if(f == INTEGRAL && n==2)
{ *ans = *params = new;
*c = ARG(1,old);
return contains(new,INTEGRAL) ? 0 : 2;
}
if((f == INTEGRAL && n==4) || f == LIMIT)
{ /* won't find an indefinite integral inside
a definite integral or limit */
*ans = new;
return 0;
}
if(FUNCTOR(old) == '*')
{ if(FUNCTOR(new) != '*')
{ *ans = new;
return 0;
}
flag = 0; /* set if we encounter a nonconstant factor */
marker = 0; /* set if we encounter an evaluated integral */
for(i=0;i<m && i<n;i++)
{ u = ARG(i,old);
v = ARG(i,new);
if(FUNCTOR(u)!= FUNCTOR(v))
{ if(FUNCTOR(u) == INTEGRAL &&
contains(v,INTEGRAL)
)
{ *ans = new;
return 1;
}
if(FUNCTOR(u) == INTEGRAL && i==n-1 && n < m &&
contains(ARG(i+1,new),INTEGRAL)
)
{ *ans = new;
return 1;
}
if(FUNCTOR(u)==INTEGRAL && ARITY(u)==2)
marker = i+1;
else
return 0;
}
else if(!constant(v))
flag = 1;
}
if(marker)
{ u = ARG(marker-1,old); /* the integral that was evaluated */
*c = ARG(1,u);
if(m > n)
{ *params = make_term('*',(unsigned short)(m-n+1));
for(k=0;k<m-n+1;k++)
ARGREP(*params,k,ARG(marker-1+k,new));
}
else
*params = ARG(marker-1,new);
*ans = flag ? *params : new;
return 2;
}
}
if(FUNCTOR(old) == '+')
{ n = ARITY(old);
if(FUNCTOR(new) != '+')
{ *ans = new;
return 0;
}
/* n doesn't have to equal ARITY(new) */
SETFUNCTOR(*params,ILLEGAL,0);
SETFUNCTOR(*c, ILLEGAL,0);
/* First look in new for a still-unevaluated integral */
for(i=0;i<n;i++)
{ u = ARG(i,old);
v = ARG(i,new);
if(FUNCTOR(u) == '-' && FUNCTOR(v) == '-')
{ u = ARG(0,u);
v = ARG(0,v);
}
if(FUNCTOR(v) == INTEGRAL && ARITY(v)==2)
/* here's one still unevaluated */
{ *ans = new;
return 1;
}
if(FUNCTOR(v) == '*' || FUNCTOR(v) == '/')
{ term c,s;
for(j=0;j<ARITY(v);j++)
{ if(FUNCTOR(ARG(j,v))==INTEGRAL && ARITY(ARG(j,v))==2)
{ x = ARG(1,ARG(j,v));
break;
}
}
if(j<ARITY(v))
{ twoparts(v,x,&c,&s);
if(FUNCTOR(s) == INTEGRAL)
/* an unevaluated integral multiplied by a constant */
{ *ans = new;
return 1;
}
if(FUNCTOR(s) == '*' && ARITY(s) == 2 &&
FUNCTOR(ARG(0,s)) == SG &&
FUNCTOR(ARG(1,s)) == INTEGRAL &&
ARITY(ARG(1,s)) == 2
)
{ *ans = new;
return 1;
}
}
}
}
/* Now we know that new doesn't contain integrals multiplied by
constants. */
flag = flag2 = 0;
for(i=0;i<n;i++)
{ u = ARG(i,old);
v = ARG(i,new);
if(FUNCTOR(u) == '-' && FUNCTOR(v) == '-')
{ u = ARG(0,u);
v = ARG(0,v);
}
if(FUNCTOR(u) != FUNCTOR(v) && FUNCTOR(u)==INTEGRAL && ARITY(u)==2)
/* This is an integral that's been evaluated */
{ ++flag;
x = ARG(1,u);
if(FUNCTOR(*params) == ILLEGAL)
{ *params = v;
*c = x;
}
else
{ *params = and(*params,v);
*c = and(*c,x);
}
continue;
}
if(FUNCTOR(u) == '*' && contains2(u,INTEGRAL,2) && FUNCTOR(v) == '*')
/* maybe an integral was a factor of u and was evaluated to
make v, and all the other factors are constant */
{ m = ARITY(u);
flag2 = flag3 = 0;
/* First identify the variable of integration */
for(j=0;j<m;j++)
{ if(FUNCTOR(ARG(j,u)) == INTEGRAL)
{ x = ARG(1,ARG(j,u));
break;
}
}
if(j==m)
continue; /* no factor of u is an integral */
for(j=0;j<m;j++)
{ w1 = ARG(j,u);
w2 = ARG(j,v);
if(FUNCTOR(w1) == INTEGRAL && ARITY(w1)==2
&& FUNCTOR(w2) != INTEGRAL
)
flag2 = j+1;
else if(FUNCTOR(w1) != FUNCTOR(w2))
{ *ans = new;
return 0;
}
else if(FUNCTOR(w1) == '+') /* as in Example 5 */
{ term temp;
int r = ci_aux(w1,w2,&temp,params,c);
if(r==1) /* one evaluated and one unevaluated integral there */
{ *ans = new;
return 1;
}
if(r==2) /* one evaluated and no unevaluated integrals */
{ flag2 = j+1;
}
}
else if(FUNCTOR(w1) != SG && contains(w1,FUNCTOR(x)))
flag3 = 1; /* nonconstant factor other than the integral */
}
if(flag3 && /* nonconstant factor other than the integral */
flag2 /* an integral factor was evaluated */
/* but if there isn't an integral in the term,
a nonconstant factor is OK */
)
break; /* out of the i-loop, this sum isn't
the answer, we'll have to go for the
product after a recursive call */
/* but if there isn't an integral in the term,
a nonconstant factor is OK */
if(flag2) /* an integral was evaluated */
{ ++flag;
if(FUNCTOR(*params) == ILLEGAL)
{ *params = v;
*c = x;
}
else
{ *params = and(*params,v);
*c = and(*c,x);
}
}
}
}
if(flag) /* We do have an evaluated integral in summand number 'marker-1' */
{ *ans = new;
return 2;
}
}
if(FUNCTOR(old) != FUNCTOR(new) || ARITY(old) != ARITY(new))
{ *ans = new;
return 0;
}
/* Now we must go deeper into old */
n = ARITY(old);
for(i=0;i<n;i++)
{ k = ci_aux(ARG(i,old),ARG(i,new),ans,params,c);
if(k != 0)
return k;
}
*ans = new;
return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int combineconstantsofintegration(term t, term arg, term *next, char *reason)
/* c1 + c2 = c3 for constants of integration */
{ unsigned short n;
int i,j;
term u,c,temp;
int count=0;
int *scratchpad;
if(FUNCTOR(t) != '+')
return 1;
n = ARITY(t);
scratchpad = (int *) callocate(n,sizeof(int));
if(scratchpad==NULL)
{ nospace();
return 1;
}
temp = make_term('+',n);
/* Now count and locate the position of all constants of integration
(or for that matter other existential variables)
in t; at the same time accumulating their dependsinfo, ie.
what variables they directly depend on */
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u) == CONSTANTOFINTEGRATION)
{ ARGREP(temp,count,u);
++count;
scratchpad[i] = 1;
}
}
if(count < 2)
{ RELEASE(temp);
free2(scratchpad);
return 1;
}
c= constant_of_integration(temp,get_eigenvariable());
/* doesn't matter what variable we pass */
/* passing temp ensures that the right variables will be
put in the arguments of c */
HIGHLIGHT(c);
RELEASE(temp);
/* Now construct the answer, *next, by putting c in place of
the first constant of integration and copying over all the
args which are not constants of integration. */
if(count == n) /* all terms were constants of integration */
*next = c;
else
{ *next = make_term('+',(unsigned short)(n-count+1));
j = 0;
for(i=0;i<n;i++)
{ if(!scratchpad[i])
{ ARGREP(*next,j,ARG(i,t));
++j;
}
}
assert(j==n-count);
ARGREP(*next,j,c);
}
strcpy(reason, english(687)); /* combine constants */
free2(scratchpad);
return 0;
}
/*_______________________________________________________________________*/
static void intvector_aux(term u, term x, term *next)
/* u is a vector; form the vector of its indefinite integrals
with respect to x */
{ unsigned short n = ARITY(u);
int i;
*next = make_term(VECTOR,n);
for(i=0;i<n;i++)
ARGREP(*next,i,integral(ARG(i,u),x));
}
/*_______________________________________________________________________*/
static void intvector_aux2(term u, term x, term lo, term hi,term *next)
/* u is a vector; form the vector of its indefinite integrals from lo to hi
with respect to x */
{ unsigned short n = ARITY(u);
int i;
*next = make_term(VECTOR,n);
for(i=0;i<n;i++)
ARGREP(*next,i,definite_integral(ARG(i,u),x,lo,hi));
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int intvector(term t, term arg, term *next, char *reason)
{ term u,x,lo,hi;
if(FUNCTOR(t) != INTEGRAL)
return 1;
u = ARG(0,t);
if(FUNCTOR(u) != VECTOR)
return 1;
x = ARG(1,t);
if(ARITY(t)==2)
intvector_aux(u,x,next);
else
{ lo = ARG(2,t);
hi = ARG(3,t);
intvector_aux2(u,x,lo,hi,next);
}
HIGHLIGHT(*next);
strcpy(reason, english(1156));
/* �{a,b...}dx = {�a dx,�b dx...} */
return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int intmatrix(term t, term arg, term *next, char *reason)
{ term u,x,lo,hi;
int i;
unsigned short n;
if(FUNCTOR(t) != INTEGRAL)
return 1;
u = ARG(0,t);
if(FUNCTOR(u) != MATRIX)
return 1;
n = ARITY(u);
x = ARG(1,t);
*next = make_term(MATRIX,n);
if(ARITY(t)==2)
{ for(i=0;i<n;i++)
intvector_aux(ARG(i,u),x,ARGPTR(*next)+i);
}
else
{ lo = ARG(2,t);
hi = ARG(3,t);
for(i=0;i<n;i++)
intvector_aux2(u,x,lo,hi,next);
}
HIGHLIGHT(*next);
strcpy(reason, english(686));
/* integrate matrix term by term */
return 0;
}
/*_______________________________________________________________________*/
MEXPORT_TRIGCALC int intabs(term t, term arg, term *next, char *reason)
{ term u,x,temp;
if(FUNCTOR(t) != INTEGRAL)
return 1;
u = ARG(0,t);
x = ARG(1,t);
if(FUNCTOR(u) != ABS)
return 1;
if(!equals(ARG(0,u),x))
return 1;
temp= make_fraction(product(x,abs1(x)),two);
if(ARITY(t)==2)
*next = temp;
else
*next = evalat(temp,x,ARG(2,t),ARG(3,t));
HIGHLIGHT(*next);
strcpy(reason, english(1157));
/* �|t| dt = t|t|/2 */
return 0;
}
/*_________________________________________________________________*/
MEXPORT_TRIGCALC int completethesquare1(term t , term arg, term *next, char *reason)
/* complete the square.
In auto mode, called only inside an integral, on a sum which is
the arg of a square root or on a quotient which is a rational function.
*/
{ term num,denom,p,q,pp,x,y,power;
int err;
unsigned short f = FUNCTOR(t);
unsigned short path[32];
char buffer[DIMREASONBUFFER];
switch(f)
{ case SQRT:
err = completesquare1_aux(ARG(0,t),&x,&y,&p,&q);
if(err)
return 1;
path[0] = SQRT;
path[1] = 1;
pathncopy(path+2,30,get_pathtail());
break;
case '^':
power = ARG(1,t);
if(!FRACTION(power) || !equals(ARG(1,power),two))
return 1;
err = completesquare1_aux(ARG(0,t),&x,&y,&p,&q);
if(err)
return 1;
path[0] = '^';
path[1] = 1;
pathncopy(path+2,30,get_pathtail());
break;
case '/':
num = ARG(0,t);
denom = ARG(1,t);
if(FUNCTOR(denom) == '^')
denom = ARG(0,denom);
err = completesquare1_aux(denom,&x,&y,&p,&q);
if(err)
return 1;
path[0] = '/';
path[1] = 2;
pathncopy(path+2,30,get_pathtail());
break;
case '+':
completesquare1_aux(t,&x,&y,&p,&q);
path[0] = 0;
break;
default:
return 1;
}
if(FUNCTOR(p) != '+' || ARITY(p) != 3)
return 1;
if(
(NEGATIVE(ARG(1,p)) && !NEGATIVE(ARG(0,p))) ||
(NEGATIVE(ARG(0,p)) && !NEGATIVE(ARG(1,p)))
)
err = factorsquareofdif(p,zero,&pp,buffer);
else
err = factorsquareofsum(p,zero,&pp,buffer);
if(err)
{ /* example: x^2 - 2sqrt x + 2 */
err = purefactor(p,&pp);
if(err)
return 1;
}
set_pathtail(path); /* after all possibility of failure has passed */
denom = sum(pp,tnegate(q));
PROTECT(denom); /* otherwise it will get expanded or polyval'd back
to its original form */
HIGHLIGHT(denom);
switch(f)
{ case SQRT:
*next = sqrt1(denom);
break;
case '/':
if(FUNCTOR(ARG(1,t)) == '^')
denom = make_power(denom,ARG(1,ARG(1,t)));
*next = make_fraction(num,denom);
break;
case '^':
*next = make_power(denom,ARG(1,t));
break;
case '+':
*next = denom;
break;
default:
assert(0);
}
strcpy(reason, english(238)); /* complete the square */
return 0;
}
/*_____________________________________________________________*/
MEXPORT_TRIGCALC int absorbconstant(term t, term arg, term *next, char *reason)
/* absorb number into constant of integration */
/* actually absorbs any seminumerical term. */
{ unsigned short n;
int i,c,count,k;
term newconst;
if(FUNCTOR(t) != '+')
return 1;
n = ARITY(t);
for(c=0;c<n;c++)
{ if(FUNCTOR(ARG(c,t)) == CONSTANTOFINTEGRATION)
break;
}
if(c == n)
return 1; /* no constant of integration present */
count = 0;
for(i=0;i<n;i++)
{ if(i != c && seminumerical(ARG(i,t)))
++count;
}
if(count == 0)
return 1; /* no constant terms to absorb */
/* create a new constant of integration */
newconst = constant_of_integration(ARG(c,t),zero);
if(count == n-1)
{ *next = newconst;
HIGHLIGHT(*next);
strcpy(reason, english(1545)); /* absorb constant */
return 0;
}
*next = make_term('+',(unsigned short)(n-count));
k=0;
for(i=0;i<n;i++)
{ if(i!= c && seminumerical(ARG(i,t)))
continue;
if(i==c)
ARGREP(*next,k,newconst);
else
ARGREP(*next,k,ARG(i,t));
++k;
}
assert(k==ARITY(*next));
strcpy(reason,english(1545)); /* absorb constant */
HIGHLIGHT(ARG(c,*next));
return 0;
}
/*__________________________________________________________________*/
static int completesquare1_aux( term left, term *x, term *y, term *ans, term *addthis)
/* return zero if left is a quadratic in *x and *y, and you add 'addthis' to it
to complete the square, producing *ans. All pointer variables are
outputs. */
{ term a,b,c,newconst,oldconst,ysq,temp;
if(FUNCTOR(left) != '+' || !contains(left,'^'))
return 1; /* reject it fast */
if(ARITY(left)==2) /* ax^2 + bx maybe */
{ if(seminumerical(ARG(1,left)) || seminumerical(ARG(0,left)))
{ errbuf(0, english(2223)); /* Completing the square requires a nonconstant linear term */
return 1;
}
temp = sum(left,one);
if(!isquadratic(temp,&a,&b,&c,x,y))
return 1;
c = sum(c,minusone);
}
else if(!isquadratic(left,&a,&b,&c,x,y))
return 1;
/* Now we're going to do it; calculate the desired constant term */
polyval( make_fraction(make_power(b,two),product(four,a)), &temp);
if(ONE(*y))
{ newconst = temp;
oldconst = c;
}
else
{ ysq = make_power(*y,two);
newconst = product(temp,ysq);
oldconst = product(c,ysq);
}
polyval(sum(newconst,tnegate(oldconst)),addthis);
temp = sum(left,*addthis);
if(!collect(temp,ans))
*ans = temp;
if(FUNCTOR(*ans) == '+')
SET_FACTORME(*ans); /* beg automode to factor it. */
return 0;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists