Sindbad~EG File Manager
/* M. Beeson, Mathpert */
/* Original date 8.11.93 */
/* Code last modified 5.12.95 */
/* file last modified 6.18.98 */
/* Note, we DON'T put the expression through polyval first, because some
assumptions are lost when compound fractions are simplified and cancellation
is done. */
/* This file is needed because you can't calculate the codomain (where the
function is undefined) by simply negating the domain and simplifying.
Consider the codomain of sec x. The domain is n\pi -\pi /2 \le x \le n\pi +\pi /2.
Here n is existentially quantified. The codomain is x = k\pi + \pi /2, where
k is ALSO existentially quantified. You'll never get the codomain by negating
the domain and simplifying! */
#include <assert.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 "userfunc.h"
#include "binders.h"
#include "pvalaux.h" /* mvpoly2 */
static term undefined2(unsigned short f, term x);
static term codomexp(term a, term b);
static term codef_aux(term u);
static term reduced_or3(term,term,term);
static term reduced_or4(term,term,term,term);
static term undefined3_real(unsigned short f, term x, term y);
static term undefined3_complex(unsigned short f, term x, term y);
static term undefined3(unsigned short f, term x,term y);
/*________________________________________________________________*/
term codomain(term u)
/* return a proposition expressing that u is undefined. If 'DEFINED' is
present in the returned term (indicating failure to analyze the codomain)
then it should be PROTECTED. This function is only needed in minmax
problems to calculate where f'(x) is undefined. It therefore doesn't
have to handle functors DIFF, INTEGRAL, LIMIT, EVAL as domain does.
*/
{ term mid;
double x;
dcomplex z;
int err;
if(NOTDEFINED(u))
return trueterm;
if(OBJECT(u))
return falseterm;
if(seminumerical(u)) /* e.g. tan \pi /4, which otherwise comes back
as -1/4 < n < 3/4;
called recursively on examples like x+\pi /4;
also gets undefined examples like \pi /2 */
{ err = get_complex() ? ceval(u,&z) : deval(u,&x);
if(err != 10)
return err ? trueterm : falseterm;
/* else if (err==10), as happens when u = 10^10^10, just
analyze the term as if it weren't seminumerical */
}
if(ISATOM(u) && get_nextdefn() == 0)
return falseterm;
if(ISATOM(u)) /* have to worry about let-definitions */
{ if(is_letdefined(u,&mid))
return codomain(mid);
return falseterm; /* wasn't a defined variable after all */
}
return lpt(codef_aux(u));
}
/*_____________________________________________________________*/
static term codef_aux(term u)
/* called by codomain on functions not containing DIFF, INTEGRAL, etc. */
/* u is not atomic */
{ term p,q,a,b,ans,mid,num,den;
unsigned short k;
int i,err;
unsigned short g = FUNCTOR(u);
unsigned short n = ARITY(u);
assert(!ATOMIC(u));
if(get_nextdefn() == 0 && mvpoly2(u))
return falseterm;
if(g=='-')
return codef_aux(ARG(0,u));
if(n==1 && PREDEFINED_FUNCTOR(g))
return undefined2(g,ARG(0,u));
if(g =='*' || g == '+' || g == AND || g == OR)
{ 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 = codomain(ARG(i,u));
if(equals(p,trueterm))
{ RELEASE(ans);
return trueterm;
}
if(!equals(p,falseterm))
{ ARGREP(ans,k,p);
++k;
}
}
if(k==0)
{ RELEASE(ans);
return falseterm;
}
if(k==1)
{ mid = ARG(0,ans);
RELEASE(ans);
return mid;
}
SETFUNCTOR(ans,OR,k);
drop_variants(ans,&ans);
return ans;
}
if(g == '/')
{ p = codomain(ARG(0,u));
b = codomain(ARG(1,u));
if(ISINTEGER(ARG(1,u))) /* common special case, let's speed up */
q = ZERO(ARG(1,u)) ? trueterm : falseterm;
else
q = lpt(equation(zero,ARG(1,u)));
mid = lpt(reduced_or3(p,b,q));
drop_variants(mid,&mid);
return mid;
}
if(g == '^')
{ a = ARG(0,u);
b = ARG(1,u); /* trying to get codomain of a^b */
if(INTEGERP(b)) /* very common case */
return codomain(a);
if(get_complex())
return lpt(reduced_and(lpt(equation(a,zero)),lpt(equation(b,zero))));
/* 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 codomain(make_power(a,q));
num = ARG(0,q);
den = ARG(1,q);
return codomexp(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 codomain(make_power(a,tnegate(q)));
num = ARG(0,q);
den = ARG(1,q);
return codomexp(a,tnegate(make_fraction(num,den)));
}
}
if(NEGATIVE(b) && INTEGERP(ARG(0,b)))
{ return lpt(equation(zero,a)); /* hopefully faster than domexp */
}
return codomexp(a,b);
}
if( g== '=' || g == '<' || g == '>' || g == LE || g == GE || g == NE)
return lpt(reduced_or(codomain(ARG(0,u)),codomain(ARG(1,u))));
if(n==2 && PREDEFINED_FUNCTOR(g))
return undefined3(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 codomain(mid);
}
ans = not(defined(u));
PROTECT(ans);
return ans;
}
/*________________________________________________________________*/
static term codomexp(term a, term b)
/* called for codomain(a^b). Assume that if b is a fraction or negated
fraction then b is already in lowest terms. */
{ term p,num,den,apos,numint,denint,temp,cancelled,mid;
double x;
int err;
p = codomain(a);
apos = lpt(lessthan(zero,a));
if(equals(apos,trueterm))
return codomain(b); /* and that's that-- so much for 2^((x^2 + c)/(x^2-c)) */
if(FUNCTOR(b)=='-')
{ if(INTEGERP(ARG(0,b)) ) /* another common case */
return lpt(reduced_or(p,lpt(equation(zero,a))));
return lpt(reduced_or(lpt(equation(zero,a)),codomexp(a,ARG(0,b))));
}
/* Now we may assume b isn't a negation */
if(INTEGERP(b) && !ZERO(b)) /* a very common case */
return p; /* and that's that. */
if(FUNCTOR(b)=='/')
{ num = ARG(0,b);
den = ARG(1,b);
if(INTEGERP(num) && INTEGERP(den)) /* positive rational exponent */
{ if(ISODD(den))
return p; /* as in x^(1/3) or x^(3/5) */
/* else denominator is even, as in x^(1/4) */
return lpt(reduced_or(p,lpt(lessthan(a,zero))));
}
if(INTEGERP(den)) /* example: x^(n/3) */
{ if(ISODD(den))
return lpt(reduced_or3(p, lpt(not(type(num,INTEGER))), reduced_and(lpt(le(num,zero)),lpt(equation(zero,a)))));
else
return lpt(reduced_or3(p,lpt(lessthan(a,zero)),codomain(b)));
}
/* The only way to infer that something is even is if 2 will cancel
out of it. Let's handle that directly here for speed. */
polyval(sum(den,minusone),&mid);
err = cancel(mid,two,&cancelled,&temp);
if(!err) /* denominator is odd if temp is an integer */
return lpt(reduced_or4(p, /* a undefined */
lpt(not(type(temp,INTEGER))), /* b irrational */
lpt(not(type(num,INTEGER))),
reduced_and(lpt(le(b,zero)), /* exponent positive */
lpt(equation(zero,a)) /* or base nonzero */
)
)
);
/* maybe the denominator is provably even, e.g. x^(n/2m) */
err = cancel(den,two,&cancelled,&temp);
if(!err)
return lpt(reduced_or4(p, /* a undefined */
codomain(b),
reduced_and(lpt(le(b,zero)),lpt(le(a,zero))),
lpt(lessthan(a,zero))
)
);
/* Now we're unable to settle whether den is odd or even */
numint = lpt(not(type(num,INTEGER)));
denint = lpt(not(type(den,INTEGER)));
/* a^num/den defined iff
and(
a defined
or(b > 0, a !=0)
or(
and(numint, denint, (odd(den) or a \ge 0))
a > 0
)
) */
return lpt(reduced_or3( p, /* a undefined */
reduced_and(lpt(le(a,zero)),lpt(equation(zero,a))),
reduced_and(
reduced_or3(numint,denint, /* b is rational */
reduced_and(even(den),lpt(equation(zero,a)))
),
lpt(le(a,zero))
)
)
);
}
/* Now FUNCTOR(b) != '/' or '-' */
temp = lpt(and(le(b,zero),equation(zero,a)));
if(seminumerical(b) && !deval(b,&x)) /* catch e.g. x^sqrt(5) so we don't return
something involving odd(denom(sqrt 5)) */
mid = x > 0.0 ? lessthan(a,zero) : le(a,zero);
else
mid = lpt(and(even(denom1(b)),lessthan(a,zero)));
/* temp and mid assigned separately to facilitate debugging */
return lpt(reduced_or4(p,codomain(b),temp, mid));
}
/*________________________________________________________________*/
static term undefined2(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 undefined;
Example: undefined2(SQRT,t) returns t<0
*/
{ term n,u,w,s;
/* first the total functions */
if( ENTIRE(f))
return codomain(x);
switch(f)
{ case SQRT: return (get_complex() ? falseterm : lessthan(x,zero));
case LOG:
case LN: return (get_complex() ? equation(x,zero) : le(x,zero));
case TAN:
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) ? trueterm : falseterm;
}
else
/* example, lim(x->a, sec x) */
return undefined2(f,s);
}
else
{ n = getnewintvar1(x,"nmkjpq");
u = product(n,pi_term);
tneg(make_fraction(pi_term,two),&w);
return equation(x, sum(u,piover2));
/* odd multiples of pi/2 */
}
case CSC:
case COT: /* 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) ? trueterm : falseterm;
}
else
/* example, lim(x->a, cot x) */
return undefined2(f,s);
}
else
{ n = getnewintvar1(x,"nmkjpq");
return product(n,pi_term);
}
case COTH: /* fall-through */
case CSCH: return equation(zero,x);
case ACOS:
case ASIN: return reduced_or(lpt(lessthan(x,minusone)),lpt(lessthan(one,x)));
case ASEC:
case ACSC: return reduced_and(lpt(lessthan(minusone,x)),lpt(lessthan(x,one)));
case ACOSH: return lessthan(x,one);
case ATANH: return or(le(x,minusone),le(one,x));
case ACOTH: return or(le(minusone,x),le(x,one));
case ASECH: return or(le(x,zero),lessthan(one,x));
case DIGAMMA: /* fall-through */
case POLYGAMMA:
case GAMMA: n = getnewintvar1(x,"nmkjpq");
/* nonpositive integers */
return reduced_and(equation(x,n), le(n,zero));
}
assert(0);
return falseterm;
}
/*____________________________________________________________________*/
static term reduced_or3(term a,term b,term c)
/* eliminate true and false if possible and return the disjunction */
{ term ans;
if(equals(a,trueterm))
return trueterm;
if(equals(b,trueterm))
return trueterm;
if(equals(c,trueterm))
return trueterm;
if(equals(a,falseterm))
return reduced_or(b,c);
if(equals(b,falseterm))
return reduced_or(a,c);
if(equals(c,falseterm))
return reduced_or(a,b);
ans = make_term(OR,3);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
ARGREP(ans,2,c);
return ans;
}
/*____________________________________________________________________*/
static term reduced_or4(term a,term b,term c,term d)
/* eliminate true and false if possible and return the disjunction */
{ term ans;
if(equals(a,trueterm))
return trueterm;
if(equals(b,trueterm))
return trueterm;
if(equals(c,trueterm))
return trueterm;
if(equals(d,trueterm))
return trueterm;
if(equals(a,falseterm))
return reduced_or3(b,c,d);
if(equals(b,falseterm))
return reduced_or3(a,c,d);
if(equals(c,falseterm))
return reduced_or3(a,b,d);
if(equals(d,falseterm))
return reduced_or3(a,b,c);
ans = make_term(OR,4);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
ARGREP(ans,2,c);
ARGREP(ans,3,c);
return ans;
}
/*________________________________________________________________*/
static term undefined3_real(unsigned short f, term x, term y)
/* give real codomain of f(x,y) for binary special functions f,
as well as ROOT, LOGB, if the real and complex codomains have
a different condition. */
{ switch(f)
{ case ROOT: if(INTEGERP(x)) /* far the most common case */
return ISODD(x) ? falseterm : lessthan(y,zero);
return or3(not(type(x,INTEGER)),
le(x,zero),
reduced_and( lpt(lessthan(y,zero)), even(x))
);
case LOGB: return or(le(x,zero),le(y,zero));
case INCOMPLETEGAMMAP : return or(le(x,zero),lessthan(y,zero));
}
assert(0);
return trueterm;
}
/*________________________________________________________________*/
static term undefined3_complex(unsigned short f, term x, term y)
/* give real codomain of f(x,y) for binary special functions f,
as well as ROOT and LOGB, if the real and complex codomains have a
different condition. */
{ switch(f)
{ case ROOT: return or(not(type(x,INTEGER)),le(x,zero));
case LOGB: return or(equation(x,zero),equation(y,zero));
}
assert(0);
return trueterm;
}
/*________________________________________________________________*/
static term undefined3(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 undefined;
*/
{ if(f==BESSELJ || f==BESSELI)
return or(not(type(x,INTEGER)),codomain(y));
if(f==BESSELY || f==BESSELK)
return or(not(type(x,INTEGER)),equation(y,zero));
if(f==BETAFUNCTION)
return or(undefined2(GAMMA,x), undefined2(GAMMA,y));
if(get_complex())
return undefined3_complex(f,x,y);
else
return undefined3_real(f,x,y);
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists