Sindbad~EG File Manager
/* One-step derivative calculation
M. Beeson, for Mathpert
Original date lost
10.13.92 modified
8.98 modified
1.8.00 added clauses for CASES to deriv.
2.25.00 modified deriv to handle user-defined functions
8.26.04 added "toobig" to stop simplifying before taking derivative if it creates subterms
5.5.13 added export.h
3.18.23 added two assert(0) lines about differentiating Bessel functions
7.7.24 removed all restrictions on differentiating Bessel functions
*/
#include <string.h>
#include <assert.h>
#include "globals.h"
#include "ops.h"
#include "calc.h"
#include "order.h"
#include "prover.h"
#include "deriv.h"
#include "pvalaux.h" /* square2 */
#include "mpmem.h" /* save_and_reset */
#include "binders.h"
#include "userfunc.h"
static int contains_fraction(term t, term x);
static term deriv(term u,term x);
static term ldif(term u, term x);
/*_______________________________________________________________________*/
static term interior(term t, term x)
/* if t is a proposition in x, return a term defining the interior
of the set defined by t. Example: if t is an inequality, replace
>= by > and <= by <. In general this domain will be too small,
e.g. if t is x^2 >= 0 the interior should not really omit x = 0;
but it will be correct if x occurs linearly in t, which is the usual case.
*/
{ unsigned f = FUNCTOR(t);
switch(f)
{ case '<': return t;
case '>': return t;
case LE : return lessthan(ARG(0,t),ARG(1,t));
case GE : return greaterthan(ARG(0,t),ARG(1,t));
case NE : return t;
}
return t;
}
/*_______________________________________________________________________*/
static int toobig(term t)
/* return 1 if t contains a term of arity more than 50 */
{ unsigned n,i;
if(ATOMIC(t))
return 0;
if(ARITY(t) > 50)
return 1;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(toobig(ARG(i,t)))
return 1;
}
return 0;
}
/*_______________________________________________________________________*/
term derivative(term u,term x)
/* return the derivative of u with respect to x */
/* return the answer in fresh space */
{ int savefactorflag = get_polyvalfactorflag();
int savefractexpflag = get_polyvalfractexpflag();
int savecomdenomflag = get_polyvalcomdenomflag();
int savenegexpflag = get_polyvalnegexpflag();
int savefactorflag2 = get_polyvalfactorflag2();
int savegcdflag = get_polyvalgcdflag();
int savefunctionflag = get_polyvalfunctionflag();
int savelogflag = get_polyvallogflag();
void *savenode = heapmax();
term temp,ans;
set_polyvalfactorflag(0); /* turn off content-factoring in polyval; otherwise
x^2 + x^3 differentiates to x(2 + 3x), and similarly when a product
is differentiated the result sum will be content-factored. */
set_polyvalfractexpflag(0); /* don't convert sqrt to x^(1/2) */
set_polyvalnegexpflag(0);
set_polyvalcomdenomflag(0);
set_polyvalfactorflag2(0);
set_polyvalgcdflag(1);
set_polyvalfunctionflag(1);
set_polyvallogflag(1);
polyval(u,&temp);
if(toobig(temp))
temp = u; // forget about "simplifying" if it creates sums
save_and_reset(temp,savenode,&u);
ans = deriv(u,x);
set_polyvalfactorflag(savefactorflag);
set_polyvalfractexpflag(savefractexpflag);
set_polyvalcomdenomflag(savecomdenomflag);
set_polyvalfactorflag2(savefactorflag2);
set_polyvalnegexpflag(savenegexpflag);
set_polyvalgcdflag(savegcdflag);
set_polyvalfunctionflag(savefunctionflag);
set_polyvallogflag(savelogflag);
save_and_reset(ans,savenode,&ans);
return ans;
}
/*________________________________________________________________________*/
static term deriv(term u,term x)
/* return du/dx, assuming polyval flags are appropriately set */
/* This function may make assumptions about variables other than x, but
it may not make any assumptions involving x, because such assumptions will
screw up singularity calculations that take place after deriv has been
called. This concern only arises when differentiating ABSFUNCTOR; the computed
derivative may be undefined at some values. */
{ term temp,temp2,ans,q,p,qprime,pprime,w,v;
unsigned short n;
unsigned short i,j,k;
assert(ISATOM(x));
start: /* for tail recursion */
if(ISATOM(u))
{ if(equals(u,x))
return one;
if(depends(u,x))
{ copy(diff(u,x),&ans);
return ans;
}
else
return zero;
}
if(OBJECT(u))
return zero;
w = ARG(0,u);
switch(FUNCTOR(u))
{ case '+' :
n = ARITY(u);
temp = make_term('+',n);
for(i=0;i<n;i++)
ARGREP(temp,i,deriv(ARG(i,u),x));
break;
case SUM :
{ varinf *varinfo = get_varinfo();
term savelocus;
int savej;
setlocus(ARG(1,u),&savelocus,&savej,u); /* automode.c */
fillbinders(u);
/* make assumptions that the index variable lies between
the lower and upper limit, needed to support
any deductions to be made while taking the derivative,
such as that an exponent isn't zero */
temp = make_term(SUM,4);
ARGREP(temp,0,deriv(w,x));
for(i=1;i<4;i++)
copy(ARG(i,u),ARGPTR(temp)+i);
varinfo[savej].locus = savelocus;
releasebinders(); /* discharge those assumptions */
break;
}
case '*' :
n = ARITY(u);
temp = make_term('+',n);
k=0;
for(i=0;i<n;i++)
{ if(depends(ARG(i,u),x))
{ temp2 = make_term('*',n);
for(j=0;j<n;j++)
{ if(j!=i)
copy(ARG(j,u),ARGPTR(temp2)+j);
else
ARGREP(temp2,j,deriv(ARG(i,u),x));
}
ARGREP(temp,k,temp2);
++k;
}
}
if(k==0)
{ RELEASE(temp);
return zero;
}
if(k==1)
{ temp2 = ARG(0,temp);
RELEASE(temp);
temp = temp2;
polyval(temp,&ans);
destroy_term(temp);
return ans;
}
SETFUNCTOR(temp,'+',k);
polyval(temp,&ans);
destroy_term(temp); /* entirely constructed above */
return ans;
case '^':
p = w;
q = ARG(1,u);
if(!depends(q,x))
{ /* derivative of p^q is p^(q-1) dp/dx provided q isn't zero */
if(NUMBER(q) || !check1(ne(zero,q)))
{ polyval(sum(q,minusone),&temp);
if(equals(p,x))
temp = product(q,make_power(p,temp));
else
{ copy(make_power(p,temp),&v); /* avoid DAGs */
temp = product3(q,v,deriv(p,x));
}
}
else
temp = zero; /* q is zero */
}
else if(equals(p,eulere))
temp = product(u,deriv(q,x));
else if (!depends(p,x))
temp = product3(ln1(p),u,deriv(q,x));
else
/* temp = deriv(make_power(eulere,product(q,ln1(p))),x) =
product(u,deriv(product(q,ln1(p)),x)) = */
temp = product(u,sum(product(deriv(q,x),ln1(p)), make_fraction(product(q,deriv(p,x)),p)));
break;
case '/':
p = w;
q = ARG(1,u);
if(!depends(q,x)) /* then (p/q)' = (p'/q) */
{ pprime = deriv(p,x);
if(contains_fraction(pprime,x) || contains(pprime,DIFF))
/* avoid creating compound fractions */
temp = product(reciprocal(q),pprime);
else
temp = make_fraction(pprime,q);
}
else if(!depends(p,x)) /* then (p/q)' = -pq'/(q y^2) */
{ qprime = deriv(q,x);
if(contains_fraction(qprime,x) || contains(qprime,DIFF))
/* avoid creating compound fractions */
temp = tnegate(product3(p,qprime, reciprocal(make_power(q,two))));
else
temp = tnegate(make_fraction(product(p,qprime),make_power(q,two)));
}
else if(FUNCTOR(p) == '*' || FUNCTOR(q) == '*')
temp = ldif(u,x);
else
temp = make_fraction(
sum(product(q,deriv(p,x)),tnegate(product(p,deriv(q,x)))),
make_power(q,two)
);
break;
case '-' :
temp = tnegate(deriv(w,x));
break;
case ACOS:
temp = tnegate(make_fraction(deriv(w,x),sqrt1(sum(one,tnegate(make_power(w,two))))));
break;
case ACOT:
temp = tnegate(make_fraction(deriv(w,x),sum(make_power(w,two),one)));
break;
case ACSC:
temp = tnegate(make_fraction(deriv(w,x),product(w,sqrt1(sum(make_power(w,two),minusone)))));
break;
case ASEC:
temp = make_fraction(deriv(w,x),product(w,sqrt1(sum(make_power(w,two),minusone))));
break;
case ASIN:
temp = make_fraction(deriv(w,x),sqrt1(sum(one,tnegate(make_power(w,two)))));
break;
case ATAN:
temp = make_fraction(deriv(w,x),sum(make_power(w,two),one));
break;
/*The following rule embodies a not-quite trivial theorem:
|u| is differentiable if and only if u is differentiable and
either u !=0 or du/dx = 0. The right-to-left direction is clear;
the left-to-right direction is clear if du/dx exists, so the tricky
question is whether du/dx has to exist if (d/dx) |u| does and u=0.
This is easily established.
Note, however, that the derivative of |u| is not necessarily continuous:
Example of a function in MATHPERT that is differentiable at origin
but not C1: u = |x^2 sin(1/x)|, whose derivative is
sgn(x^2 sin(1/x)) (2x sin(1/x) - cos(1/x)), which jumps from -1 to 1
infinitely many times as x-> 0.
Oops, this function isn't defined at 0, so it's not differentiable
there. You have to use "cases" to get it defined at 0.
*/
case ABSFUNCTOR:
temp2 = deriv(w,x);
temp = product(make_fraction(w, abs1(w)),temp2);
/* this expression is undefined at places where abs(w) is not differentiable;
note however that abs(u) can be differentiable where u is zero, if u has a
second-order zero, as in abs(x^2) or abs(x^3). */
/* check1(or(nonzero(w), equation(zero,temp2))); deleted to comply with the no-assumptions spec */
break;
case COS:
temp = tnegate(product(sin1(w),deriv(w,x)));
break;
case CSC:
temp = tnegate(product3(csc1(w),cot1(w),deriv(w,x)));
break;
case COT:
temp = tnegate(product(make_power(csc1(w),two),deriv(w,x)));
break;
case GAMMA:
temp = product3(gamma1(w),digamma1(w),deriv(w,x));
break;
case DIGAMMA:
temp = product(polygamma1(one,w),deriv(w,x));
break;
case POLYGAMMA:
temp = product(polygamma1(sum(w,one),ARG(1,u)),deriv(ARG(1,u),x));
break; // assuming that the 0th arg of POLYGAMMA is an integer, hence doesn't depend on x
case LN:
if(equals(w,x))
temp = make_fraction(one,x);
else if(FUNCTOR(w) == ABSFUNCTOR)
temp = make_fraction(deriv(ARG(0,w),x),ARG(0,w));
else if(FUNCTOR(w) == COS)
{ /* d/dx ln(cos x) = - tan x */
if(equals(ARG(0,w),x))
temp = tnegate(tan1(x));
else
temp = tnegate(product(deriv(ARG(0,w),x),tan1(ARG(0,w))));
}
else if(FUNCTOR(w) == SIN)
{ /* d/dx ln(sin x) = cot x */
if(equals(ARG(0,w),x))
temp = cot1(x);
else
temp = product(deriv(ARG(0,w),x),cot1(ARG(0,w)));
}
else if(FUNCTOR(w) == SINH)
{ /* d/dx ln(sinh x) = coth x */
if(equals(ARG(0,w),x))
temp = coth1(x);
else
temp = product(deriv(ARG(0,w),x),coth1(ARG(0,w)));
}
else if(FUNCTOR(w) == COSH)
{ /* d/dx ln(cosh x) = tanh x */
if(equals(ARG(0,w),x))
temp = tanh1(x);
else
temp = product(deriv(ARG(0,w),x),tanh1(ARG(0,w)));
}
else
temp = make_fraction(deriv(w,x),w);
break;
case LOG:
if(equals(w,x))
temp = make_fraction(deriv(w,x),ln1(ten));
else if(FUNCTOR(w) == ABSFUNCTOR)
temp = make_fraction(deriv(ARG(0,w),x),ARG(0,w));
else
temp = make_fraction(deriv(w,x),product(ln1(ten),w));
break;
case SEC:
temp = product3(sec1(w),tan1(w),deriv(w,x));
break;
case SIN:
temp = product(cos1(w),deriv(w,x));
break;
case SQRT:
temp = make_fraction(deriv(w,x),product(two,u));
break;
case TAN:
temp = product(make_power(sec1(w),two),deriv(w,x));
break;
case SINH:
temp = product(cosh1(w),deriv(w,x));
break;
case COSH:
temp = product(sinh1(w),deriv(w,x));
break;
case TANH:
temp = make_power(sech1(w),two);
temp = signedproduct(temp,deriv(w,x));
break;
case ROOT:
u = make_power(ARG(1,u),reciprocal(w));
goto start;
case LOGB:
u = make_fraction(ln1(ARG(1,u)),ln1(w));
goto start;
case BESSELI:
if(ZERO(w))
temp = tnegate(besseli(one,ARG(1,u)));
else
temp = sum(besseli(sum(w,minusone),ARG(1,u)),
tnegate(product(make_fraction(w,ARG(1,u)),besseli(w,ARG(1,u)))));
temp = signedproduct(temp, deriv(ARG(1,u),x));
break;
case BESSELY:
if(ZERO(w))
temp = tnegate(bessely(one,ARG(1,u)));
else
temp = sum(bessely(sum(w,minusone),ARG(1,u)),
tnegate(product(make_fraction(w,ARG(1,u)),bessely(w,ARG(1,u))))
);
temp = signedproduct(temp,deriv(ARG(1,u),x));
break;
case BESSELJ:
if(ZERO(w))
temp = tnegate(besselj(one,ARG(1,u)));
else
temp = sum(besselj(sum(w,minusone),ARG(1,u)),
tnegate(product(make_fraction(w,ARG(1,u)),besselj(w,ARG(1,u))))
);
temp = signedproduct(temp,deriv(ARG(1,u),x));
break;
case BESSELK:
if(ZERO(w))
temp = tnegate(besselk(one,ARG(1,u)));
else
temp = sum(tnegate(besselk(sum(w,minusone),ARG(1,u))),
tnegate(product(make_fraction(w,ARG(1,u)),besselk(w,ARG(1,u))))
);
temp = signedproduct(temp,deriv(ARG(1,u),x));
break;
case MATRIX: /* fall through */
case VECTOR:
n = ARITY(u);
ans = make_term(FUNCTOR(u),n);
for(i=0;i<n;i++)
ARGREP(ans,i, deriv(ARG(i,u),x));
return ans; /* no need to send it through polyval */
case CSCH:
temp = tnegate(product(csch1(w),coth1(w)));
temp = signedproduct(temp,deriv(w,x));
break;
case SECH:
temp = tnegate(product(sech1(w),tanh1(w)));
temp = signedproduct(temp,deriv(w,x));
break;
case COTH:
temp = tnegate(make_power(csch1(w),two));
temp = signedproduct(temp,deriv(w,x));
break;
case ASINH:
temp = reciprocal(sqrt1(sum(one, make_power(w,two))));
temp = signedproduct(temp,deriv(w,x));
break;
case ACOSH:
temp = reciprocal(sqrt1(sum(make_power(w,two),minusone)));
temp = signedproduct(temp,deriv(w,x));
break;
case ACOTH: /* fall-through; these functions have the
same derivative but different domains */
case ATANH:
temp = reciprocal(sum(one,tnegate(make_power(w,two))));
temp = signedproduct(temp,deriv(w,x));
break;
case ACSCH:
if(!get_complex())
temp = tnegate(make_fraction(deriv(w,x),product(abs1(w),sqrt1(sum(one,make_power(w,two))))));
else
{ q = make_fraction(deriv(w,x),product(w,sum(one,make_power(w,two))));
temp = cases2(
if1(lessthan(zero,re(w)),tnegate(q)),
if1(lessthan(re(w),zero),q)
);
}
break;
case ASECH:
if(!get_complex())
temp = tnegate(make_fraction(deriv(w,x),product(abs1(w),sqrt1(sum(one,tnegate(make_power(w,two)))))));
else
{ q = make_fraction(deriv(w,x),product(w,sum(one,tnegate(make_power(w,two)))));
temp = cases2(
if1(lessthan(zero,re(w)),tnegate(q)),
if1(lessthan(re(w),zero),q)
);
}
break;
case ERF:
temp = product(make_fraction(two,sqrt1(pi_term)),make_power(eulere, tnegate(make_power(w,two))));
temp = product(temp, deriv(w,x));
break;
case ERFC:
temp = tnegate(deriv(erf1(w),x));
break;
case COSINTEGRAL:
temp = product(make_fraction(two,sqrt1(pi_term)),cos1(make_power(w,two)));
temp = product(temp, deriv(w,x));
break;
case SININTEGRAL:
temp = product(make_fraction(two,sqrt1(pi_term)),sin1(make_power(w,two)));
temp = product(temp, deriv(w,x));
break;
# if 0
case LOGINTEGRAL: /* FINISH THIS */
case EXPINTEGRALI:
case BETAFUNCTION:
case INCOMPLETEBETA:
case EXPINTEGRALE:
case INCOMPLETEGAMMA:
case INCOMPLETEGAMMAP:
case COMPLETE_ELLIPTIC1:
case COMPLETE_ELLIPTIC2:
case COMPLETE_ELLIPTIC3:
case ELLIPTICF:
case ELLIPTICE:
case ELLIPTICPI:
case RIEMANNZETA:
case WEIERSTRASSP:
break;
# endif
case INTEGRAL:
/* use the fundamental theorem and chain rule
to differentiate definite integrals */
if(ARITY(u)==4)
{ term v = w; /* the integrand */
term t = ARG(1,u); /* variable of integration */
term a = ARG(2,u); /* lower limit */
term b = ARG(3,u); /* upper limit */
term p,q,r,tt;
if(depends(b,x))
{ subst(b,t,v,&p);
p = product(p,deriv(b,x));
}
else
p = zero;
if(depends(a,x))
{ subst(a,t,v,&q);
q = tnegate(product(q,deriv(a,x)));
}
else
q = zero;
if(equals(t,x))
{ /* assert(0); Mathpert isn't supposed to allow the creation
of terms with a bound variable also used free. */
tt = getnewvar(t,"stxyzuv");
vaux(tt);
subst(tt,t,u,&v);
}
r = definite_integral(deriv(v,x),t,a,b);
if(depends(v,x))
{ temp = make_term('+',3);
ARGREP(temp,0,p);
ARGREP(temp,1,q);
ARGREP(temp,2,r);
}
else
temp = sum(p,q);
}
else /* indefinite integral, just differentiate the integrand */
{ if(equals(x,w))
assert(0);
/* Mathpert should not allow the creation of diff(integral(v,x),x) */
temp = integral(deriv(w,x),ARG(1,u));
}
break;
case PR:
q = make_term(PR,2);
ARGREP(q,1,sum(ARG(1,u),one));
ARGREP(q,0,w);
temp = product(q,deriv(w,x));
break;
case DIFF:
if(ARITY(u)==2)
{ temp = product(diff3(w,ARG(1,u),two),deriv(ARG(1,u),x));
break;
}
temp = product(diff3(w,ARG(1,u),sum(ARG(2,u),one)),deriv(ARG(1,u),x));
/* polyval will evaluate the sum when it's called below*/
break;
case CASES: /* cases(if(a,b), if(c,d),..., if(u,v)) or
cases(if(a,b),...,v) (last argument not an IF term) */
/* The derivative is only defined on the OPEN intervals defined
by the if clauses
*/
n = ARITY(u);
ans = make_term(CASES,n);
k = 0;
for(i=0;i<n;i++)
{ w = ARG(i,u);
if(FUNCTOR(w) == IF)
{ if(FUNCTOR(ARG(0,w)) != '=')
{ v = if1(interior(ARG(0,w),x),deriv(ARG(1,w),x));
ARGREP(ans,k,v);
++k;
}
}
else if(i == n-1)
{ v = deriv(w,x);
ARGREP(ans,k,v);
++k;
}
else
assert(0);
}
if(k > 0)
{ SETFUNCTOR(ans,CASES,k);
return ans; /* not break; no need to call polyval on this */
}
else
{ RELEASE(ans);
return falseterm;
}
default :
/* Is this a user-defined function? */
{ int index = is_defined(FUNCTOR(u));
term lhs, rhs, drhs,w,v;
if(index < 0)
{ /* it isn't user-defined */
goto out;
}
get_definition(index,&lhs,&rhs);
if(ARITY(u) == 1 && ARITY(lhs) == 1)
{ w = ARG(0,lhs);
drhs = deriv(rhs,w);
subst(ARG(0,u),w,drhs,&v);
if(equals(ARG(0,u),x))
return v;
return product(v,deriv(ARG(0,u),x));
}
goto out;
}
}
polyval(temp,&ans);
return ans;
out:
copy(diff(u,x),&ans);
return ans;
}
/*_______________________________________________________________________*/
term hiderivative(term u,term n,term x)
/* return the n-th derivative of u with respect to x */
/* presumes n is an INTEGER */
/* return the answer in fresh space */
{ long k,i;
term a,b;
assert(ISINTEGER(n));
k = INTDATA(n);
a = u;
b = zero; /* just to avoid a compiler warning about possible use before defn */
for(i=0;i<k;i++)
{ if(i&1)
{ a = derivative(b,x);
destroy_term(b);
}
else
{ b = derivative(a,x);
if(i>0)
destroy_term(a);
}
}
return (k&1 ? b : a);
}
/*______________________________________________________________*/
static int contains_fraction(term t, term x)
/* does t contain a fraction that contains (the atom) x
in a monomial or fraction of
monomials at top level? If so return 1, if not return 0.
Note that t is allowed to contain f also in deeper places--
it doesn't mean t contains f ONLY monomially.
When f == '^', we are looking for NONCONSTANT powers.
Don't count a SQRT or ROOT inside a power. */
{ unsigned n = ARITY(t);
unsigned g = FUNCTOR(t);
unsigned i;
if(ATOMIC(t))
return 0;
if(g == '/') /* and f != '^' */
return contains(t,FUNCTOR(x));
if(g == '^')
{ if(contains(ARG(1,t),FUNCTOR(x)))
return 0;
return contains_fraction(ARG(0,t),x);
}
if(g == '*' || g == '-' )
{ for(i=0;i<n;i++)
{ if(contains_fraction(ARG(i,t),x))
return 1;
}
}
return 0; /* when other functors are encountered */
}
/*______________________________________________________________________*/
static int fraction_depth(term u, term x)
/* return the maximum depth of nested fractions in u containing x,
so 1/2 has depth 0 but 1/x has depth 1.
*/
{ unsigned short n;
int i,a,b;
if(ATOMIC(u))
return 0;
n = ARITY(u);
if(FRACTION(u))
{ a = fraction_depth(ARG(0,u),x);
b = fraction_depth(ARG(1,u),x);
if(!a)
/* numerator does not contain x in a fraction. It may or
may not contain x otherwise */
{ if(b)
return 1+b;
return contains(u,FUNCTOR(x)) ? 1 : 0;
}
if(!b)
{ if(a)
return 1+a;
return contains(u,FUNCTOR(x)) ? 1 : 0;
}
if(a < b)
return 1+b;
return 1+a;
}
a = 0;
for(i=0;i<n;i++)
{ b = fraction_depth(ARG(i,u),x);
if(b > a)
a = b;
}
return a;
}
/*______________________________________________________________________*/
static long maxexp(term t, term x)
/* return the maximum integer exponent of a subterm of t containing x.
Ignore non-integer exponents including bignum exponents.
*/
{ long ans, k, p;
unsigned short n;
int i;
if(ATOMIC(t))
return 0;
if(FUNCTOR(t) == '^' && ISINTEGER(ARG(1,t)))
{ if(!contains(ARG(0,t),FUNCTOR(x)))
return 0;
k = maxexp(ARG(0,t),x);
p = INTDATA(ARG(1,t));
return k < p ? p : k;
}
ans = 0;
n = ARITY(t);
for(i=0;i<n;i++)
{ k = maxexp(ARG(i,t),x);
if(k > ans)
ans = k;
}
return ans;
}
/*______________________________________________________________________*/
int simplify_before_diff(term u, term x)
/* return 1 if u should be simplified before differentiating it
with respect to x. Return 0 otherwise. At present this is
implemented as follows:
If u contains compound fractions and no exponents higher than 3
return 1, else return 0.
*/
{ if(fraction_depth(u,x) > 1 && maxexp(u,x) <= 3)
return 1;
return 0;
}
/*______________________________________________________________________*/
static term ldif(term u, term x)
/* u is a fraction, whose num or denom (or both) are products.
Use logarithmic differentiation to compute the derivative with respect
to x. The formula is, u' = sum of terms uv'/v where the v range over
all factors of numerator or denominator, those from the denom getting
a minus sign. The actual result should be computed carefully so the
factor v is cancelled from u rather than present in both num and
denom. Polyval is not called on the result as it will be in deriv.
*/
{ int i,j,k;
term num,denom,ans,a,p,q,v;
unsigned short n,m;
if(!FRACTION(u))
assert(0);
num = ARG(0,u);
denom = ARG(1,u);
m = FUNCTOR(num) == '*' ? ARITY(num) : 1;
n = FUNCTOR(denom)== '*' ? ARITY(denom) : 1;
if(m == 1)
{ /* u = num/ab..
u' = -a'num/(a^2b) - b'num/(ab^2) - ... + num'/ab
*/
ans = make_term('+',(unsigned short)(n+1));
k = 0;
for(i=0;i<n;i++)
{ copy(ARG(i,denom),&a);
if(!depends(a,x))
continue;
p = deriv(a,x);
q = make_term('*',n);
for(j=0;j<n;j++)
ARGREP(q,j, j==i ? square2(a) : ARG(j,denom));
ARGREP(ans,k,tnegate(make_fraction(product(num,p),q)));
++k;
}
if(depends(num,x))
{ ARGREP(ans,k,make_fraction(deriv(num,x),denom));
++k;
}
goto out;
}
if(n == 1)
{ /* u = ab/denom
u' = a'b/denom + ab'/denom + ... - denom'ab/denom^2
*/
ans = make_term('+',(unsigned short)(m+1));
k = 0;
for(i=0;i<m;i++)
{ a = ARG(i,num);
if(!depends(a,x))
continue;
if(equals(a,x))
{ if(m == 2)
q = ARG(i ? 0 : 1, num);
else
{ q = make_term('*',(unsigned short)(m-1));
for(j=0;j<m-1;j++)
ARGREP(q,j,j<i? ARG(j,num) : ARG(j+1,num));
}
}
else
{ q = make_term('*',m);
for(j=0;j<m;j++)
ARGREP(q,j,j==i ? deriv(a,x) : ARG(j,num));
}
ARGREP(ans,k,make_fraction(q,denom));
++k;
}
if(depends(denom,x))
{ ARGREP(ans,k,tnegate(make_fraction(product(deriv(denom,x),num),square2(denom))));
++k;
}
goto out;
}
/* Now both num and denom are products */
ans = make_term('+',(unsigned short)(n+m));
k = 0;
for(i=0;i<m;i++)
{ a = ARG(i,num);
if(!depends(a,x))
continue;
if(equals(a,x))
{ if(m == 2)
p = ARG(i ? 0 : 1, num);
else
{ p = make_term('*',(unsigned short)(m-1));
for(j=0;j<m-1;j++)
ARGREP(p,j,j<i? ARG(j,num) : ARG(j+1,num));
}
}
else
{ p = make_term('*',m);
for(j=0;j<m;j++)
ARGREP(p,j,j==i ? deriv(a,x) : ARG(j,num));
}
ARGREP(ans,k,make_fraction(p,denom));
++k;
}
for(i=0;i<n;i++)
{ a = ARG(i,denom);
if(!depends(a,x))
continue;
p = make_term('*',n);
for(j=0;j<n;j++)
ARGREP(p,j,j==i ? square2(a) : ARG(j,denom));
ARGREP(ans,k,tnegate(make_fraction(product(deriv(a,x),num),p)));
++k;
}
out:
if(k==0)
{ RELEASE(ans);
return zero;
}
if(k==1)
{ v = ARG(0,ans);
RELEASE(ans);
return v;
}
SETFUNCTOR(ans,'+',k);
return ans;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists