Sindbad~EG File Manager
/* M. Beeson, for Mathpert's prover.
nonstandard, an auxiliary function used by reduce_ineq to get rid of
bound limit variables correctly. Based on nonstandard analysis, as
described in detail in a paper published in the International Journal
for the Foundations of Computer Science.
*/
/*
6.10.92 original date
1.29.98 last modified
9.26.14 added return 1 at line 345
*/
#include <assert.h>
#include <math.h> /* fabs */
#include "globals.h"
#include "prover.h"
#include "pvalaux.h"
#include "deval.h"
#include "cancel.h"
static int stdpart(term t, term *s, term *ns);
static int get_parity(term t, int *parity);
/*___________________________________________________________________*/
int nonstandard(term t, term *ans)
/* called by reduce_ineq on an inequality t. Reduce it if possible
using infinitesimals, eliminating bound limit variables. Return
0 for success, 1 for failure. This will fail to eliminate infinitesimals
if the leading term can't be calculated, but then reduce_ineq will
simplify the inequality further using posval etc and lpt will put it
back through reduce_ineq again, so we'll get another try on some
simpler pieces. */
{ term a,b,z,sa,sb,nsa,nsb,h,p,u,n,q,x;
int sign,erra,errb,err,parity;
unsigned short f = FUNCTOR(t);
unsigned short g;
double za, zb;
assert(f==LE || f == '<' || f == NE);
err = get_infinitesimal(&h,&z,&q); /* by extraction from binders list */
if(err) /* no infinitesimals */
return 1;
if(!contains(t,FUNCTOR(h)) && !DEPENDENT(h))
return 1; /* no infinitesimals relevant to t */
if(DEPENDENT(h) && !contains(t,FUNCTOR(h)))
/* lim(x-> \pm infinity) was entered, so h is let-defined as
1/x and z is zero */
{ /* find the variable x by looking at dependency information
in varinfo entry for h */
int i,j;
int nvariables = get_nvariables();
term *varlist = get_varlist();
varinf *varinfo = get_varinfo();
term inf = ZERO(ARG(0,q)) ? infinity : minusinfinity;
/* the limit is taken as x->inf */
term newlim;
for(i=0;i<nvariables; i++)
{ if(equals(h,varlist[i]))
break;
}
assert(i<nvariables); /* h must be in varlist somewhere */
for(j=0;j<32;j++) /* find out which bit of varinfo[i].dp is set */
{ if (0x1 & (varinfo[i].dp >> j))
break;
}
assert(j < 32); /* the j-th bit of varinfo[i].dp is set */
x = varlist[j];
if(!contains(t,FUNCTOR(x)))
return 1;
/* Now take the limit as x-> inf */
u = ZERO(ARG(0,t)) ? ARG(1,t) : sum(ARG(1,t),tnegate(ARG(0,t)));
newlim = limit(arrow(x,inf),u);
err = limval(newlim,&q);
if(err)
return 1; /* too complicated */
if(equals(q,infinity))
{ *ans = trueterm;
return 0;
}
if(equals(q,minusinfinity))
{ *ans = f == NE ? trueterm : falseterm;
return 0;
}
if(equals(q,unbounded_oscillations))
{ *ans = falseterm;
return 0;
}
if(NOTDEFINED(q))
return 1; /* failure even though SOME answer was obtained
for the limit */
if(!ZERO(q))
{ double zz;
deval(q,&zz); /* using default (random) values of any variable in q */
if(zz != 0)
{ *ans = f == NE ? ne(q,zero) : f == LE ? le(zero,q) : lessthan(zero,q);
return 0;
}
}
/* The limit was zero. Take the leading term. */
err = leading_term(u,x,inf,&p,&n);
if(err)
return 1;
if(equals(inf,infinity) || f == NE || EVEN(n))
{ *ans = f == NE ? trueterm : f == LE ? le(zero,p) : lessthan(zero,p);
return 0;
}
else /* inf == -infinity and n is odd */
{ *ans = f == LE ? le(p,zero) : lessthan(p,zero);
return 0;
}
}
g = FUNCTOR(q);
a = ARG(0,t);
b = ARG(1,t);
erra = stdpart(a,&sa,&nsa);
if(erra==1)
return 1;
errb = stdpart(b,&sb,&nsb);
if(errb==1)
return 1;
if(errb==2 && erra==2)
return 1;
if(errb==2) /* sa finite, sb infinite */
{ if(NEGATIVE(sb) && (f == '<' || f == LE))
{ assert(equals(ARG(0,sb),infinity));
*ans = falseterm;
}
else
{ assert(equals(sb,infinity));
*ans = trueterm;
}
return 0;
}
if(erra==2)
{ if(f == NE || NEGATIVE(sa))
*ans= trueterm; /* -infinity < finite is true */
else
*ans = falseterm; /* infinity < finite is false */
return 0;
}
if(erra == 3 || errb ==3)
{ /* could compute both standard parts but failed to compute
one or the other nonstandard part */
switch(f)
{ case NE:
p = ne(sa,sb);
break;
case LE:
case '<':
p = lessthan(sa,sb);
break;
case GE:
case '>':
p = lessthan(sb,sa);
break;
default:
return 1;
}
err = infer(p);
if(!err)
{ *ans = trueterm;
return 0;
}
/* If the call to infer produced a refutation (err == 2) nothing
can be concluded. Example, arccos x != 0 in a limit as x->1,
the nonstandard part can't be computed so we get here, and the
standart parts are both zero, so infer(p) fails, but in fact
the correct answer is 'true' */
return 1;
}
if(erra || errb)
assert(0);
if(ZERO(nsa) && ZERO(nsb))
return 1;
if(equals(a,h) && equals(b,z))
{ if(f==NE)
{ *ans = trueterm;
return 0;
}
else if(equals(h,ARG(0,q)) &&
(f == FUNCTOR(q) || (f == LE && FUNCTOR(q) == '<') )
)
{ *ans = trueterm;
return 0;
}
*ans = falseterm;
return 0;
/* see my paper on nonstandard analysis and computation
for the justification! E.g. if q is h != z and
t is h < z, we return false. */
}
if(equals(a,z) && equals(b,h))
{ if(f==NE)
*ans = trueterm;
else if(equals(ARG(0,q),z))
*ans = trueterm;
else
*ans = falseterm;
return 0;
}
/* Is sa == sb? */
if(seminumerical(sa) && seminumerical(sb))
{ deval(sa,&za);
if(za != BADVAL)
{ deval(sb,&zb);
if(zb != BADVAL && fabs(zb-za) > VERYSMALL)
{ if(f == NE)
*ans = trueterm;
else
*ans = za < zb ? trueterm : falseterm;
return 0;
}
}
err = 1;
}
else
err = check1(ne(sa,sb));
if(!err)
{ if(f==NE)
{ *ans = trueterm;
return 0;
}
*ans = lessthan(sa,sb);
return 0;
}
/* now they have the same standard part */
polyval(sum(nsb,strongnegate(nsa)),&u);
/* The inequality is true if u is positive (nonzero for NE)
in a nbhd of z. Whether it's a two-sided or one-sided nbhd
depends on the inequality q extracted above from the
binder list. If it was a limit from the left, g = FUNCTOR(q)
is < and ARG(0,q) is h, and if from the right, ARG(1,q) is h
*/
err = leading_term(u,h,z,&p,&n);
if(err)
return 1;
if(f==NE)
{ if(equals(p, bounded_oscillations))
return 1; /* e.g. h sin (1/h) or h(2 + sin(1/h)), it might or might
not be nonzero in a nbhd */
if(OBJECT(p) && !ZERO(p))
err = 0;
else
err = check1(nonzero(p));
if(err)
return 1;
*ans = trueterm;
return 0;
}
/* Now we are dealing with an inequality < or LE */
/* determine the sign of p as best you can without making assumptions */
if(ZERO(p))
return 1;
if(POSNUMBER(p))
sign = 1;
else if(NEGATIVE(p) && POSNUMBER(ARG(0,p)))
sign = -1;
else if(immediate(lessthan(zero,p)) == 1)
sign = 1;
else if(immediate(lessthan(p,zero)) == 1)
sign = -1;
else
sign = 0; /* sign not yet determined */
if(g == NE && sign < 0)
{ /* a two-sided limit, but u is already negative on the right */
*ans = falseterm;
return 0;
}
if(equals(ARG(1,q),h))
{ /* a right-handed limit. Is u positive to the right of z ? */
*ans = sign > 0 ? trueterm : sign < 0 ? falseterm : lessthan(zero,p);
return 0;
}
if(g == NE || equals(ARG(0,q),h))
{ /* a left-handed with either sign,
or a two-sided limit with positive sign.
Now not only the sign of p
but also the parity of n matters. */
err = get_parity(n,&parity);
if(!err)
{ if(parity) /* odd power */
*ans = sign > 0 ? falseterm : sign < 0 ? trueterm : lessthan(p,zero);
else /* even power */
*ans = sign > 0 ? trueterm : sign < 0 ? falseterm : lessthan(zero,p);
return 0;
}
else /* can't determine parity */
{ if(sign > 0)
*ans = even(n);
else if (sign < 0)
*ans = odd(n);
else
*ans = or(and(lessthan(zero,p),even(p)),and(lessthan(p,zero),odd(p)));
return 0;
}
}
assert(0);
return 1;
}
/*__________________________________________________________________*/
static int stdpart(term t, term *s, term *ns)
/* extract the standard and infinitesimal parts of a term */
/* return 0 for success, 1 for failure to compute either *s or *ns,
2 when the 'standard part' would be infinite,
in which case *s is infinity or minusinfinity.
In that case *ns is garbage. This still counts as
'failure' but nonstandard can use the information.
Return 3 when the standard part can be computed but not the
nonstandard part. In that case, *s is correct but *ns is garbage.
*/
{ term h,a,u,c,diff,n,q;
int sign=0,err; // initialization to silence warning.
unsigned short g;
if(seminumerical(t))
{ *s = t;
*ns = zero;
return 0;
}
err = get_infinitesimal(&h,&a,&q); /* by extraction from binders list */
if(err)
{ *s = t;
*ns = zero;
return 0;
}
if(equals(t,h)) /* trap this common case without calling limval */
{ *s = a;
*ns = sum(h, strongnegate(a));
return 0;
}
g = FUNCTOR(q);
if(g == NE)
sign = 0;
else if(
(g == '<' && equals(h,ARG(0,q))) ||
(g == '>' && equals(h,ARG(1,q)))
)
sign = -1;
else if(
(g == '<' && equals(h,ARG(1,q))) ||
(g == '>' && equals(h,ARG(0,q)))
)
sign = 1;
else
return 1; // assert(0), I think, but to be conservative, return 1;
if(!contains(t,FUNCTOR(h))) /* then don't bother calling limval */
{ *s = t;
*ns = zero;
return 0;
}
switch(sign)
{ case 0:
u = limit(arrow(h,a),t);
break;
case -1:
u = limit3(arrow(h,a),left,t);
break;
case 1:
u = limit3(arrow(h,a),right,t);
break;
}
err = limval(u,s);
if(err)
return 1;
if(ISINFINITE(*s))
return 2;
if(NOTDEFINED(*s))
return 1;
polyval(sum(t,strongnegate(*s)),&diff);
if(ZERO(diff))
{ *ns = zero;
return 0;
}
err = leading_term(diff,h,a,&c,&n);
/* example: t = sqrt(x+h) - sqrt x; *s comes out 0,
diff comes out the same as t, and we want *ns = h/(2 sqrt x) */
if(err)
return 3; /* example, e^tan x as x->pi/2 */
/* example 2: arccos x as x->1 */
*ns = product(c,make_power(sum(h,strongnegate(a)),n));
return 0;
}
/*__________________________________________________________________*/
int stdpartonly(term t, term *s)
/* extract the standard part of a term */
/* return 0 for success, 1 for failure to compute.
This is just the first part of stdpart, omitting the last call
to leading_term for efficiency, and also because it might give an
answer even when that leading term couldn't be computed.
Example, e^tan x as x->pi/2.
*/
{ term h,a,u,q;
int sign,err;
unsigned short g;
err = get_infinitesimal(&h,&a,&q); /* by extraction from binders list */
if(err)
{ *s = t;
return 0;
}
g = FUNCTOR(q);
sign = (g==NE ? 0 : g=='<' ? -1 : 1);
if(!contains(t,FUNCTOR(h))) /* then don't bother calling limval */
{ *s = t;
return 0;
}
switch(sign)
{ case 0:
u = limit(arrow(h,a),t);
break;
case -1:
u = limit3(arrow(h,a),left,t);
break;
case 1:
u = limit3(arrow(h,a),right,t);
break;
}
err = limval(u,s);
if(err)
return 1;
return 0;
}
/*_________________________________________________*/
static int get_parity(term t, int *parity)
/* if t is an even integer or rational, return
0 in *parity; if t is an odd integer or rational,
return 1 in *parity; if 2 cancels out of t leaving
an integer atom, or out of t-1, set *parity
accordingly; return 0 for success in these cases,
else return 1 for failure. */
{ term cancelled, u;
int err,p,q,i;
unsigned short n;
if(NEGATIVE(t))
return get_parity(ARG(0,t),parity);
if(INTEGERP(t))
{ *parity = ISEVEN(t) ? 0 : 1;
return 0;
}
if(RATIONALP(t))
{ if(ISODD(ARG(0,t)))
{ *parity = 1;
return 0;
}
if(ISODD(ARG(1,t)) && ISEVEN(ARG(0,t)))
{ *parity = 0;
return 0;
}
err = cancel(ARG(0,t),ARG(1,t),&cancelled,&u);
assert(!err);
return get_parity(u,parity);
}
if(ATOMIC(t))
return 1;
if(FUNCTOR(t) == '*')
{ /* maybe it's even */
err = cancel(t,two,&cancelled,&u);
if(err)
return 1;
*parity = 0;
return infer(type(u,INTEGER));
}
if(FUNCTOR(t) == '+')
{ p = 0;
n = ARITY(t);
for(i=0;i<n;i++)
{ err = get_parity(ARG(i,t),&q);
if(err)
return 1;
if(q)
p = p ? 0 : 1;
}
*parity = p;
return 0;
}
return 1;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists