Sindbad~EG File Manager
/* Beeson, Mathpert; information about open domains of functions */
/*
1.29.91 original date
10.30.99 last modified
8.24.07 modified nonzeroval for POLYGAMMA
9.8.07 corrected negval on SIN
5.1.13 wrote getindexvar
5.2.13 corrected getindexvar
1.3.25 made zeroval return ILLEGAL if we're out of variables
*/
#include <assert.h>
#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 *);
/*____________________________________________________________________*/
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;
}
/*____________________________________________________________*/
term getindexvar(term t, char *data)
/* get an existing BOUND integer variable that doesn't
occur in t, or else make a new one */
{ term *varlist = get_varlist();
varinf *varinfo = get_varinfo();
int i;
int n = get_nvariables();
for(i=n-1;i>=0;i--)
{ if(varinfo[i].scope == BOUND && varinfo[i].type == INTEGER && !contains(t,FUNCTOR(varlist[i])))
return varlist[i];
}
return getnewindexvar(t,data);
}
/*____________________________________________________________*/
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 trueterm;
if(f==TAN || f==CSC || f==SEC || f==COT || f == GAMMA || f == DIGAMMA)
{ if(kind == FULL)
return defined2(f,x);
/* now kind == PUNCTURED */
if(equals(x,infinity) || equals(x,minusinfinity))
return falseterm; /* not defined in punctured nbhd of infinity*/
else
return trueterm; /* 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 trueterm;
if (equals(x,minusinfinity) && kind == PUNCTURED && dir == RIGHTDIR)
return falseterm;
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 trueterm;
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 ABSFUNCTOR: 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_term),x),
lessthan(x,product(sum(product(two,n),one),pi_term))
);
set_ordered(&ans);
break;
case COS: n = getnewintvar1(x,intvarnames);
tneg(piover2,&w);
ans = and(
lessthan(sum(product3(two,n,pi_term),w),x),
lessthan(x,sum(product3(two,n,pi_term),piover2))
);
set_ordered(&ans);
break;
case COT: /* fall-through */
case TAN: n = getnewintvar1(x,intvarnames);
ans = and(
lessthan(product(n,pi_term),x),
lessthan(x,sum(product(n,pi_term), 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 trueterm;
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 trueterm;
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 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 falseterm;
case ABSFUNCTOR: return falseterm;
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(product(sum(product(two,n),minusone),pi_term),x),
lessthan(x,product3(two,n,pi_term))
);
set_ordered(&ans);
break;
case COS: n = getnewintvar1(x,intvarnames);
ans = and(
lessthan(sum(product3(two,n,pi_term),piover2),x),
lessthan(x,sum(product3(two,n,pi_term),make_fraction(product(three,pi_term),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_term),w),x),
lessthan(x,product(n,pi_term))
);
break;
case CSC: return negval(SIN,x);
case SEC: return negval(COS,x);
case ATAN: ans = lessthan(x,zero);
break;
case ACOT: return falseterm;
case ASIN: ans = and(le(minusone,x),lessthan(x,zero));
break;
case ACOS: return falseterm;
case ASEC: return falseterm;
case ACSC: return falseterm;
case SECH: return falseterm;
case COSH: return falseterm;
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 falseterm;
case ASECH: return falseterm;
case ACSCH: ans = lessthan(x,zero);
break;
case POLYGAMMA: return falseterm;
case FACTORIAL: return falseterm;
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 ABSFUNCTOR: return trueterm;
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_term),x),
le(x,product(sum(product(two,n),one),pi_term))
);
set_ordered(&ans);
break;
case COS: n = getnewintvar1(x,intvarnames);
tneg(piover2,&w);
ans = and(
le(sum(product3(two,n,pi_term),w),x),
le(x,sum(product3(two,n,pi_term),piover2))
);
set_ordered(&ans);
break;
case TAN: n = getnewintvar1(x,intvarnames);
ans = and(
le(product(n,pi_term),x),
lessthan(x,sum(product(n,pi_term),piover2))
);
set_ordered(&ans);
break;
case COT: n = getnewintvar1(x,intvarnames);
ans = and(
lessthan(product(n,pi_term),x),
le(x,sum(product(n,pi_term),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 trueterm;
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 trueterm;
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 ABSFUNCTOR: 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_term),x),
le(x,product3(two,n,pi_term))
);
set_ordered(&ans);
break;
case COS: n = getnewintvar1(x,intvarnames);
ans = and(
le(sum(product3(two,n,pi_term),piover2),x),
le(x,sum(product3(two,n,pi_term),make_fraction(product(three,pi_term),two)))
);
set_ordered(&ans);
break;
case TAN: n = getnewintvar1(x,intvarnames);
tneg(piover2,&w);
ans = and(
lessthan(sum(product(n,pi_term),w),x),
le(x,product(n,pi_term))
);
set_ordered(&ans);
break;
case COT: n = getnewintvar1(x,intvarnames);
tneg(piover2,&w);
ans = and(
le(sum(product(n,pi_term),w),x),
lessthan(x,product(n,pi_term))
);
set_ordered(&ans);
break;
case CSC: return negval(SIN,x);
case SEC: return negval(COS,x);
case POLYGAMMA: return falseterm;
case FACTORIAL: return falseterm;
case GAMMA: return negval(GAMMA,x);
case ATAN: ans = le(x,zero);
break;
case ACOT: return falseterm;
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 falseterm;
case SECH: /* fall-through */
case COSH: return falseterm;
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 falseterm;
case ASECH: return falseterm;
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,
or ILLEGAL if we ran out of variables.
*/
term zeroval(unsigned short f, term x)
{ term n,w,ans;
int err;
switch(f)
{ case SQRT: /* fall through */
case ABSFUNCTOR:
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);
if(FUNCTOR(n) == ILLEGAL) // out of variables
{ SETFUNCTOR(ans, ILLEGAL,0);
return ans;
}
ans = equation(x,product(n,pi_term));
SETORDERED(ARG(1,ans));
break;
case COT: /* fall-through */
case COS:
n = getnewintvar1(x,intvarnames);
if(FUNCTOR(n) == ILLEGAL) // out of variables
{ SETFUNCTOR(ans, ILLEGAL,0);
return ans;
}
ans = equation(x,make_fraction(product(sum(product(two,n),one),pi_term),two));
SETORDERED(ARG(0,ARG(0,ARG(0,ARG(1,ans)))));
break;
case CSC:
return falseterm;
case SEC:
case ACOT:
return falseterm;
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 falseterm;
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 falseterm;
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 plus or minus 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 GAMMA:
n = getnewintvar1(x,intvarnames);
return and(equation(x,n),le(n,zero));
case FACTORIAL:
return falseterm; /* it's only defined on nonnegative ints */
default:
return falseterm;
}
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 falseterm;
case TAN: if(sign > 0 && dir == LEFTDIR)
return zeroval(COS,x);
if(sign < 0 && dir == RIGHTDIR)
return zeroval(COS,x);
return falseterm;
case COT: if(sign < 0 && dir == LEFTDIR)
return zeroval(SIN,x);
if(sign > 0 && dir == RIGHTDIR)
return zeroval(SIN,x);
return falseterm;
case CSC: if((sign > 0 && dir==LEFTDIR) || (sign < 0 && dir==RIGHTDIR))
{ n = getnewintvar1(x,intvarnames);
return equation(x,product3(two,pi_term,n));
}
if((sign > 0 && dir==RIGHTDIR) || (sign < 0 && dir==LEFTDIR))
{ n = getnewintvar1(x,intvarnames);
ans = equation(x,product(sum(product(two,n),one),pi_term));
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_term),make_fraction(pi_term,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_term),tnegate(make_fraction(pi_term,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 falseterm;
case ASECH: if(dir == RIGHTDIR && sign > 0)
return equation(x,zero);
return falseterm;
case ACSCH: if(dir == LEFTDIR && sign < 0)
return equation(x,zero);
if(dir == RIGHTDIR && sign > 0)
return equation(x,zero);
return falseterm;
case ACOTH: if(dir == LEFTDIR && sign < 0)
return equation(x,minusone);
if(dir == RIGHTDIR && sign > 0)
return equation(x,one);
return falseterm;
case ATANH: if(dir == RIGHTDIR && sign < 0)
return equation(x,minusone);
if(dir == LEFTDIR && sign > 0)
return equation(x,one);
return falseterm;
case POLYGAMMA:
if(sign < 0) return falseterm;
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 falseterm;
}
}
/*_______________________________________________________________*/
// #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 \pm ,f(x)) = \pm infinity
where dir and sign specify the two \pm signs. */
{ switch(f)
{ case BESSELJ: break;
case BESSELI: break;
case BESSELY: return ((sign < 0 && dir == RIGHTDIR) ? equation(x,zero): falseterm);
/* the Y's have a negative singularity */
case BESSELK: return ((sign > 0 && dir == RIGHTDIR) ? equation(x,zero) : falseterm);
/* and the K's have a positive one */
}
return falseterm;
}
/*_______________________________________________________________*/
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 ABSFUNCTOR: 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 = check1(nonzero(s));
if(!err)
{ /* if the standard part of x is nonzero then
sin x is nonzero too. */
return trueterm;
}
/* 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_term),a),s),
lessthan(s,make_fraction(product3(b,sum(n,one),pi_term),a))
);
}
else if(!ONE(c))
{ ans = and(
lessthan(make_fraction(product(n,pi_term),c),s),
lessthan(s,make_fraction(product(sum(n,one),pi_term),c))
);
}
else /* if(ONE(c)) */
{ ans = and(
lessthan(product(n,pi_term),s),
lessthan(s,product(sum(n,one),pi_term))
);
}
}
else
{ ans = and(
lessthan(product(n,pi_term),x),
lessthan(x,product(sum(n,one),pi_term))
);
}
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 = check1(nonzero(s));
if(!err)
{ /* if the standard part of x is nonzero then
sin x is nonzero too. */
return trueterm;
}
/* 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_term),tnegate(piover2)),x),
lessthan(x,sum(product(n,pi_term),piover2))
);
/* It would be fatal to set u = product(n,pi_term) 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_term),two),x),
lessthan(x,make_fraction(product(sum(n,one),pi_term),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_term,two),product(n,pi_term)),v),
lessthan(v,sum(make_fraction(pi_term,two),product(sum(n,one),pi_term)))
)
);
set_ordered(&ans);
}
else
return trueterm;
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_term),v),
lessthan(v,product(sum(n,one),pi_term))
)
);
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_term),two),v),
lessthan(v,make_fraction(product(sum(n,one),pi_term),two))
)
);
set_ordered(&ans);
}
else
ans = nonzero(x);
break;
case COTH: return defined2(COTH,x);
case SECH: return trueterm;
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 GAMMA: return trueterm;
case FACTORIAL: return trueterm;
case BESSELJ:
case BESSELK:
case BESSELY:
case BESSELI:
case DIGAMMA: break; /* too difficult */
case POLYGAMMA: 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 trueterm;
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 trueterm; /* intuitionistically false */
case COT:
return falseterm;
case ASIN:
return defined2(ASIN,a);
case ACOS:
return falseterm;
case CSC:
return decreasing(SIN,a,kind,dir);
case SEC:
return decreasing(COS,a,kind,dir);
case ABSFUNCTOR:
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 trueterm;
case TANH:
return trueterm;
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 falseterm;
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 falseterm;
case ACOS:
return defined2(ACOS,a);
case CSC:
return increasing(COS,a,kind,dir);
case ABSFUNCTOR:
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 falseterm;
case DIGAMMA:
return falseterm;
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