Sindbad~EG File Manager
/* Calculate the conditions for an expression to be defined.
M. Beeson, for Mathpert
Original date 2.1.92
def_aux_diff modified 11.13.99
1.2.00 removed second occurrence of ABSFUNCTOR in def_aux_diff as superfluous.
6.24.04 added calls to lpt in defined2 for LN and SQRT
7.14.05 added code for NOT at line 430 in def_aux
7.20.05 corrected a typo at the end of reduced_and4
8.24.07 modified defined3 for POLYGAMMA
added code to def_aux_diff for DIGAMMA and POLYGAMMA
9.4.07 changed def_aux2 to defined_on_interval, moved make_true into this file
and then deleted it and the code that called it, see maketrue.jnk
9.6.07 moved DefIntegralDomain into this file, and finished defined_on_interval
and defined_on_interval2.
9.6.07 corrected interval_form, which had the wrong return value if passed an interval.
9.6.07 made interior take a second argument and added it to the calls,
and made it use that argument correctly; wrote join and joins
9.8.07 corrected last lines of join.
9.9.07 added implies2 and zeromodpi and code that calls implies2
10.2.09 added the AND case to defined_on_interval2 at line 747
5.15.13 added a case for BERNOULLI in defined2.
6.5.13 added a case for RIEMANNZETA in defined 2
corrected the case for ASINH in defined2.
1.29.25 modified first_difference
*/
/* Note, we DON'T put the expression through polyval first, because some
assumptions are lost when compound fractions are simplified and cancellation
is done. */
#include <assert.h>
#include <stdlib.h>
#include "globals.h"
#include "prover.h"
#include "dcomplex.h"
#include "cancel.h"
#include "ceval.h"
#include "deval.h"
#include "deriv.h"
#include "order.h"
#include "eqn.h"
#include "domain.h"
#include "algaux.h"
#include "trigdom.h"
#include "trigpoly.h"
#include "trig.h"
#include "mplimits.h"
#include "userfunc.h"
#include "pvalaux.h" /* entire */
#include "binders.h" /* binders_interval */
#include "invineq.h" /* invert_ineq */
#include "domexp.h" /* domexp */
#include <stdio.h> /* DEBUG */
#include "pstring.h" /* DEBUG only */
static term def_aux(term);
static term def_aux_diff(term,term);
static term def_aux_hidiff(term,term,term);
static term belongs(term u, term interval, term x);
static int interval_form(term mid, term x, term *ans);
static int evalbar2(term, term *);
static term interior(term p, term x);
static term defined_on_interval2(term v, term x, term lo, term hi);
static term positive_on_interval(term v, term x, term lo, term hi);
/*___________________________________________________________________*/
term domain_aux(term u)
/* calculate the domain of a term u whose functor involves a binding
operator, arctrig, hyperbolic, or special function; in general all
functions whose functor isn't trapped in fastdom_aux get their domains
calculated by domain_aux. */
{ unsigned short g = FUNCTOR(u);
term v,mid,ans;
unsigned short n = ARITY(u);
assert(!ATOMIC(u));
if(g==PR) /* u is PR(v,n), meaning v with n primes after */
{ assert(ISINTEGER(ARG(1,u)));
v = domain(ARG(0,u));
if(INTDATA(ARG(1,u))==1) /* u is v' */
return def_aux_diff(ARG(0,u),get_eigenvariable());
/* Now it's a second-or-higher-order derivative */
return def_aux_hidiff(ARG(0,u),ARG(1,u),get_eigenvariable());
}
if(g==LIMIT) /* two-sided or one-sided limits */
{ limval(u,&mid); /* calculate simple limits directly */
if(FUNCTOR(mid) != LIMIT) /* successful calculation */
return domain(mid);
/* can't calculate limit; simplify the limitand and
return a 'defined' term */
polyval(LIMITAND(u),&v);
mid = n==2 ? limit(ARG(0,u),v) : limit3(ARG(0,u),ARG(1,u),v);
ans = defined(mid);
SET_ALREADY(ans); /* don't process it with lpt again */
return ans;
}
if (g==DIFF && n==2)
return def_aux_diff(ARG(0,u),ARG(1,u)); /* see this for explanation */
if (g==DIFF) /* and n > 2, a high-diff */
return def_aux_hidiff(ARG(0,u),ARG(2,u),ARG(1,u)); /* see this for explanation */
if(( g==INTEGRAL && n==4) || g == SUM || g == PRODUCT)
{ term lo = ARG(2,u);
term hi = ARG(3,u);
if(equals(hi,infinity) || equals(lo,minusinfinity) || equals(hi,minusinfinity) || equals(lo,infinity))
/* an improper sum or integral */
{ ans = defined(u);
PROTECT(ans);
SET_ALREADY(ans);
return ans; /* FINISH THIS */
}
return defined_on_interval(ARG(0,u),ARG(1,u),ARG(2,u),ARG(3,u));
}
if(g == EVAL) /* this can arise from update_assumptions if a
definite integral's domain couldn't be calculated
and it is subsequently evaluated */
{ term temp;
int err = evalbar2(u,&temp);
if(!err)
return domain(temp);
}
return(lpt(def_aux(u)));
}
/*_______________________________________________________________________*/
static term def_aux_diff(term y, term x)
/* Called in order to find conditions for diff(y,x) to be defined. That is,
where y and its derivative are both defined. Note that, for example, the
derivative of ln x is 1/x, which is defined in places where ln x is not.
This is supposed to be equivalent to and(domain(y),domain(derivative(y,x)),
but easier to compute. The result has already been passed through lpt so it won't
help to pass it through lpt again.
In certain cases (involving ABSFUNCTOR, SG, CASES) the result may be a subset
of the true domain, e.g. abs(sqrt(x))^3 is in reality differentiable at
origin but this will return x > 0. The result will be some unnecessary
assumptions. Hopefully this is unimportant.
*/
{ unsigned short f;
int i,err;
unsigned short n,k;
double z;
term base,power,ans,temp,u,v,p,q;
if(NEGATIVE(y))
y = ARG(0,y);
f = FUNCTOR(y);
if(OBJECT(y))
return trueterm;
if(ISATOM(y) && (!depends(y,x) || equals(y,x)))
return trueterm;
if(f == ABSFUNCTOR)
{ if(FUNCTOR(ARG(0,y)) == '^' && entire(ARG(0,ARG(0,y))) && seminumerical(ARG(1,ARG(0,y))))
{ double z;
deval(ARG(1,ARG(0,y)),&z);
if(z != BADVAL && z > 1.0)
return trueterm; /* abs(x^(3/2)) is differentiable for example */
}
return lpt(reduced_and(ne(ARG(0,y),zero),def_aux_diff(ARG(0,y),x)));
}
if(entire(y) && !contains_defined_variables(y))
return trueterm;
if (ATOMIC(y)) /* and y was introduced by a let_defn */
{ if(is_letdefined(y,&temp))
return def_aux_diff(temp,x);
else /* y may have been introduced e.g. in implicit diff and
declared by the user to depend on x. Then we assume it
does so differentiably */
return trueterm;
/* whether this assumption is always justified I'm not sure */
}
if (!PREDEFINED_FUNCTOR(f)) /* user-defined */
{ i = is_defined(f);
if(i>=0)
{ apply_definition(y,&v);
return def_aux_diff(v,x);
}
ans = defined(diff(y,x));
SET_ALREADY(ans);
/* don't process by lpt, nothing but loops will come of it */
return ans;
}
if (f == '^' || f == SQRT || f == ROOT)
{ switch(f)
{ case '^':
base = ARG(0,y);
power = ARG(1,y);
break;
case SQRT:
base = ARG(0,y);
power = reciprocal(two);
break;
case ROOT:
base = ARG(1,y);
power = reciprocal(ARG(0,y));
break;
}
if(f != SQRT && depends(power,x))
{ ans = make_term(AND,4);
ARGREP(ans,0,get_complex() ? nonzero(base) : positive(base));
ARGREP(ans,1,def_aux_diff(base,x));
ARGREP(ans,2,def_aux_diff(power,x));
ARGREP(ans,3,domain(power));
return lpt(ans);
}
/* Now power is constant */
if(INTEGERP(power)) /* common case */
return def_aux_diff(base,x);
/* Now, the question is whether the power is more or less than 1 */
if(seminumerical(power))
{ deval(power,&z);
if(z != BADVAL && z > 1.0 - VERYSMALL)
return def_aux_diff(base,x);
if(NEGATIVE(power) && RATIONALP(ARG(0,power)))
power = ARG(0,power);
if(z != BADVAL && RATIONALP(power) && ISODD(ARG(1,power)))
return lpt(reduced_and(def_aux_diff(base,x), ne(base,zero)));
if(z != BADVAL && RATIONALP(power))
return lpt(reduced_and(def_aux_diff(base,x), lessthan(zero,base)));
}
/* Now the power is symbolic */
err = infer(le(one,power));
if(!err)
return def_aux_diff(base,x);
if(NEGATIVE(power))
power = ARG(0,power);
if(FRACTION(power) && isinteger(ARG(0,power)) &&
isinteger(ARG(1,power)) && isodd(ARG(1,power))
)
ans = and(
def_aux_diff(base,x),
or(le(one,power), ne(base,zero))
);
else
ans = and(
def_aux_diff(base,x),
or(le(one,power), lessthan(zero,base))
);
return lpt(ans);
}
if(f == SG)
{ base = ARG(0,y);
return lpt(reduced_and(def_aux_diff(base,x), ne(base,zero)));
}
if(f == CASES)
return interior(domain(derivative(y,x)),x);
if(f == LN && !get_complex())
return lpt(and(lessthan(zero,ARG(0,y)),def_aux_diff(ARG(0,y),x)));
if(f == LOGB && !get_complex())
return lpt(and(lessthan(zero,ARG(1,y)),def_aux_diff(ARG(1,y),x)));
if(ENTIRE(f))
return lpt(def_aux_diff(ARG(0,y),x));
if(UNARY(f) /* includes Bessel functions */
|| f == DIGAMMA || f == POLYGAMMA
)
return interior(domain(y),x);
if(f == '/')
{ u = ARG(0,y);
v = ARG(1,y);
if(OBJECT(u))
ans = and(def_aux_diff(v,x),nonzero(v));
else
{ p = def_aux_diff(u,x);
q = def_aux_diff(v,x);
if(equals(p,trueterm) && equals(q,trueterm))
ans = nonzero(v);
else if(equals(p,trueterm))
ans = and(q,nonzero(v));
else if(equals(q,trueterm))
ans = and(p,nonzero(v));
else
ans = and3(p,q,nonzero(v));
}
return lpt(ans);
}
if(f == '+' || f == '*')
{ k=0;
n = ARITY(y);
ans = make_term(AND,n);
for(i=0;i<n;i++)
{ temp = def_aux_diff(ARG(i,y),x);
if(equals(temp,trueterm))
continue;
if(equals(temp,falseterm))
{ RELEASE(ans);
return falseterm;
}
ARGREP(ans,k,temp);
++k;
}
if(k==0)
{ RELEASE(ans);
return trueterm;
}
if(k==1)
{ temp = ARG(0,ans);
RELEASE(ans);
return temp;
}
SETFUNCTOR(ans,AND,k);
return lpt(ans);
}
if(f == INTEGRAL && ARITY(y) == 2)
{ if(equals(x,ARG(1,y)))
return domain(y);
return interior(domain(derivative(ARG(0,y),x)),x);
}
if(f == INTEGRAL && ARITY(y) == 4)
return and(domain(derivative(y,x)), domain(y));
return interior(domain(derivative(y,x)),x);
/* binary special function ? */
}
/*_______________________________________________________________________*/
static term def_aux_hidiff(term y, term n, term x)
/* Called in order to find conditions for y and its first n derivatives with
respect to x to be defined. The result has already been passed through lpt.
*/
{ unsigned short f;
int i,err;
unsigned short nn,k;
term base,power,ans,temp,u,v;
if(NEGATIVE(y))
y = ARG(0,y);
f = FUNCTOR(y);
if(ATOMIC(y) && (!depends(y,x) || equals(y,x)))
return trueterm;
if(ATOMIC(y)) /* and y was introduced by a let_defn */
if(ATOMIC(y)) /* and y was introduced by a let_defn */
{ if(is_letdefined(y,&temp))
return def_aux_hidiff(temp,n,x);
ans = defined(diff3(y,n,x));
SET_ALREADY(ans);
return ans;
}
if(!PREDEFINED_FUNCTOR(f)) /* user-defined */
{ i = is_defined(f);
if(i>=0)
{ apply_definition(y,&v);
return def_aux_hidiff(v,n,x);
}
ans = defined(diff3(y,x,n)); /* user-introduced, undefined, function*/
SET_ALREADY(ans);
return ans;
}
if(f == ABSFUNCTOR)
{ if(FUNCTOR(ARG(0,y)) == '^' && entire(ARG(0,ARG(0,y))) && seminumerical(ARG(1,ARG(0,y))))
{ double z,nn;
deval(ARG(1,ARG(0,y)),&z);
deval(n,&nn);
if(z != BADVAL && nn != BADVAL && z > nn)
return trueterm; /* abs(x^(5/2)) is twice differentiable for example */
}
return lpt(reduced_and(ne(ARG(0,y),zero),def_aux_diff(ARG(0,y),x)));
}
if(f == '^' || f == SQRT || f == ROOT)
{ switch(f)
{ case '^':
base = ARG(0,y);
power = ARG(1,y);
break;
case SQRT:
power = reciprocal(two);
base = ARG(0,y);
break;
case ROOT:
base = ARG(1,y);
power = reciprocal(ARG(0,y));
break;
}
if(f != SQRT && depends(power,x))
{ ans = make_term(AND,4);
ARGREP(ans,0,(get_complex() ? nonzero(base) : positive(base)));
ARGREP(ans,1,def_aux_hidiff(base,n,x));
ARGREP(ans,2,def_aux_hidiff(power,n,x));
ARGREP(ans,3,domain(power));
return lpt(ans);
}
/* Now power is constant */
if(INTEGERP(power)) /* common case */
return def_aux_hidiff(base,n,x);
/* Now, the question is whether the power is more or less than n */
temp = sum(power,strongnegate(n));
if(seminumerical(temp) )
{ double z;
deval(power,&z);
if(z != BADVAL && z > - VERYSMALL)
return def_aux_hidiff(base,n,x);
if(z != BADVAL)
return lpt(reduced_and(def_aux_hidiff(base,n,x), ne(base,zero)));
}
/* Now the power is symbolic */
err = infer(le(zero,temp));
if(!err)
return def_aux_hidiff(base,n,x);
ans = and(
def_aux_hidiff(base,n,x),
or(le(one,power), ne(base,zero))
);
return lpt(ans);
}
if(f == ABSFUNCTOR || f == SG)
{ base = ARG(0,y);
return lpt(reduced_and(def_aux_hidiff(base,n,x), ne(base,zero)));
}
if(f == CASES)
return interior(domain(hiderivative(y,n,x)),x);
if(f == LN && !get_complex())
return lpt(and(lessthan(zero,ARG(0,y)),def_aux_hidiff(ARG(0,y),n,x)));
if(f == LOGB && !get_complex())
return lpt(and(lessthan(zero,ARG(1,y)),def_aux_hidiff(ARG(1,y),n,x)));
if(ENTIRE(f))
return lpt(def_aux_hidiff(ARG(0,y),n,x));
if(UNARY(f)) /* includes Bessel functions */
return interior(domain(y),x);
if(f == '/')
{ u = ARG(0,y);
v = ARG(1,y);
ans = and3(def_aux_hidiff(u,n,x), def_aux_hidiff(v,n,x), nonzero(v));
return lpt(ans);
}
if(f == '+' || f == '*')
{ nn = ARITY(y);
ans = make_term(AND,nn);
k = 0;
for(i=0;i<nn;i++)
{ temp = def_aux_hidiff(ARG(i,y),n,x);
if(equals(temp,trueterm))
continue;
if(equals(temp,falseterm))
{ RELEASE(ans);
return falseterm;
}
ARGREP(ans,k,temp);
++k;
}
if(k==0)
{ RELEASE(ans);
return trueterm;
}
if(k==1)
{ temp = ARG(0,ans);
RELEASE(ans);
return temp;
}
SETFUNCTOR(ans,AND,k);
return lpt(ans);
}
return interior(domain(hiderivative(y,n,x)),x);
}
/*_____________________________________________________________*/
static term def_aux(term u)
/* called by domain on functions not containing DIFF, INTEGRAL, etc. */
/* u is not atomic */
{ term p,q,a,b,ans,mid,num,den;
int i,err;
unsigned short k;
unsigned short g = FUNCTOR(u);
unsigned short n = ARITY(u);
assert(!ATOMIC(u));
if(mvpoly2(u))
return trueterm; /* even if there are let-definitions, because we will
have already assumed the new variable is defined */
if(g=='-' || g == NOT)
return domain(ARG(0,u));
if(g == MATRIXINVERSE)
return nonzero(det1(ARG(0,u)));
if(n==1 && PREDEFINED_FUNCTOR(g))
return defined2(g,ARG(0,u));
if(g =='*' || g == '+' || g == AND || g == OR)
{ int needsflattening = 0;
ans = make_term(AND,ARITY(u));
k=0;
for(i=0;i<ARITY(u);i++)
{ if(OBJECT(ARG(i,u)))
continue;
if(ISATOM(ARG(i,u)) && get_nextdefn() == 0)
continue;
p = domain(ARG(i,u));
if(equals(p,falseterm))
{ RELEASE(ans);
return falseterm;
}
if(!equals(p,trueterm))
{ ARGREP(ans,k,p);
++k;
}
if(FUNCTOR(p) == AND)
++needsflattening;
}
if(k==0)
{ RELEASE(ans);
return trueterm;
}
if(k==1)
{ mid = ARG(0,ans);
RELEASE(ans);
return mid;
}
SETFUNCTOR(ans,AND,k);
if(needsflattening)
ans = topflatten(ans);
drop_variants(ans,&ans);
SET_ALREADY (ans);
return ans;
}
if(g == '/')
{ /* When processing the denom, let lpt (via 'immediate')
use the assumptions that the num is defined. This should
save time in processing quotients containing trig functions,
such as (tan x + tan y)/(1+tan x tan y), and avoid
generating variants that have to be eliminated later. */
p = domain(ARG(0,u));
b = domain(ARG(1,u));
if(ISINTEGER(ARG(1,u))) /* common special case, let's speed up */
q = ZERO(ARG(1,u)) ? falseterm : trueterm;
else
q = lpt(ne(ARG(1,u),zero));
mid = lpt(reduced_and3(p,b,q));
drop_variants(mid,&mid);
SET_ALREADY(mid);
return mid;
}
if(g == '^')
{ a = ARG(0,u);
b = ARG(1,u); /* trying to get domain of a^b */
if(INTEGERP(b)) /* very common case */
return domain(a);
if(get_complex())
{ term p = reduced_and(domain(a),domain(b));
term q = reduced_or(lpt(ne(a,zero)),lpt(ne(b,zero)));
return lpt(reduced_and(p,q));
}
/* and if !complex... */
/* make sure that fractional exponents are in lowest terms */
if(FUNCTOR(b) == '/')
{ num = ARG(0,b);
den = ARG(1,b);
err = cancel(num,den,&mid,&q);
if(!err)
{ if(FUNCTOR(q) != '/')
return domain(make_power(a,q));
num = ARG(0,q);
den = ARG(1,q);
return domexp(a,make_fraction(num,den));
}
}
if(FUNCTOR(b) == '-' && FUNCTOR(ARG(0,b))=='/')
{ num = ARG(0,ARG(0,b));
den = ARG(1,ARG(0,b));
err = cancel(num,den,&mid,&q);
if(!err)
{ if(FUNCTOR(q) != '/')
return domain(make_power(a,tnegate(q)));
num = ARG(0,q);
den = ARG(1,q);
return domexp(a,tnegate(make_fraction(num,den)));
}
}
if(NEGATIVE(b) && INTEGERP(ARG(0,b)))
{ return lpt(reduced_and(domain(a),nonzero(a))); /* hopefully faster than domexp */
}
return domexp(a,b);
}
if(g== '=' || g == '<' || g == '>' || g == LE || g == GE || g == NE)
return lpt(reduced_and(domain(ARG(0,u)),domain(ARG(1,u))));
if(g == IF)
/* the domain of an IF term is the set where the condition is
true and the value is defined */
return lpt(and(ARG(0,u), domain(ARG(1,u))));
if(g == CASES)
/* similar to '+' but build an OR term instead of an AND */
/* The domain of a CASES term is the union of the domains of the cases */
{ int needsflattening = 0;
ans = make_term(OR,ARITY(u));
k=0;
for(i=0;i<ARITY(u);i++)
{ if(OBJECT(ARG(i,u)))
continue;
if(ISATOM(ARG(i,u)) && get_nextdefn() == 0)
continue;
p = domain(ARG(i,u));
if(equals(p,trueterm))
{ RELEASE(ans);
return trueterm;
}
if(!equals(p,falseterm))
{ ARGREP(ans,k,p);
++k;
}
if(FUNCTOR(p) == OR)
++needsflattening;
}
if(k==0)
{ RELEASE(ans);
return trueterm;
}
if(k==1)
{ mid = ARG(0,ans);
RELEASE(ans);
return mid;
}
SETFUNCTOR(ans,OR,k);
if(needsflattening)
ans = topflatten(ans);
drop_variants(ans,&ans);
SET_ALREADY (ans);
return ans;
}
if(g == MATRIX || g == VECTOR)
{ ans = make_term(AND,n);
k=0;
for(i=0;i<n;i++)
{ p = domain(ARG(i,u));
if(equals(p,falseterm))
{ RELEASE(ans);
return falseterm;
}
if(!equals(p,trueterm))
ARGREP(ans,i,p);
}
if(k==0)
return trueterm;
if(k==1)
{ mid = ARG(0,ans);
RELEASE(ans);
return mid;
}
return ans;
}
if(n==2 && PREDEFINED_FUNCTOR(g))
return defined3(g,ARG(0,u),ARG(1,u));
/* Now g is not a predefined functor. Is there a function
definition for it? */
i = is_defined(g);
if(i >= 0)
{ apply_definition(u,&mid);
return domain(mid);
}
ans = defined(u);
PROTECT(ans);
SET_ALREADY(ans);
return ans;
}
/*__________________________________________________________________*/
term defined_on_interval(term v, term x, term lo, term hi)
/* called by domain when u is a definite integral or an indexed sum or product.
The args of u are passed to this function. */
/* This uses the array 'binders' used by one-step and exec, instead
of assume and discharge, because (1) the binders array can be freed
and (2) it speeds up finding the standard part if there is only binders
to examine. */
/* Return value is a proposition giving the conditions for v to be defined
on { x : lo <= x <= hi }. */
/* Presumes that lo and hi are not plus or minus infinity */
/* Does not presume that lo <= hi. Sometimes, for example, lo is 0 and hi is x,
and the integrand will be defined only for x < 0, or only for x > 0, so
that should be the answer. */
{ int err, err2=1;
term ans, ans2;
short savenextassumption;
if(entire(v))
return trueterm; /* in that case there's nothing to worry about! */
savenextassumption = get_nextassumption();
err = infer(le(lo,hi));
if(err)
err2 = refute(lessthan(hi,lo));
if(!err || !err2)
{ ans = defined_on_interval2(v,x,lo,hi);
if(!equals(ans,falseterm))
{ if(get_nextassumption() > savenextassumption &&
get_nextassumption() > 2
)
simplify_assumptions(and3(v,hi,lo));
return ans;
}
}
set_nextassumption(savenextassumption); /* May have assumed something in check above */
err = infer(le(hi,lo));
if(err)
err2 = refute(lessthan(lo,hi));
if(!err || !err2)
{ ans = defined_on_interval2(v,x,hi,lo);
if(!equals(ans,falseterm))
{ if(get_nextassumption() > savenextassumption &&
get_nextassumption() > 2
)
simplify_assumptions(and3(v,hi,lo));
return ans;
}
}
set_nextassumption(savenextassumption);
assume(lessthan(lo,hi));
ans = defined_on_interval2(v,x,lo,hi);
set_nextassumption(savenextassumption);
assume(lessthan(hi,lo));
ans2 = defined_on_interval2(v,x,hi,lo);
set_nextassumption(savenextassumption);
if(equals(ans,falseterm))
ans = lpt(reduced_and(le(hi,lo),ans2));
else if(!equals(ans2,falseterm))
ans = lpt(or(reduced_and(le(lo,hi),ans),reduced_and(le(hi,lo),ans2)));
/* le instead of lessthan, because we checked already that it's defined at lo and hi */
else
ans = lpt(reduced_and(le(lo,hi),ans));
if(equals(ans,falseterm))
set_nextassumption(savenextassumption);
else if(get_nextassumption() > savenextassumption &&
get_nextassumption() > 2
)
simplify_assumptions(and3(v,hi,lo));
return ans;
}
/*__________________________________________________________________*/
static term defined_on_interval2(term v, term x, term lo, term hi)
/* Like defined_on_interval, except it assumes lo <= hi. */
{ term ans,mid,temp;
int i,err,savebinderflag;
term savelocus;
int savej;
term u = definite_integral(v,x,lo,hi);
varinf *varinfo = get_varinfo();
setlocus(x,&savelocus,&savej,u);
fillbinders(u);
savebinderflag = get_lpt_binderflag();
set_lpt_binderflag(0);
mid = lpt(domain(v));
set_lpt_binderflag(savebinderflag);
varinfo[savej].locus = savelocus;
releasebinders();
unsigned f = FUNCTOR(v);
if(f == '^' && INTEGERP(ARG(1,v)))
v = ARG(0,v);
if(f == '^' && RATIONALP(ARG(1,v)) && isodd(ARG(1,ARG(1,v))))
v = ARG(0,v);
if(f == '^' && RATIONALP(ARG(1,v)) && iseven(ARG(1,ARG(1,v))))
return positive_on_interval(ARG(0,v),x,lo,hi);
if(f == '-')
v = ARG(0,v);
if(f == '/' || f == '*' || f == AND)
{ int i;
term temp = make_term(AND,ARITY(v));
for(i=0;i<ARITY(v);i++)
{ ARGREP(temp,i,defined_on_interval2(ARG(i,v),x,lo,hi));
}
return lpt(temp);
}
if(f == ROOT && isodd(ARG(0,v)))
v = ARG(1,v);
if(f == ROOT && iseven(ARG(0,v)))
return positive_on_interval(ARG(1,v),x,lo,hi);
if(f == SQRT)
return positive_on_interval(ARG(0,v),x,lo,hi);
if(!contains(mid,FUNCTOR(x))) /* as in integral(1/x,x,1,2) */
return mid;
/* Example: integral(1/x,x,a,b). When we get here we
have mid = (x != 0) with assumptions a<=x, x<=b. Now we
want to say that lo and hi belong to the same one of the
intervals making up mid. So mid should BE a disjunction
of inequalities or intervals. */
if(FUNCTOR(mid) == NE && equals(ARG(0,mid),x))
{ /* a single inequality, e.g. integral(1/(x-a),x,0,1) gets here. */
term a = ARG(1,mid);
/* return lpt(not(and(le(lo,a),le(a,hi)))); This is correct but e.g. with lo = sin x and hi = x^2 and a = zero, it does not simplify enough */
return lpt(or( lessthan(a,lo), lessthan(hi,a) ));
}
if(FUNCTOR(mid) == AND)
{ /* Example: integral( (2x - 1) / (x^2 - 4), x, -3,3)
leads to mid = and(x != -2, x != 2)
*/
int i;
term q;
for(i=0;i<ARITY(mid);i++)
{ if(FUNCTOR(ARG(i,mid)) == NE && equals(ARG(0,ARG(i,mid)),x) && !contains(ARG(1,ARG(i,mid)),FUNCTOR(x)))
{ q = ARG(1,ARG(i,mid));
err = infer(lessthan(q,lo));
if(!err) continue;
err = infer(lessthan(hi,q));
if(!err) continue;
err = infer(and(le(lo,q),le(q,hi)));
if(!err) return falseterm;
err = check1(lessthan(q,lo));
if(err)
{ err = check1(lessthan(hi,q));
if(err)
return falseterm;
}
}
}
}
err = interval_form(mid,x,&temp);
if(!err) /* could put mid in the form of an interval or union of intervals */
{ mid = temp;
if(FUNCTOR(mid) != OR) /* mid is a single interval */
{ ans = and(belongs(lo,mid,x),belongs(hi,mid,x));
return lpt(ans);
}
else /* mid is a union of intervals */
/* then both lo and hi must belong to (the same) one of those intervals */
{ ans = make_term(OR,ARITY(mid));
for(i=0;i<ARITY(mid);i++)
ARGREP(ans,i,and(belongs(lo,ARG(i,mid),x),belongs(hi,ARG(i,mid),x)));
return lpt(ans);
}
}
/* if we get here, mid could not be put in interval form */
/* Example: integral(sqrt(tan x) (sec x)^2,x,0,pi/4)
mid is now
m pi <= x < m pi+pi/2, n pi-pi/2 < x < n pi+pi/2
*/
// I'm not totally sure the following is logically correct, but it seems to work.
ans = make_term(OR,ARITY(mid));
for(i=0;i<ARITY(mid);i++)
ARGREP(ans,i,and(belongs(lo,ARG(i,mid),x),belongs(hi,ARG(i,mid),x)));
return lpt(ans);
/* utter failure: */
return falseterm; /* can't calculate the domain */
}
/*__________________________________________________________________*/
static term positive_on_interval(term v, term x, term lo, term hi)
/* return a proposition equivalent to v being >= 0 on lo <= x <= hi,
or falseterm if it can't find conditions
*/
/* Present technique works is to solve v = 0 on (lo+epsilon, hi-epsilon),
numerically; if there's no solution and v is positive at (lo+hi)/2
then return true. The solution won't be a minimum, because Brent's method
only finds crossing solutions, so if there is a solution, we can confidently
return false.
*/
{ double leftend,rightend,x0,zz;
int err;
deval(lo,&leftend);
deval(hi,&rightend);
SETVALUE(x,leftend);
err = deval(v,&zz);
if(err)
{ return falseterm; // v undefined at left endpoint
}
SETVALUE(x,rightend);
err = deval(v,&zz);
if(err)
{ return falseterm; // v undefined at right endpoint
}
double epsilon = 0.001 * (rightend-leftend);
leftend += epsilon;
rightend -= epsilon;
err = solve(v,x,leftend,rightend,&x0); /* Brent's method, see solve.c */
if(err == 1)
{ // no solution
SETVALUE(x, 0.5 * (leftend+rightend));
deval(v,&x0);
if(x0 >= 0)
return trueterm;
}
return falseterm;
}
/*____________________________________________________________________*/
term reduced_and(term a,term b)
/* eliminate true and false if possible and return the conjunction */
{ term ans;
if(equals(a,falseterm))
return falseterm;
if(equals(b,falseterm))
return falseterm;
if(equals(a,trueterm))
return b;
if(equals(b,trueterm))
return a;
ans = make_term(AND,2);
ARGREP(ans,0,a);
ARGREP(ans,1,b); /* avoid going to overlay algaux.c for 'and' */
return ans;
}
/*____________________________________________________________________*/
term reduced_and3(term a,term b,term c)
/* eliminate true and false if possible and return the conjunction */
{ term ans;
if(equals(a,falseterm))
return falseterm;
if(equals(b,falseterm))
return falseterm;
if(equals(c,falseterm))
return falseterm;
if(equals(a,trueterm))
return reduced_and(b,c);
if(equals(b,trueterm))
return reduced_and(a,c);
if(equals(c,trueterm))
return reduced_and(a,b);
ans = make_term(AND,3);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
ARGREP(ans,2,c); /* avoid going to overlay algaux.c for and3 */
return ans;
}
/*____________________________________________________________________*/
term reduced_and4(term a,term b,term c,term d)
/* eliminate true and false if possible and return the conjunction */
{ term ans;
if(equals(a,falseterm))
return falseterm;
if(equals(b,falseterm))
return falseterm;
if(equals(c,falseterm))
return falseterm;
if(equals(d,falseterm))
return falseterm;
if(equals(a,trueterm))
return reduced_and3(b,c,d);
if(equals(b,trueterm))
return reduced_and3(a,c,d);
if(equals(c,trueterm))
return reduced_and3(a,b,d);
if(equals(d,trueterm))
return reduced_and3(a,b,c);
ans = make_term(AND,4);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
ARGREP(ans,2,c);
ARGREP(ans,3,d); // corrected 7.21.05
return ans;
}
/*____________________________________________________________________*/
term reduced_or(term a,term b)
/* eliminate true and false if possible and return the conjunction */
{ term ans;
if(equals(a,trueterm))
return trueterm;
if(equals(b,trueterm))
return trueterm;
if(equals(a,falseterm))
return b;
if(equals(b,falseterm))
return a;
ans = make_term(OR,2);
ARGREP(ans,0,a);
ARGREP(ans,1,b); /* avoid going to overlay algaux.c for 'or' */
return ans;
}
/*________________________________________________________________*/
#define COMPLEMENT(f) (f == SIN ? COS : f == COS ? SIN : f==TAN ? COT : f==COT ? TAN : f==SEC ? CSC : SEC)
term defined2(unsigned short f, term x)
/* f is a #-defined unary functor, such as SQRT;
x is any expression;
the output is a proposition expressing that f(x) is defined;
Example: defined2(SQRT,t) returns LE(0,t)
*/
{ term n,u,v,w,s,ans,p,q;
/* first the total functions */
if(NEGATIVE(x) && (f==SIN || f==COS || f==TAN || f==SEC || f==CSC || f==COT))
x = ARG(0,x); /* this makes the resulting intervals look nicer */
/* catch things like tan(pi/2-x) and simplify so we don't wind up with
two equivalent assumptions that it doesn't realize are equivalent. */
if(FUNCTOR(x) == '+' &&
TRIGFUNCTOR(f) &&
equals(ARG(0,x),piover2) &&
ARITY(x) == 2 &&
NEGATIVE(ARG(1,x))
)
return defined2((unsigned short)COMPLEMENT(f),ARG(0,ARG(1,x)));
switch(f)
{ case SQRT:
ans = (get_complex() ? trueterm : lpt(le(zero,x)));
if(!entire(x))
ans = reduced_and(ans,domain(x));
break;
case LOG:
case LN:
ans = (get_complex() ? nonzero(x) : lessthan(zero,x));
if(!entire(x))
ans = reduced_and(lpt(ans),domain(x));
break;
case TAN:
/* fall through */
case SEC:
if(get_binders() && !stdpartonly(x,&s) && !equals(x,s))
{ if(seminumerical(s))
/* example, lim(x->pi/3, sec x) */
{ double z;
return deval(s,&z) ? falseterm : trueterm;
}
else
/* example, lim(x->a, sec x) */
return defined2(f,s);
}
else
{ n = getnewintvar1(x,"nmkjpq");
u = product(n,pi_term);
tneg(piover2,&w);
if(get_complex())
{ if(complexparts(x,&p,&q)==0)
x = p;
else
{ p = re(x);
q = im(x);
x = p;
}
}
if(entire(x))
{ v = reduced_and(
lpt(lessthan(sum(u,w),x)),
lpt(lessthan(x,sum(u,piover2)))
);
}
else
{ v = reduced_and3(
lpt(lessthan(sum(u,w),x)),
lpt(lessthan(x,sum(u,piover2))),
domain(x)
);
}
if(!get_complex()) /* between odd multiples of pi/2 */
return v;
ans = reduced_or(nonzero(q),v);
break;
}
case CSC: /* fall through */
case COT: /* between multiples of pi */
if(get_binders() && !stdpartonly(x,&s) && !equals(x,s))
{ if(seminumerical(s))
/* example, lim(x->pi/3, cot x) */
{ double z;
return deval(s,&z) ? falseterm : trueterm;
}
else
/* example, lim(x->a, cot x) */
return defined2(f,s);
}
else
{ n = getnewintvar1(x,"nmkjpq");
if(get_complex())
{ if(complexparts(x,&p,&q)==0)
x = p;
else
{ p = re(x);
q = im(x);
x = p;
}
}
v = reduced_and(
lpt(lessthan(product(n,pi_term),x)),
lpt(lessthan(x,product(sum(n,one),pi_term)))
);
if(!get_complex())
return v;
if(entire(x))
ans = reduced_or(nonzero(q),v);
else
ans = reduced_and(reduced_or(nonzero(q),v),domain(x));
break;
}
case TANH:
/* zeroes of cosh are at i pi/2 + i n pi */
if(get_complex())
{ n = getnewintvar1(x,"nmkjpq");
if(complexparts(x,&p,&q)==0)
x = p;
else
{ p = re(x);
q = im(x);
x = p;
}
ans = reduced_or(nonzero(x),
and(
lessthan(sum(piover2, product(n,pi_term)),q),
lessthan(q,sum(piover2, product(sum(n,one),pi_term)))
)
);
ans = reduced_and(ans,domain(x));
}
else
ans = domain(x);
break;
case COTH: /* fall-through */
case CSCH:
/* zeroes of sinh are at i n pi */
if(get_complex())
{ n = getnewintvar1(x,"nmkjpq");
if(complexparts(x,&p,&q)==0)
x = p;
else
{ p = re(x);
q = im(x);
x = p;
}
ans = reduced_or(nonzero(x),
and(
lessthan(product(n,pi_term),q),
lessthan(q,product(sum(n,one),pi_term))
)
);
ans = reduced_and(ans,domain(x));
}
else if(entire(x))
ans = nonzero(x);
else
ans = reduced_and(nonzero(x),domain(x));
break;
case ACOS:
case ASIN: /* See Abramowitz and Stegun p. 79 for complex branch cuts */
if(get_complex())
{ if(complexparts(x,&p,&q)==0)
x = p;
else
{ p = re(x);
q = im(x);
x = p;
}
}
if(FUNCTOR(x) == SQRT)
{ if(entire(ARG(0,x)))
ans = reduced_and(le(zero,ARG(0,x)),le(ARG(0,x),one));
else
ans = reduced_and3(le(zero,ARG(0,x)),le(ARG(0,x),one),domain(ARG(0,x)));
}
else if(FUNCTOR(x) == LN || FUNCTOR(x) == LOG)
{ if(entire(ARG(0,x)))
ans = reduced_and(lessthan(zero,ARG(0,x)),le(ARG(0,x),one));
else
ans = reduced_and3(lessthan(zero,ARG(0,x)),le(ARG(0,x),one),domain(ARG(0,x)));
}
else if(entire(x))
ans = reduced_and(le(minusone,x),le(x,one));
else
ans = reduced_and3(le(minusone,x),le(x,one),domain(x));
if(get_complex())
ans = reduced_or(nonzero(q),ans);
break;
case ASEC:
case ACSC:
if(get_complex())
{ if(complexparts(x,&p,&q)==0)
x = p;
else
{ p = re(x);
q = im(x);
x = p;
}
}
if(FUNCTOR(x) == SQRT || FUNCTOR(x) == LN || FUNCTOR(x) == LOG)
{ if(entire(ARG(0,x)))
ans = le(one,ARG(0,x));
else
ans = reduced_and(le(one,x),domain(ARG(0,x)));
}
else if(entire(x))
ans = reduced_or(le(x,minusone),le(one,x));
else
ans = reduced_and(reduced_or(le(x,minusone),le(one,x)),domain(x));
if(get_complex())
ans = reduced_or(nonzero(q),ans);
break;
case ATAN:
if(get_complex())
{ if(complexparts(x,&p,&q)==0)
x = p;
else
{ p = re(x);
q = im(x);
x = p;
}
ans = reduced_or(nonzero(x),
and(lessthan(minusone,q),
lessthan(q,one)
)
);
}
else if(entire(x))
ans = trueterm;
else
ans = domain(x);
break;
case ACOT:
if(get_complex())
{ if(complexparts(x,&p,&q)==0)
x = p;
else
{ p = re(x);
q = im(x);
x = p;
}
ans = reduced_or(nonzero(x),
reduced_or(
lessthan(q,minusone),
lessthan(one,q)
)
);
}
else if(entire(x))
ans = nonzero(x);
else
ans = reduced_and(nonzero(x),domain(x));
break;
/* see page 86 of Abramowitz and Stegund for branch cuts of the
inverse hyperbolic trig functions */
case ACOSH:
if(get_complex())
{ if(complexparts(x,&p,&q)==0)
x = p;
else
{ p = re(x);
q = im(x);
x = p;
}
}
if(entire(x))
ans = le(one,x);
else
ans = reduced_and(le(one,x),domain(x));
if(get_complex())
ans = reduced_or(nonzero(q),ans);
break;
case ATANH:
if(get_complex())
{ if(complexparts(x,&p,&q)==0)
x = p;
else
{ p = re(x);
q = im(x);
x = p;
}
}
if(entire(x))
ans = reduced_and(lessthan(minusone,x),lessthan(x,one));
else
ans = reduced_and3(lessthan(minusone,x),lessthan(x,one),domain(x));
if(get_complex())
ans = reduced_or(nonzero(q),ans);
break;
case ACOTH:
if(get_complex())
{ if(complexparts(x,&p,&q)==0)
x = p;
else
{ p = re(x);
q = im(x);
x = p;
}
}
if(entire(x))
ans = reduced_or(lessthan(x,minusone),lessthan(one,x));
else
ans = reduced_and(reduced_or(lessthan(x,minusone),lessthan(one,x)),domain(x));
if(get_complex())
ans = reduced_or(nonzero(q),ans);
break;
case ASECH:
if(get_complex())
{ if(complexparts(x,&p,&q)==0)
x = p;
else
{ p = re(x);
q = im(x);
x = p;
}
}
if(entire(x))
ans =reduced_and(lessthan(zero,x),le(x,one));
else
ans =reduced_and3(lessthan(zero,x),le(x,one),domain(x));
if(get_complex())
ans = reduced_or(nonzero(q),ans);
break;
case ACSCH:
if(get_complex())
{ if(complexparts(x,&p,&q)==0)
x = p;
else
{ p = re(x);
q = im(x);
x = p;
}
ans = reduced_or(nonzero(x), reduced_or(lessthan(q,minusone), lessthan(one,q)));
if(!entire(x))
ans = reduced_and(ans,domain(x));
break;
}
if(entire(x))
ans = ne(x,zero);
else
ans = reduced_and(ne(x,zero),domain(x));
break;
case ASINH:
if(get_complex())
{ if(complexparts(x,&p,&q)==0)
x = p;
else
{ p = re(x);
q = im(x);
x = p;
}
ans = reduced_or(nonzero(x), and(lessthan(minusone,q),lessthan(q,one)));
if(!entire(x))
ans = reduced_and(ans,domain(x));
break;
}
if(entire(x))
ans = trueterm;
else
ans = domain(x);
break;
case RIEMANNZETA:
if(get_complex())
{ if(complexparts(x,&p,&q) == 0)
x = p;
else
{ p = re(x);
q = im(x);
x = p;
}
ans = lessthan(make_fraction(one,two),x);
if(!entire(x))
ans = reduced_and(ans,domain(x));
break;
}
ans = lessthan(one,x);
if(!entire(x))
ans = reduced_and(ans,domain(x));
break;
case BERNOULLI: // fall through
case EULERNUMBER: // fall through
case FACTORIAL:
if(INTEGERP(x))
return trueterm;
if(isinteger(x))
{ ans = le(zero,x);
break;
}
if(ISATOM(x))
{ if(TYPE(x) == NATNUM)
return trueterm;
if(TYPE(x) == INTEGER)
return le(zero,x);
}
if(entire(x))
ans = reduced_and(lpt(type(x,INTEGER)),lpt(le(zero,x)));
else
ans = reduced_and3(lpt(type(x,INTEGER)),lpt(le(zero,x)),domain(x));
break;
case DIGAMMA: /* fall-through */
case GAMMA:
n = getnewintvar1(x,"nmkjpq");
v = reduced_and3(lpt(lessthan(n,x)),
lpt(lessthan(x,sum(n,one))),
lpt(lessthan(n,zero))
);
if(entire(x))
ans = reduced_or(lpt(lessthan(zero,x)),v);
else
ans = reduced_and(reduced_or(lpt(lessthan(zero,x)),v),domain(x));
case CONSTANTOFINTEGRATION:
return trueterm;
/* constants of integration actually can represent step functions,
but we can assume they are defined at the jumps. */
default:
if(ENTIRE(f))
return domain(x);
else
assert(0);
}
#if 0 /* this code was present in early versions, but it prevents
recognizing the case when ans is 'immediate' but infer-literally
can't get it, e.g. when we try to deduce n! > 0 and 0<n is in
the assumption list, ans is 0 <= n. */
if(ATOMIC(x)&& !get_binders())
SET_ALREADY(ans); /* speed up calls to lpt */
#endif
return ans;
}
/*________________________________________________________________*/
static term defined3_real(unsigned short f, term x, term y)
/* give real domain of f(x,y) for binary special functions f,
as well as ROOT, LOGB, if the real and complex domains have
a different condition. */
{ term ans;
switch(f)
{ case ROOT:
if(INTEGERP(x)) /* far the most common case */
return ISODD(x) ? trueterm : le(zero,y);
ans = and3(type(x,INTEGER),
lessthan(zero,x),
reduced_or( lpt(le(zero,y)), odd(x))
);
break;
case LOGB:
ans = and(lessthan(zero,x),lessthan(zero,y));
break;
case INCOMPLETEGAMMAP :
ans = and(lessthan(zero,x),le(zero,y));
break;
default:
/* assert(0); You can't get here with normal input,
but if someone types in exists(x,x) we get here.
The parser accepts it. */
ans = and(domain(x),domain(y));
break;
}
if(ATOMIC(x) && ATOMIC(y))
SET_ALREADY(ans);
return ans;
}
/*________________________________________________________________*/
static term defined3_complex(unsigned short f, term x, term y)
/* give real domain of f(x,y) for binary special functions f,
as well as ROOT and LOGB, if the real and complex domains have a
different condition. */
{ switch(f)
{ case ROOT:
if(INTEGERP(x))
return domain(y);
if(ISATOM(x) && TYPE(x)==INTEGER)
return domain(y);
return and(type(x,INTEGER),lessthan(zero,x));
case LOGB:
return INTEGERP(x) ? nonzero(y) : and(nonzero(x),nonzero(y));
default: assert(0);
}
return falseterm;
}
/*________________________________________________________________*/
term defined3(unsigned short f, term x,term y)
/* f is ROOT, MOD, LOGB or GCD or BINOMIAL,
or a binary special function;
x,y are any expressions;
the output is a proposition expressing that f(x,y) is defined;
*/
{ if(f==GCD)
return and(type(x,INTEGER),type(y,INTEGER));
if(f==MOD)
return and3(type(x,INTEGER),type(y,INTEGER),lessthan(zero,y));
if(f==BINOMIAL)
{ term ans;
ans = make_term(AND,4);
ARGREP(ans,0,type(x,INTEGER));
ARGREP(ans,1,lpt(le(zero,x)));
ARGREP(ans,2,type(y,INTEGER));
ARGREP(ans,3,lpt(le(zero,y)));
return ans;
}
if(f==BESSELJ || f==BESSELI)
{ if(INTEGERP(x) || (ATOMIC(x) && TYPE(x) == INTEGER))
return domain(y);
else
return and(type(x,INTEGER),domain(y));
}
if(f==BESSELY || f==BESSELK)
{ if(INTEGERP(x) || (ATOMIC(x) && TYPE(x) == INTEGER))
return nonzero(y);
else
return and(type(x,INTEGER),nonzero(y));
}
if(f==BETAFUNCTION)
return and(defined2(GAMMA,x), defined2(GAMMA,y));
if(f==POLYGAMMA)
{ term n = getnewintvar1(y,"nmkjpq");
term v = reduced_and3(lpt(lessthan(n,y)),
lpt(lessthan(y,sum(n,one))),
lpt(lessthan(n,zero))
);
if(entire(y))
return reduced_or(lpt(lessthan(zero,y)),v);
else
return reduced_and(reduced_or(lpt(lessthan(zero,y)),v),domain(y));
}
if(get_complex())
return defined3_complex(f,x,y);
else
return defined3_real(f,x,y);
}
/*________________________________________________________________*/
static term belongs(term u, term interval, term x)
/* interval is an inequality or an interval with variable x */
/* return a proposition saying that u belongs to that interval */
{ term ans;
subst(u,x,interval,&ans);
return ans;
}
/*________________________________________________________________*/
static int first_difference(term a, term b, term *p, term *q)
/* compare the expression trees of a and b until there is a position
where a has a different subterm than b. Then set *p and *q to those
subterms and return 0. If they are equal return 1.
But count <= and < as not different in this comparison.
*/
{ if(FUNCTOR(a) == '*' && FUNCTOR(b) == '*' && ARITY(a) != ARITY(b))
{ /* for example 2m pi and n pi */
term temp, cancelled;
int rval = cancel(a,b,&cancelled,&temp);
if(rval) // nothing cancelled
{ *p = a;
*q = b;
return 0;
}
if(FUNCTOR(temp) == '/')
{ *p = ARG(0,temp);
*q = ARG(1,temp);
return 0;
}
return 1;
}
if(
(FUNCTOR(a) != FUNCTOR(b) || ARITY(a) != ARITY(b)) &&
! (FUNCTOR(a) == ',' && FUNCTOR(b) == LE) && // per spec
! (FUNCTOR(a) == LE && FUNCTOR(b) == '<')
)
{ *p = a;
*q = b;
return 0;
}
int i,n;
if(ATOMIC(a) && equals(a,b))
return 1;
if(ATOMIC(a))
{ *p = a;
*q = b;
return 0;
}
if(ATOMIC(b))
{ *q = b;
*p = a;
return 0;
}
n = ARITY(a);
for(i=0;i<n;i++)
{ int rval = first_difference(ARG(i,a),ARG(i,b),p,q);
if(rval == 0)
return 0;
}
return 1;
}
/*________________________________________________________________*/
static int interval_form(term mid, term x, term *ans)
/* mid is a proposition. If possible, express it as an interval
or union of intervals (a union is an OR) in the variable x. Here
'intervals' includes inequalities with x on one side and the
other side not containing x. Return 0 for success, 1 for failure. */
{ int err,i;
term temp,u;
unsigned short f,g,n,h;
if(interval_as_and(mid))
{ *ans = mid;
if(equals(ARG(1,ARG(0,mid)),x) && !contains(ARG(0,ARG(0,mid)),FUNCTOR(x)) && !contains(ARG(1,ARG(1,mid)),FUNCTOR(x)))
return 0;
return 1;
}
if(FUNCTOR(mid) == NE)
{ if(contains(ARG(1,mid),FUNCTOR(x)))
/* invert_eqn requires the unknown in its FIRST argument */
{ if(contains(ARG(0,mid),FUNCTOR(x)))
return 1;
err = invert_eqn(ARG(1,mid),ARG(0,mid),x,&temp);
}
else
err = invert_eqn(ARG(0,mid),ARG(1,mid),x,&temp);
if(err) return 1;
*ans = or(lessthan(x,temp),lessthan(temp,x));
return 0;
}
f = FUNCTOR(mid);
if(INEQUALITY(f))
{ if(contains(ARG(1,mid),FUNCTOR(x)))
/* invert_ineq requires the unknown in its FIRST argument */
{ if(contains(ARG(0,mid),FUNCTOR(x)))
return 1;
f= SWITCH(f);
err = invert_ineq(ARG(1,mid),ARG(0,mid),x,&temp,&f);
}
else
err = invert_ineq(ARG(0,mid),ARG(1,mid),x,&temp,&f);
if(!err)
{ switch(f)
{ case '<' : *ans = lessthan(x,temp); return 0;
case LE : *ans = le(x,temp); return 0;
case '>' : *ans = lessthan(temp,x); return 0;
case GE : *ans = le(temp,x); return 0;
default : assert(0);
}
}
/* example: t^2 < 1 gets here */
err = ssolve(mid,x,ans);
if(err)
return 1;
g = FUNCTOR(*ans);
if(INEQUALITY(g))
return 0;
if(g == AND && interval_as_and(*ans))
return 0;
if(g != OR)
return 1;
n = ARITY(*ans);
for(i=0;i<n;i++)
{ u = ARG(i,*ans);
h = FUNCTOR(u);
if(h == AND && interval_as_and(u))
continue;
if(INEQUALITY(h))
continue;
return 1;
}
return 0;
}
if(FUNCTOR(mid) == AND && ARITY(mid) == 2 &&
interval_as_and(ARG(0,mid)) && interval_as_and(ARG(1,mid))
)
{ // as in ln(sec x) tan x, which gets here with
// mid = 2m pi-pi/2 < x < 2m pi+pi/2,n pi-pi/2 < x < n pi+pi/2
term a,b,p,q,x;
a = ARG(0,mid);
b = ARG(1,mid);
x = ARG(1,ARG(0,a));
if(!equals(x,ARG(1,ARG(0,b))))
return 1;
int rval = first_difference(a,b,&p,&q); // in the example, p = 2m and q = n
if(rval)
{
// a is equal to b
*ans = a;
return 0;
}
if(ISATOM(p))
{ subst(q,p,a,ans);
return 0;
}
if(ISATOM(q))
{ subst(p,q,b,ans);
return 0;
}
return 1;
}
return 1;
}
/*_____________________________________________________________*/
static int evalbar2(term t, term *next)
/* like evalbar in defint.c but reason-free and model-free */
/* eliminate EVAL; EVAL(u,x,a,b) goes to u(b) - u(a) */
/* except if the lower limit a is an equality x=c then it goes to u(b)-u(c) */
{ term u,x,a,b,p,q;
if(FUNCTOR(t) != EVAL)
return 1;
u = ARG(0,t);
x = ARG(1,t);
a = ARG(2,t);
if(FUNCTOR(a) == '=')
{ assert(equals(ARG(0,a),x));
a = ARG(1,a);
}
b = ARG(3,t);
if(FUNCTOR(u)==LN)
{ subst(a,x,ARG(0,u),&p);
subst(b,x,ARG(0,u),&q);
*next = ln1(make_fraction(q,p));
return 0;
}
/* else, it isn't a LN term */
subst(a,x,u,&p);
subst(b,x,u,&q);
*next = sum(q,tnegate(p));
return 0;
}
/*_________________________________________________________________________*/
term join(term u, term v)
/* If u and v are intervals whose union is an (easily computed) interval, then return that interval;
otherwise return false.
*/
{ term a,b,c,d,x;
unsigned short f;
if(interval_as_and(u) && interval_as_and(v))
{ a = ARG(0,ARG(0,u));
b = ARG(1,ARG(1,u));
c = ARG(0,ARG(0,v));
d = ARG(1,ARG(1,v));
x = ARG(0,ARG(1,u));
if(equals(a,d))
return and(ARG(0,v),ARG(1,u));
if(equals(b,c))
return and(ARG(0,u),ARG(1,v));
return falseterm;
}
if(interval_as_and(u))
return join(v,u);
if(interval_as_and(v))
{ f = FUNCTOR(u);
if(f != '<' && f != LE)
return falseterm;
a = ARG(0,u);
b = ARG(1,u);
c = ARG(0,ARG(0,v));
x = ARG(1,ARG(0,v));
d = ARG(1,ARG(1,v));
if(equals(a,x) && equals(b,c))
return or( and(le(d,b),u), and(le(b,d),ARG(1,v)));
if(equals(b,x) && equals(a,d))
return or( and(le(c,a),ARG(0,v)), and(le(a,c),u));
}
return falseterm;
}
/*______________________________________________________________________*/
static term interior(term p, term x)
/* replace all inequalities in p by the corresponding strict
inequalities, i.e. LE by <, GE by >. Return the result.
*/
{ int i;
unsigned short n;
unsigned short f;
term ans;
if(ATOMIC(p))
return p;
f = FUNCTOR(p);
switch(f)
{ case LE:
ans = p;
SETFUNCTOR(ans,'<',2);
return ans;
case GE:
ans = p;
SETFUNCTOR(ans,'>',2);
return ans;
case '=':
case NE:
case '<':
case '>':
return p;
}
if(f == OR)
{ /* combine adjacent intervals, e.g. the interior of [0,1] union [1,2] does contain 1 */
int i,j,k,r;
unsigned short n = ARITY(p);
term q,w;
for(i=0;i<n-1;i++)
for(j=i+1;j<n;j++)
{ w = join(ARG(i,p),ARG(j,p));
if(!equals(w,falseterm))
{ if(n==2)
return interior(w,x);
q = make_term(OR,n-1);
ARGREP(q,0,w);
k=1;
for(r=0;r<n;r++)
{ if(r==i || r==j) continue;
ARGREP(q,k,ARG(r,p));
k++;
}
assert(k==n-1);
return interior(q,x);
}
}
/* if no intervals are adjacent then just go on to the code below */
}
if(f == AND || f == OR || f == NOT || f == IMPLIES)
{ n = ARITY(p);
ans = make_term(f,n);
for(i=0;i<n;i++)
ARGREP(ans,i,interior(ARG(i,p),x));
return ans;
}
return p; /* p is mathematical, or a proposition with predicate ':' or EVEN or ODD
or other proposition that can't contain an inequality anyway. */
}
/*_______________________________________________________________________*/
int contains_defined_variables(term t)
/* return 1 if t contains any defined variable, 0 if not;
but don't count variables bound or half-bound by limit
or integration, which have been introduced by changelimitvariable
of by integration by substitution.
*/
{ term *atomlist;
int nextdefn = get_nextdefn();
int i,j,nvars;
unsigned short f;
int nvariables = get_nvariables();
defn *defns = get_defns();
if(nextdefn == 0 || nvariables == 0 || seminumerical(t))
return 0;
for(i=0;i<nextdefn;++i)
{ if(defns[i].reverse)
{ /* then the defined variable is contained in defns[i].right, and
the variable in defns[i].left is an older variable, not
defined by this definition. Of course, the right hand side
might contain parameters too, so it's a problem to fish out
the right variable. */
nvars = variablesin(defns[i].right,&atomlist);
if(nvars == 1)
{ f = FUNCTOR(atomlist[0]);
if(contains_free(t,f))
{ free2(atomlist);
return 1;
}
}
else
{ for(j=0;j<nvars;j++)
{ if(!isparameter(atomlist[j]))
{ f = FUNCTOR(atomlist[j]);
if(contains_free(t,f))
{ free2(atomlist);
return 1;
}
}
}
}
free2(atomlist);
continue;
}
f = FUNCTOR(defns[i].left);
if(f != AND && contains_free(t,f))
return 1;
if(f == AND)
{ assert(ARITY(defns[i].left)==2); /* two simultaneous defns is the max */
if(contains_free(t,FUNCTOR(ARG(0,defns[i].left))) ||
contains_free(t,FUNCTOR(ARG(1,defns[i].left)))
)
return 1;
}
}
return 0;
}
/*__________________________________________________________________*/
term DifIntegralDomain(term t)
/* calculate the domain of a derivative of an integral */
{ term I = ARG(0,t); /* the integral */
term u = ARG(0,I); /* the integrand */
term x = ARG(1,t); /* differentiating with respect to x */
term z = ARG(1,I); /* integrating with respect to z */
term hi,lo;
term hidom, lodom;
term w,q;
term ans;
int err;
int original_assumptions = get_nextassumption();
int save_nextassumption, nassumptions;
if(ARITY(I) == 2)
{ /* an indefinite integral */
if(equals(z,x))
return domain(u); /* by the fundamental theorem of calculus */
/* Now we're differentiating under the integral */
return domain(derivative(u,x));
}
/* Now it's a definite integral */
hi = ARG(3,I);
lo = ARG(2,I);
/* Maybe we're just differentiating under the integral sign */
if(!equals(x,z) && !contains(lo,FUNCTOR(x)) && !contains(hi,FUNCTOR(x)))
return lpt(and3(domain(hi),domain(lo),domain(definite_integral(derivative(u,x),z,lo,hi))));
/* Now it's a fundamental-theorem problem */
hidom = domain(hi);
if(contains(hi,FUNCTOR(x)) && !equals(hi,x))
hidom = reduced_and(hidom, domain(derivative(hi,x)));
lodom = domain(lo);
if(contains(lodom,FUNCTOR(x)) && !equals(lo,x))
lodom = reduced_and(lodom, domain(derivative(lo,x)));
err = check1(lodom); /* for use by lpt in defined_on_interval */
if(err)
return falseterm;
err = check1(hidom);
if(err)
return falseterm;
save_nextassumption = get_nextassumption();
if(equals(x,z) || contains(lo,FUNCTOR(z)) || contains(hi,FUNCTOR(z)))
{ if(!contains(lo,FUNCTOR(x)) && !contains(hi,FUNCTOR(x)))
{ ans = domain(I); /* example, diff (integral(x^2, x,0,1),x). The answer is zero, so it's
defined whereever the integral is defined--no, on the interior of that set! */
goto out;
}
/* Now we need to rename the variable of integration. */
w = getnewvar(t,"uvwtxyz");
subst(w,z,u,&q);
ans = domain(derivative(definite_integral(q,w,lo,hi),x));
goto out;
}
/* Now there's no conflict of free and bound variables */
if(!contains(u,FUNCTOR(x)))
{ /* Then it's a straightforward fundamental-theorem problem. But the
answer is not just the domain of u. Example: integral( tan z,z, a(x), b(x)).
The domain is the set of values of x such that [a(x),b(x)] lies in the domain of
of tan. That will in general not be trivial to compute. */
ans = defined_on_interval(u,z,lo,hi);
goto out;
}
/* Now it's a trickier problem where the answer is u(hi)-u(lo) + integral(du/dx,z,lo,hi) */
ans = and(defined_on_interval(u,z,lo,hi), defined_on_interval(derivative(u,x),z,lo,hi));
out:
ans = interior(ans,x);
/* We need interior here because it's the two-sided derivative. Example:
the domain of d/dx integral(sqrt(1-t),t,0,x) is t < 1, not t <= 1.
But sometimes defined_on_interval has already made assumptions, and ans is just 'true'.
Therefore the following code to replace each new assumption by its interior */
nassumptions = get_nextassumption();
if(nassumptions > save_nextassumption)
{ int k = nassumptions - save_nextassumption;
term *q = (term *) calloc(k,sizeof(term));
int i;
for(i=0;i<k;i++)
q[i] = get_assumption(save_nextassumption + i);
set_nextassumption(original_assumptions);
for(i=0;i<k;i++)
assume(interior(q[i],x));
free(q);
simplify_assumptions(and3(lo,hi,u));
}
ans = lpt(reduced_and3(hidom, lodom,ans));
return ans;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists