Sindbad~EG File Manager
/* Beeson, Mathpert; information about open domains of functions */
/*
1.29.91 original date
10.30.99 last modified
*/
#include <assert.h>
#define PROVER_DLL
#include "globals.h"
#include "prover.h"
#include "algaux.h"
#include "domain.h"
#include "deval.h"
#include "binders.h"
#include "pvalaux.h" /* ratpart2, complexparts */
static char intvarnames[] = "nmkjpqNMKJPQ";
static void set_ordered(term *);
/*____________________________________________________________________*/
MEXPORT_PROVER term getnewintvar1(term t, char *data)
/* like getnewintvar, but enters an assumption if needed */
{ term ans = getnewintvar(t,data);
unsigned short f = FUNCTOR(ans);
if(f != 'n' && f != 'm' && f != 'j' && f != 'k' && f != ILLEGAL)
assume(type(ans,INTEGER));
/* Note, if we are out of space for subscripted variables
getnewintvar can return ILLEGAL; in that case we're in
trouble but don't compound matters by making an assumption
involving ILLEGAL */
return ans;
}
/*____________________________________________________________*/
MEXPORT_PROVER term getnewindexvar(term t, char *data)
/* like getnewintvar1, but sets the scope to BOUND rather than
EXISTENTIAL.
*/
{ term ans = getnewboundintvar(t,data);
unsigned short f = FUNCTOR(ans);
if(f != 'n' && f != 'm' && f != 'j' && f != 'k' && f != ILLEGAL)
assume(type(ans,INTEGER));
/* Note, if we are out of space for subscripted variables
getnewintvar can return ILLEGAL; in that case we're in
trouble but don't compound matters by making an assumption
involving ILLEGAL */
return ans;
}
/*____________________________________________________________________*/
/* open_domain is similar to 'defined2', but for the
interior of the domain. The proposition returned gives the condition
for f to be defined in a neighborhood of x of the specified kind and
direction. */
term open_domain(unsigned short f, term x, int kind, int dir)
{ term ans;
if(ENTIRE(f))
return true;
if(f==TAN || f==CSC || f==SEC || f==COT || f == GAMMA || f == DIGAMMA || f==POLYGAMMA)
{ if(kind == FULL)
return defined2(f,x);
/* now kind == PUNCTURED */
if(equals(x,infinity) || equals(x,minusinfinity))
return false; /* not defined in punctured nbhd of infinity*/
else
return true; /* defined in punctured nbhd of any finite point */
/* this isn't true intuitionistically! */
}
if(f==SQRT || f == LOG || f == LN )
{ if (equals(x,infinity) && kind == PUNCTURED && dir==LEFTDIR)
return true;
if (equals(x,minusinfinity) && kind == PUNCTURED && dir == RIGHTDIR)
return false;
if (dir == LEFTDIR || dir == CENTERED) /* punctured or not */
return positive(x);
if (dir == RIGHTDIR && kind == PUNCTURED)
return nonnegative(x);
}
if (f == ACOS || f == ASIN)
{ if (dir == CENTERED)
return and( lessthan(minusone,x),lessthan(x,one));
if (dir == RIGHTDIR)
return and( le(minusone,x),lessthan(x,one));
if (dir == LEFTDIR)
return and(lessthan(minusone,x),le(x,one));
}
if (f==ASEC || f == ACSC)
{ if (dir == CENTERED)
return or(lessthan(x,minusone),lessthan(one,x));
if (kind == FULL)
return or(lessthan(x,minusone),lessthan(one,x));
if (kind == PUNCTURED && (equals(x,infinity) || equals(x,minusinfinity)))
return true;
if (kind == PUNCTURED && dir == RIGHTDIR)
return or(le(x,minusone),lessthan(one,x));
if (kind == PUNCTURED && dir == LEFTDIR)
return or(lessthan(x,minusone),le(one,x));
}
SETFUNCTOR(ans,ILLEGAL,0);
return ans;
}
/*_________________________________________________________________*/
/* posval(f,x) returns a proposition which is true when f(x)
is positive. Note: none of these functions ever takes real values
for non-real complex arguments, so it doesn't matter for this function
whether we are speaking of complex or real variables.
In too-difficult cases it returns an illegal term.
*/
term posval(unsigned short f, term x)
{ term n,ans,w;
switch(f)
{ case SQRT: ans = lessthan(zero,x);
break;
case ABS: ans = nonzero(x);
break;
case SG: ans = lessthan(zero,x);
break;
case LOG: ans = lessthan(one,x);
break;
case LN: ans = lessthan(one,x);
break;
case SIN: n = getnewintvar1(x,intvarnames); /* get a new variable, preferably n */
ans = and(
lessthan(product3(two,n,pi),x),
lessthan(x,product(sum(product(two,n),one),pi))
);
set_ordered(&ans);
break;
case COS: n = getnewintvar1(x,intvarnames);
tneg(piover2,&w);
ans = and(
lessthan(sum(product3(two,n,pi),w),x),
lessthan(x,sum(product3(two,n,pi),piover2))
);
set_ordered(&ans);
break;
case COT: /* fall-through */
case TAN: n = getnewintvar1(x,intvarnames);
ans = and(
lessthan(product(n,pi),x),
lessthan(x,sum(product(n,pi), piover2))
);
set_ordered(&ans);
break;
case CSC: return posval(SIN,x);
case SEC: return posval(COS,x);
case ATAN: ans = lessthan(zero,x);
break;
case ACOT: return true;
case ASIN: ans = and(lessthan(zero,x),le(x,one));
break;
case ACOS: ans = and(le(minusone,x),lessthan(x,one));
break;
case ASEC: ans = or(le(minusone,x),le(one,x));
break;
case ACSC: ans = le(one,x);
break;
case SECH: /* fall-through */
case COSH: return true;
case CSCH: /* fall-through */
case COTH: /* fall-through */
case TANH: /* fall-through */
case SINH: ans = lessthan(zero,x);
break;
case ATANH: ans = and(lessthan(zero,x),lessthan(x,one));
break;
case ACOTH: ans = lessthan(one,x);
break;
case ASINH: ans = lessthan(zero,x);
break;
case ACOSH: ans = le(one,x);
break;
case ASECH: ans = and(lessthan(zero,x),lessthan(x,one));
break;
case ACSCH: ans = lessthan(zero,x);
break;
case POLYGAMMA: return defined2(POLYGAMMA,x); /* positive where defined */
case FACTORIAL: return defined2(FACTORIAL,x);
case GAMMA: n = getnewintvar1(x,intvarnames);
return or(lessthan(zero,x),
and3(
lessthan(sum(product(two,n),minusone),x),
lessthan(x,product(two,n)),
le(n,zero)
)
);
default: w = make_term(f,1);
ARGREP(w,0,x);
ans = lessthan(zero,w);
SET_ALREADY(ans);
return ans;
}
if(ATOMIC(x) && !get_binders())
SET_ALREADY(ans); /* speed up lpt calls */
return ans;
}
/*________________________________________________________________________*/
/* negval(f,x) returns a proposition true when f(x) is negative */
term negval(unsigned short f, term x)
{ term n,ans,w;
switch (f)
{ case SQRT: return false;
case ABS: return false;
case SG: return lessthan(x,zero);
case LOG: ans = and(lessthan(zero,x),lessthan(x,one));
break;
case LN: ans = and(lessthan(zero,x),lessthan(x,one));
break;
case SIN: n = getnewintvar1(x,intvarnames);
ans = and(
lessthan(sum(product(two,n),minusone),x),
lessthan(x,product3(two,n,pi))
);
set_ordered(&ans);
break;
case COS: n = getnewintvar1(x,intvarnames);
ans = and(
lessthan(sum(product3(two,n,pi),piover2),x),
lessthan(x,sum(product3(two,n,pi),make_fraction(product(three,pi),two)))
);
set_ordered(&ans);
break;
case COT: /* fall-through */
case TAN: n = getnewintvar1(x,intvarnames);
tneg(piover2,&w);
ans = and(
lessthan(sum(product(n,pi),w),x),
lessthan(x,product(n,pi))
);
break;
case CSC: return negval(SIN,x);
case SEC: return negval(COS,x);
case ATAN: ans = lessthan(x,zero);
break;
case ACOT: return false;
case ASIN: ans = and(le(minusone,x),lessthan(x,zero));
break;
case ACOS: return false;
case ASEC: return false;
case ACSC: return false;
case SECH: return false;
case COSH: return false;
case CSCH: /* fall-through */
case SINH: /* fall-through */
case COTH: /* fall-through */
case TANH: ans = lessthan(x,zero);
break;
case ATANH: ans = and(lessthan(minusone,x),lessthan(x,zero));
break;
case ACOTH: ans = lessthan(x,minusone);
break;
case ASINH: ans = lessthan(x,zero);
break;
case ACOSH: return false;
case ASECH: return false;
case ACSCH: ans = lessthan(x,zero);
break;
case POLYGAMMA: return false;
case FACTORIAL: return false;
case GAMMA: n = getnewintvar1(x,intvarnames);
return and3(lessthan(product(two,n),x),
lessthan(x,sum(product(two,n), one)),
lessthan(n,zero)
);
default: w = make_term(f,1);
ARGREP(w,0,x);
ans = lessthan(w,zero);
SET_ALREADY(ans);
return ans;
}
if(ATOMIC(x) && !get_binders())
SET_ALREADY(ans);
return ans;
}
/*_____________________________________________________________________*/
/* nonnegval(f,x) returns a proposition expressing that f(x) is nonnegative */
term nonnegval(unsigned short f, term x)
{ term n,ans,w;
switch(f)
{ case SQRT: ans = le(zero,x);
break;
case ABS: return true;
case SG: ans =le(zero,x);
break;
case LOG: ans = le(one,x);
break;
case LN: ans = le(one,x);
break;
case SIN: n = getnewintvar1(x,intvarnames);
ans = and(
le(product3(two,n,pi),x),
le(x,product(sum(product(two,n),one),pi))
);
set_ordered(&ans);
break;
case COS: n = getnewintvar1(x,intvarnames);
tneg(piover2,&w);
ans = and(
le(sum(product3(two,n,pi),w),x),
le(x,sum(product3(two,n,pi),piover2))
);
set_ordered(&ans);
break;
case TAN: n = getnewintvar1(x,intvarnames);
ans = and(
le(product(n,pi),x),
lessthan(x,sum(product(n,pi),piover2))
);
set_ordered(&ans);
break;
case COT: n = getnewintvar1(x,intvarnames);
ans = and(
lessthan(product(n,pi),x),
le(x,sum(product(n,pi),piover2))
);
set_ordered(&ans);
break;
case CSC: return posval(SIN,x);
case SEC: return posval(COS,x);
case POLYGAMMA: return defined2(POLYGAMMA,x);
case FACTORIAL: return defined2(FACTORIAL,x);
case GAMMA: return posval(GAMMA,x);
case ATAN: ans = le(zero,x);
break;
case ACOT: return true;
case ASIN: ans = and(le(minusone,x),le(x,one));
break;
case ACOS: ans = and(le(minusone,x),le(x,one));
break;
case ASEC: ans = or(le(x,minusone),le(one,x));
break;
case ACSC: ans = le(one,x);
break;
case SECH: /* fall-through */
case COSH: return true;
case CSCH: ans = lessthan(zero,x);
break;
case SINH: ans = le(zero,x);
break;
case COTH: ans = lessthan(zero,x);
break;
case TANH: ans = le(zero,x);
break;
case ATANH: ans = and(le(zero,x),lessthan(x,one));
break;
case ACOTH: ans = lessthan(one,x);
break;
case ASINH: ans = le(zero,x);
break;
case ACOSH: ans = le(one,x);
break;
case ASECH: ans = and(lessthan(zero,x),le(x,one));
break;
case ACSCH: ans = le(zero,x);
break;
default: w = make_term(f,1);
ARGREP(w,0,x);
ans = le(zero,w);
SET_ALREADY(ans);
return ans;
}
if(ATOMIC(x) && !get_binders())
SET_ALREADY(ans);
return ans;
}
/*___________________________________________________________________*/
/* nonposval(f,x) returns a proposition expression f(x) is nonpositive */
term nonposval(unsigned short f, term x)
{ term n,ans,w;
switch(f)
{ case SQRT: ans = equation(x,zero);
break;
case ABS: ans = equation(x,zero);
break;
case SG: ans = le(x,zero);
break;
case LOG: ans = and(lessthan(zero,x),le(x,one));
break;
case LN: ans = and(lessthan(zero,x),le(x,one));
break;
case SIN: n = getnewintvar1(x,intvarnames);
ans = and(
le(product(sum(product(two,n),minusone),pi),x),
le(x,product3(two,n,pi))
);
set_ordered(&ans);
break;
case COS: n = getnewintvar1(x,intvarnames);
ans = and(
le(sum(product3(two,n,pi),piover2),x),
le(x,sum(product3(two,n,pi),make_fraction(product(three,pi),two)))
);
set_ordered(&ans);
break;
case TAN: n = getnewintvar1(x,intvarnames);
tneg(piover2,&w);
ans = and(
lessthan(sum(product(n,pi),w),x),
le(x,product(n,pi))
);
set_ordered(&ans);
break;
case COT: n = getnewintvar1(x,intvarnames);
tneg(piover2,&w);
ans = and(
le(sum(product(n,pi),w),x),
lessthan(x,product(n,pi))
);
set_ordered(&ans);
break;
case CSC: return negval(SIN,x);
case SEC: return negval(COS,x);
case POLYGAMMA: return false;
case FACTORIAL: return false;
case GAMMA: return negval(GAMMA,x);
case ATAN: ans = le(x,zero);
break;
case ACOT: return false;
case ASIN: ans = and(le(minusone,x),le(x,zero));
break;
case ACOS: ans = equation(x,one);
break;
case ASEC: ans = equation(x,one);
break;
case ACSC: return false;
case SECH: /* fall-through */
case COSH: return false;
case CSCH: ans = lessthan(x,zero);
break;
case SINH: ans = le(x,zero);
break;
case COTH: ans = lessthan(x,zero);
break;
case TANH: ans = le(x,zero);
break;
case ATANH: ans = and(lessthan(minusone,x),le(x,zero));
break;
case ACOTH: ans = lessthan(x,minusone);
break;
case ASINH: ans = le(x,zero);
break;
case ACOSH: return false;
case ASECH: return false;
case ACSCH: ans = lessthan(x,zero);
break;
default: w = make_term(f,1);
ARGREP(w,0,x);
ans = le(w,zero);
SET_ALREADY(ans);
return ans;
}
if(ATOMIC(x) && !get_binders())
SET_ALREADY(ans);
return ans;
}
/*_______________________________________________________________*/
/* zeroval(f,x) returns a proposition expressing f(x)=0 */
term zeroval(unsigned short f, term x)
{ term n,w,ans;
int err;
switch(f)
{ case SQRT: /* fall through */
case ABS:
case ATAN:
case ASIN:
case SINH:
case TANH:
case ASINH:
case ATANH:
err = zeroes(x,&ans);
if(err > 1)
ans = equation(x,zero);
break;
case SG:
return equation(x,zero);
case LOG:
ans = equation(x,one);
break;
case LN:
ans = equation(x,one);
break;
case TAN: /* fall-through */
case SIN:
n = getnewintvar1(x,intvarnames);
ans = equation(x,product(n,pi));
SETORDERED(ARG(1,ans));
break;
case COT: /* fall-through */
case COS:
n = getnewintvar1(x,intvarnames);
ans = equation(x,make_fraction(product(sum(product(two,n),one),pi),two));
SETORDERED(ARG(0,ARG(0,ARG(0,ARG(1,ans)))));
break;
case CSC:
return false;
case SEC:
case ACOT:
return false;
case ACOS:
ans = equation(x,one);
break;
case ASEC:
ans = equation(x,one);
break;
case ACSC: /* fall through */
case SECH:
case COSH:
case COTH:
case CSCH:
case ACOTH:
case ACSCH:
return false;
case ACOSH:
ans = equation(x,one); /* even in the complex case */
break;
case ASECH:
ans = equation(x,one); /* even in the complex case */
break;
case POLYGAMMA: /* fall through */
case FACTORIAL:
case GAMMA:
return false;
default:
w = make_term(f,1);
ARGREP(w,0,x);
ans = equation(w,zero);
SET_ALREADY(ans);
return ans;
}
if(ATOMIC(x) && !get_binders())
SET_ALREADY(ans);
return ans;
}
/*_______________________________________________________________*/
/* singular(f,x) returns a proposition expressing that one or both
one-sided limits are � infinity */
/* This gets the REAL singularities, since it's used for graphing. */
/* x is not allowed to be infinity */
term singular(unsigned short f, term x)
{ term n,ans;
int err;
switch(f)
{ case LOG:
break;
case LN:
break;
case SEC: /* fall-through */
case TAN:
return zeroval(COS,x);
case COT: /* fall-through */
case CSC:
return zeroval(SIN,x);
case COTH:
break;
case ASECH:
break;
case ACSCH:
break;
case CSCH:
break;
case ACOTH: /* fall-through */
case ATANH:
return and(equation(x,one),equation(x,minusone));
case DIGAMMA: /* fall-through */
case POLYGAMMA:
case FACTORIAL:
return false; /* it's only defined on nonnegative ints */
case GAMMA:
n = getnewintvar1(x,intvarnames);
return and(equation(x,n),le(n,zero));
default:
return false;
}
err = zeroes(x,&ans);
if(err > 1)
ans = equation(x,zero);
return ans;
}
/*_______________________________________________________________*/
/* singular4(f,x,dir,sign) returns a proposition expressing that the one-sided
limit from direction dir is infinity (if sign > 0) or minusinfinity (if sign < 0) */
/* x is allowed to be infinity or minusinfinity */
term singular4(unsigned short f, term x,int dir, int sign)
{ term n,ans;
switch(f)
{ case LOG: /* deliberate fall-through */
case LN: if(dir==RIGHTDIR && sign < 0 )
return equation(x,zero);
else if(dir==LEFTDIR && sign > 0)
return equation(x,infinity);
return false;
case TAN: if(sign > 0 && dir == LEFTDIR)
return zeroval(COS,x);
if(sign < 0 && dir == RIGHTDIR)
return zeroval(COS,x);
return false;
case COT: if(sign < 0 && dir == LEFTDIR)
return zeroval(SIN,x);
if(sign > 0 && dir == RIGHTDIR)
return zeroval(SIN,x);
return false;
case CSC: if((sign > 0 && dir==LEFTDIR) || (sign < 0 && dir==RIGHTDIR))
{ n = getnewintvar1(x,intvarnames);
return equation(x,product3(two,pi,n));
}
if((sign > 0 && dir==RIGHTDIR) || (sign < 0 && dir==LEFTDIR))
{ n = getnewintvar1(x,intvarnames);
ans = equation(x,product(sum(product(two,n),one),pi));
SETORDERED(ARG(0,ARG(1,ans)));
return ans;
}
case SEC: if((sign > 0 && dir==LEFTDIR) || (sign < 0 && dir==RIGHTDIR))
{ n = getnewintvar1(x,intvarnames);
ans = equation(x,sum(product3(two,n,pi),make_fraction(pi,four)));
SETORDERED(ARG(1,ans));
return ans;
}
if((sign > 0 && dir==RIGHTDIR) || (sign < 0 && dir==LEFTDIR))
{ n = getnewintvar1(x,intvarnames);
ans = equation(x,sum(product3(two,n,pi),tnegate(make_fraction(pi,four))));
SETORDERED(ARG(0,ans));
return ans;
}
case CSCH: /* fall-through */
case COTH: if(sign < 0 && dir == LEFTDIR)
return equation(x,zero);
if(sign > 0 && dir == RIGHTDIR)
return equation(x,zero);
return false;
case ASECH: if(dir == RIGHTDIR && sign > 0)
return equation(x,zero);
return false;
case ACSCH: if(dir == LEFTDIR && sign < 0)
return equation(x,zero);
if(dir == RIGHTDIR && sign > 0)
return equation(x,zero);
return false;
case ACOTH: if(dir == LEFTDIR && sign < 0)
return equation(x,minusone);
if(dir == RIGHTDIR && sign > 0)
return equation(x,one);
return false;
case ATANH: if(dir == RIGHTDIR && sign < 0)
return equation(x,minusone);
if(dir == LEFTDIR && sign > 0)
return equation(x,one);
return false;
case POLYGAMMA:
if(sign < 0) return false;
n = getnewintvar1(x,intvarnames);
return and(equation(x,n),le(n,zero));
case DIGAMMA:
if(sign > 0) /* nonpositive even integers */
{ n = getnewintvar1(x,intvarnames);
return and(le(n,zero),
equation(x,product(two,n))
);
}
else
{ n = getnewintvar1(x,intvarnames);
return and(lessthan(n,zero),
equation(x,sum(product(two,n),one))
);
}
case GAMMA: if( (sign > 0 && dir == RIGHTDIR) /* +infinity from right */
|| (sign < 0 && dir == LEFTDIR) /* -infinity from left */
)
{ n = getnewintvar1(x,intvarnames);
return and(le(n,zero),
equation(x,product(two,n))
);
}
if( (sign < 0 && dir == RIGHTDIR) /* -infinity from right */
|| (sign > 0 && dir == LEFTDIR) /* +infinity from left */
)
{ n = getnewintvar1(x,intvarnames);
return and(lessthan(n,zero),
equation(x,sum(product(two,n),one))
);
}
default:
return false;
}
}
/*_______________________________________________________________*/
// #pragma argsused /* doesn't depend on index as it turns out */
term bessel_singularity(unsigned short f,term index, term x,int dir, int sign)
/* f must be a Bessel functor; together with 'index' this specifies
a Bessel function. Return a proposition expressing
that f(index, x) has a singularity of the specified sign when x is approached
from the specified direction, i.e. lim(z->x�,f(x)) = �infinity
where dir and sign specify the two � signs. */
{ switch(f)
{ case BESSELJ: break;
case BESSELI: break;
case BESSELY: return ((sign < 0 && dir == RIGHTDIR) ? equation(x,zero): false);
/* the Y's have a negative singularity */
case BESSELK: return ((sign > 0 && dir == RIGHTDIR) ? equation(x,zero) : false);
/* and the K's have a positive one */
}
return false;
}
/*_______________________________________________________________*/
term nonzeroval(unsigned short f, term x)
/* return a proposition P(x) such that P(x) <--> f(x) != 0 */
{ term n,ans,s;
int err;
term u,v;
switch(f)
{ case SQRT: ans = (get_complex() ? nonzero(x) : positive(x));
break;
case ABS: ans = nonzero(x);
break;
case SG: ans = nonzero(x);
break;
case LOG: ans = and(lessthan(zero,x),ne(x,one));
break;
case LN: ans = and(lessthan(zero,x),ne(x,one));
break;
case SIN: if(get_binders() && !stdpartonly(x,&s) && !equals(x,s))
/* example, lim(x->pi/3, cot x) */
/* !stdpartonly means it's a limit problem,
and s is the standard part of x.
!equals(x,s) means that the expression
x involves the limit variable. */
{ err = check(nonzero(s));
if(!err)
{ /* if the standard part of x is nonzero then
sin x is nonzero too. */
return true;
}
/* Since we used check instead of infer,
if we get here then s is equal to zero */
err = nonstandard(ne(sin1(x),zero),&ans);
if(!err)
return ans;
/* else an expression involving x will
be returned by the code below */
}
if(get_complex())
{ if(complexparts(x,&u,&v)==0)
x = u;
else
{ u = re(x);
v = im(x);
x = u;
}
if(ZERO(x))
{ ans = nonzero(v);
break;
}
}
n = getnewintvar1(x,intvarnames);
if(FUNCTOR(x) == '*')
{ term a,b,c,s;
ratpart2(x,&c,&s);
if(FRACTION(c))
{ a = ARG(0,c);
b = ARG(1,c);
ans = and(lessthan(make_fraction(product3(b,n,pi),a),s),
lessthan(s,make_fraction(product3(b,sum(n,one),pi),a))
);
}
else if(!ONE(c))
{ ans = and(
lessthan(make_fraction(product(n,pi),c),s),
lessthan(s,make_fraction(product(sum(n,one),pi),c))
);
}
else /* if(ONE(c)) */
{ ans = and(
lessthan(product(n,pi),s),
lessthan(s,product(sum(n,one),pi))
);
}
}
else
{ ans = and(
lessthan(product(n,pi),x),
lessthan(x,product(sum(n,one),pi))
);
}
set_ordered(&ans);
if(get_complex())
ans = or(ans,nonzero(v));
break;
case COS: if(get_binders() && !stdpartonly(x,&s) && !equals(x,s))
/* example, lim(x->pi/3, sec x) */
{ err = check(nonzero(s));
if(!err)
{ /* if the standard part of x is nonzero then
sin x is nonzero too. */
return true;
}
/* Since we used check instead of infer,
if we get here then s is equal to zero */
err = nonstandard(ne(cos1(x),zero),&ans);
if(!err)
return ans;
/* else an expression involving x will
be returned by the code below */
}
n = getnewintvar1(x,intvarnames);
if(get_complex())
{ if(complexparts(x,&u,&v)==0)
x = u;
else
{ u = re(x);
v = im(x);
x = u;
}
if(ZERO(x))
{ ans = nonzero(v);
break;
}
}
ans = and(
lessthan(sum(product(n,pi),tnegate(piover2)),x),
lessthan(x,sum(product(n,pi),piover2))
);
/* It would be fatal to set u = product(n,pi) and use
u twice in defining ans, because that creates a DAG
instead of a tree for a term, and when destroy_term
is called on it, when the second occurrence is reached,
the argptr points to garbage, which is then destroyed
causing a crash. Actually, NOW this situation will
be caught by destroy_term, because free2 leaves 255 in
the bits of a freed block that will be read as a functor. */
set_ordered(&ans);
if(get_complex())
ans = or(ans,nonzero(v));
break;
case COT: /* fall-through */
case TAN: if(get_complex())
{ if(complexparts(x,&u,&v)==0)
x = u;
else
{ u = re(x);
v = im(x);
x = u;
}
if(ZERO(x))
{ ans = nonzero(v);
break;
}
}
n = getnewintvar1(x,intvarnames);
ans = and(
lessthan(make_fraction(product(n,pi),two),x),
lessthan(x,make_fraction(product(sum(n,one),pi),two))
);
set_ordered(&ans);
if(get_complex())
ans = or(ans,nonzero(v));
break;
case CSC: return defined2(CSC,x);
case SEC: return defined2(SEC,x);
case ATAN: if(get_complex())
/* see pp. 79-80 of Abramowitz and Stegun for the complex case */
ans = and(nonzero(x),defined2(ATAN,x));
else
ans = nonzero(x);
break;
case ACOT: if(get_complex())
return defined2(ACOT,x);
else
ans = nonzero(x);
/* acot never takes the value 0, but it's undefined at 0. */
break;
case ASIN: if(get_complex())
ans = and(nonzero(x),defined2(ASIN,x));
/* see p. 80 of Abramowitz and Stegun */
else
ans = or(
and(le(minusone,x),lessthan(x,zero)),
and(lessthan(zero,x),le(x,one))
);
break;
case ACOS: if(get_complex())
ans = and(ne(x,one),defined2(ACOS,x));
/* see p. 80 of Abramowitz and Stegun */
else
ans = posval(ACOS,x);
break;
case ASEC: if(get_complex())
ans = defined2(ASEC,x);
else
ans = posval(ASEC,x);
break;
case ACSC: return defined2(ACSC,x);
case COSH: if(get_complex())
/* zeroes of cosh are at k pi i + i pi/2 */
{ n = getnewintvar1(x,intvarnames);
if(complexparts(x,&u,&v)==0)
x = u;
else
{ u = re(x);
v = im(x);
x = u;
}
ans = or(
nonzero(x),
and(
lessthan(sum(make_fraction(pi,two),product(n,pi)),v),
lessthan(v,sum(make_fraction(pi,two),product(sum(n,one),pi)))
)
);
set_ordered(&ans);
}
else
return true;
case SINH: if(get_complex())
/* zeroes of sinh are at k pi i */
{ n = getnewintvar1(x,intvarnames);
if(complexparts(x,&u,&v)==0)
x = u;
else
{ u = re(x);
v = im(x);
x = u;
}
ans = or(
nonzero(x),
and(
lessthan(product(n,pi),v),
lessthan(v,product(sum(n,one),pi))
)
);
set_ordered(&ans);
}
else
ans = nonzero(x);
break;
case TANH: if(get_complex())
/* zeroes of tanh are at k pi i, zeroes of cosh at k pi i + i pi/2,
so together they are at k i pi/2 */
{ n = getnewintvar1(x,intvarnames);
if(complexparts(x,&u,&v)==0)
x = u;
else
{ u = re(x);
v = im(x);
x = u;
}
ans = or(
nonzero(x),
and(
lessthan(make_fraction(product(n,pi),two),v),
lessthan(v,make_fraction(product(sum(n,one),pi),two))
)
);
set_ordered(&ans);
}
else
ans = nonzero(x);
break;
case COTH: return defined2(COTH,x);
case SECH: return true;
case CSCH: return defined2(CSCH,x);
case ACOSH: ans = lessthan(one,x);
break;
case ASINH: ans = nonzero(x);
break;
case ATANH: ans = and(lessthan(zero,abs1(x)),lessthan(abs1(x),one));
break;
case ACOTH: return defined2(ACOTH,x);
case ASECH: if(get_complex())
ans = ne(x,one);
else
ans = and(lessthan(zero,x),lessthan(x,one));
break;
case ACSCH: return defined2(ACSCH,x);
case POLYGAMMA: return true;
case GAMMA: return true;
case FACTORIAL: return true;
case BESSELJ:
case BESSELK:
case BESSELY:
case BESSELI:
case DIGAMMA: break; /* too difficult */
case CONSTANTOFINTEGRATION:
ans = make_term(f,1);
ARGREP(ans,0,x);
return ne(ans,zero);
default: /* for example f(x) where f is a function variable */
s = make_term(f,1);
ARGREP(s,0,x);
return nonzero(s);
}
if(ISATOM(x) && !get_binders()) /* Not ATOMIC as if x is a number ans may simplify */
SET_ALREADY(ans); /* speed up lpt calls */
return ans;
}
/*__________________________________________________________________*/
/* returns a proposition expressing that f(x) is increasing in a
neigborhood of a of the specified kind and direction (see above for
the meaning of 'kind' and 'direction') */
term increasing(unsigned short f, term a, int kind, int dir)
{ term ans;
switch(f)
{ case SQRT:
if(dir==RIGHTDIR)
return nonnegative(a);
else
return positive(a);
case LN:
/* deliberate fall-through */
case LOG:
if(dir==RIGHTDIR && kind==PUNCTURED)
return nonnegative(a);
else
return positive(a);
case ATAN:
return true;
case SIN:
if(dir==RIGHTDIR)
return and(nonnegative(cos1(a)),lessthan(sin1(a),one));
if(dir==LEFTDIR)
return and(nonnegative(cos1(a)),lessthan(minusone,sin1(a)));
if(dir==CENTERED)
return positive(cos1(a));
case COS:
if(dir==RIGHTDIR)
return and(nonpositive(sin1(a)),lessthan(cos1(a),one));
if(dir==LEFTDIR)
return and(nonnegative(sin1(a)),lessthan(minusone,cos1(a)));
if(dir==CENTERED)
return negative(sin1(a));
case TAN:
if(dir==CENTERED)
return nonzero(cos1(a));
else
return true; /* intuitionistically false */
case COT:
return false;
case ASIN:
return defined2(ASIN,a);
case ACOS:
return false;
case CSC:
return decreasing(SIN,a,kind,dir);
case SEC:
return decreasing(COS,a,kind,dir);
case ABS:
if(dir==RIGHTDIR)
return nonnegative(a);
else
return positive(a);
case COSH:
if(dir==RIGHTDIR)
return nonnegative(a);
else
return positive(a);
case SINH:
return true;
case TANH:
return true;
case DIGAMMA:
return defined2(DIGAMMA,a);
case BESSELJ: /* these cases are too difficult, we don't know the zeros */
case BESSELK:
case BESSELY:
case BESSELI:
case POLYGAMMA:
break;
}
/* Note: MATHPERT doesn't know anything about where Bessel functions
increasing or decreasing: this requires introducing a notation for the
n-th zero of these functions. It also knows nothing about GAMMA. */
SETFUNCTOR(ans,ILLEGAL,0);
return ans;
}
/*_____________________________________________________________________*/
term decreasing(unsigned short f, term a, int kind, int dir)
/* return a proposition expressing that f(x) is decreasing in a neighborhood
of a of the specified kind and direction */
{ term ans;
switch(f)
{ case SQRT: /* deliberate fall-through */
case LN:
case LOG:
case TAN:
case ATAN:
return false;
case SIN:
if(dir==RIGHTDIR)
return and(nonpositive(cos1(a)),lessthan(minusone,sin1(a)));
if(dir==LEFTDIR)
return and(nonpositive(cos1(a)),lessthan(sin1(a),one));
else
return negative(cos1(a));
case COS:
if(dir==RIGHTDIR)
return and(nonnegative(sin1(a)),lessthan(minusone,cos1(a)));
if(dir==LEFTDIR)
return and(nonnegative(sin1(a)),lessthan(cos1(a),one));
else
return positive(sin1(a));
case COT:
return increasing(TAN,a,kind,dir); /* in view of cot = 1/tan */
case ASIN:
return false;
case ACOS:
return defined2(ACOS,a);
case CSC:
return increasing(COS,a,kind,dir);
case ABS:
if(dir==LEFTDIR)
return nonpositive(a);
else
return negative(a);
case COSH:
if(dir==LEFTDIR)
return nonpositive(a);
else
return negative(a);
case SINH: /* fall-through */
case TANH:
return false;
case DIGAMMA:
return false;
case BESSELJ: /* these cases are too difficult, we don't know the zeros */
case BESSELK:
case BESSELY:
case BESSELI:
case POLYGAMMA: break;
}
SETFUNCTOR(ans,ILLEGAL,0);
return ans;
}
/*________________________________________________________________*/
int rootinfo(unsigned short f, term b, term *ans)
/* b has functor ROOT; f is NE, LE, or '<'; determine
the conditions for the inequality 0 f b to hold and
return them in *ans. Return 0 for success, 1 for failure */
{ term index = ARG(0,b);
switch(f)
{ case NE:
*ans = nonzero(ARG(1,b));
return 0;
case LE:
if(INTEGERP(index) && ISODD(index))
{ *ans = le(zero,ARG(1,b));
return 0;
}
else if(INTEGERP(index))
{ *ans = le(zero,ARG(1,b));
return 0;
}
else
return 1;
case '<':
if(INTEGERP(index) && ISODD(index))
{ *ans = lessthan(zero,ARG(1,b));
return 0;
}
else if(INTEGERP(index))
{ *ans = lessthan(zero,ARG(1,b));
return 0;
}
else
return 1;
default:
assert(0);
}
return 1; /* avoid a warning message */
}
/*_______________________________________________________________*/
static void set_ordered(term *t)
/* t is an interval describing a domain of a trig function.
Use SETORDERED on the (n+1) terms */
{ unsigned short f = FUNCTOR(*t);
if(ATOMIC(*t))
return;
if(f == AND)
{ set_ordered(ARGPTR(ARG(0,*t)));
set_ordered(ARGPTR(ARG(1,*t))+1);
return;
}
if(f == '+')
{ SETORDERED(*t);
return;
}
if(f == '*' || f == '/')
{ set_ordered(ARGPTR(*t));
set_ordered(ARGPTR(*t)+1);
return;
}
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists