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 ABS 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
*/
/* 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>
#define PROVER_DLL
#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 */
static term def_aux(term);
static term def_aux2(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 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)
return def_aux2(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 ABS, 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 true;
if(ISATOM(y) && (!depends(y,x) || equals(y,x)))
return true;
if(f == ABS)
{ 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 true; /* 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 true;
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 true;
/* 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)));
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 */
return interior(domain(y));
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,true) && equals(q,true))
ans = nonzero(v);
else if(equals(p,true))
ans = and(q,nonzero(v));
else if(equals(q,true))
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,true))
continue;
if(equals(temp,false))
{ RELEASE(ans);
return false;
}
ARGREP(ans,k,temp);
++k;
}
if(k==0)
{ RELEASE(ans);
return true;
}
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)));
}
if(f == INTEGRAL && ARITY(y) == 4)
return and(domain(derivative(y,x)), domain(y));
return interior(domain(derivative(y,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 true;
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 == ABS)
{ 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 true; /* 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 == ABS || 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)));
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));
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,true))
continue;
if(equals(temp,false))
{ RELEASE(ans);
return false;
}
ARGREP(ans,k,temp);
++k;
}
if(k==0)
{ RELEASE(ans);
return true;
}
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)));
}
/*_____________________________________________________________*/
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 true; /* 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,false))
{ RELEASE(ans);
return false;
}
if(!equals(p,true))
{ ARGREP(ans,k,p);
++k;
}
if(FUNCTOR(p) == AND)
++needsflattening;
}
if(k==0)
{ RELEASE(ans);
return true;
}
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)) ? false : true;
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,true))
{ RELEASE(ans);
return true;
}
if(!equals(p,false))
{ ARGREP(ans,k,p);
++k;
}
if(FUNCTOR(p) == OR)
++needsflattening;
}
if(k==0)
{ RELEASE(ans);
return true;
}
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,false))
{ RELEASE(ans);
return false;
}
if(!equals(p,true))
ARGREP(ans,i,p);
}
if(k==0)
return true;
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;
}
/*__________________________________________________________________*/
static term def_aux2(term u)
/* called by domain when u has functor LIMIT, INTEGRAL, PR, SUM, or PRODUCT */
/* 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. */
{ term ans,x,v,lo,hi,mid,temp;
int i,err,savebinderflag;
unsigned short g = FUNCTOR(u);
unsigned short n = ARITY(u);
if(g==SUM || g == PRODUCT || (g == INTEGRAL && n == 4))
{ v = ARG(0,u);
x = ARG(1,u);
lo = ARG(2,u);
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 */
}
fillbinders(u);
savebinderflag = get_lpt_binderflag();
set_lpt_binderflag(0);
mid = lpt(domain(v));
set_lpt_binderflag(savebinderflag);
releasebinders();
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. */
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 */
{ 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 */
ans = defined(u); /* can't calculate the limit */
PROTECT(ans);
SET_ALREADY(ans);
return ans;
}
assert(0); /* can't get here */
return false;
}
/*____________________________________________________________________*/
term reduced_and(term a,term b)
/* eliminate true and false if possible and return the conjunction */
{ term ans;
if(equals(a,false))
return false;
if(equals(b,false))
return false;
if(equals(a,true))
return b;
if(equals(b,true))
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,false))
return false;
if(equals(b,false))
return false;
if(equals(c,false))
return false;
if(equals(a,true))
return reduced_and(b,c);
if(equals(b,true))
return reduced_and(a,c);
if(equals(c,true))
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,false))
return false;
if(equals(b,false))
return false;
if(equals(c,false))
return false;
if(equals(d,false))
return false;
if(equals(a,true))
return reduced_and3(b,c,d);
if(equals(b,true))
return reduced_and3(a,c,d);
if(equals(c,true))
return reduced_and3(a,b,d);
if(equals(d,true))
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,true))
return true;
if(equals(b,true))
return true;
if(equals(a,false))
return b;
if(equals(b,false))
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 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(�/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() ? true : 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) ? false : true;
}
else
/* example, lim(x->a, sec x) */
return defined2(f,s);
}
else
{ n = getnewintvar1(x,"nmkjpq");
u = product(n,pi);
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) ? false : true;
}
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),x)),
lpt(lessthan(x,product(sum(n,one),pi)))
);
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)),q),
lessthan(q,sum(piover2, product(sum(n,one),pi)))
)
);
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),q),
lessthan(q,product(sum(n,one),pi))
)
);
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 = true;
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 = true;
else
ans = domain(x);
break;
case FACTORIAL:
if(INTEGERP(x))
return true;
if(isinteger(x))
{ ans = le(zero,x);
break;
}
if(ISATOM(x))
{ if(TYPE(x) == NATNUM)
return true;
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 POLYGAMMA:
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 true;
/* 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) ? true : 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 false;
}
/*________________________________________________________________*/
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(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 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;
return equals(ARG(1,ARG(0,mid)),x);
}
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;
}
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;
}
/*______________________________________________________________________*/
static term interior(term p)
/* 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 == 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)));
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. */
}
/*_______________________________________________________________________*/
MEXPORT_PROVER 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;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists