Sindbad~EG File Manager
/*
M. Beeson, for Mathpert
rewrite rules for propositional logic and
for combining propositional combinations of inequalities
12.30.90 original date
3.30.99 last modified
6.24.04 corrected puncture at line 1328
*/
#include <assert.h>
#include <math.h>
#include "globals.h"
#include "dcomplex.h"
#include "prover.h"
#include "algaux.h"
#include "deval.h"
#include "mpmem.h"
#include "pvalaux.h"
#include "display1.h"
#include "bigrect.h"
#include "lterm.h" /* interval_as_and */
static int archimedean_rule(term,term, term *);
static int eliminate_n(term, term *);
static int puncture(term u, term v, term *ans);
static int arctrig_intervals(term t, term *ans);
/*____________________________________________________________*/
int andrule1(term t,term *ans)
/* a & b & (p | q | a) = a & b (dropping other disjuncts p,q...) */
/* return value 0 if rule is applicable, 1 if not; if not applicable
*ans can be garbage */
{ int i,j,k;
unsigned short n,m;
term u;
if(FUNCTOR(t) != AND)
return 1;
n = ARITY(t);
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u)==OR)
{ m = ARITY(u);
for(j=0;j<m;j++)
{ for(k=0;k<n;k++)
{ if(k != i && equals(ARG(k,t),ARG(j,u))) /* rule applies */
{ /* delete u as an argument of t */
if(n==2)
{ *ans = ARG(i ? 0 : 1, t);
return 0;
}
*ans = make_term(AND,(unsigned short)(n-1));
for(k=0;k<i;k++)
ARGREP(*ans,k,ARG(k,t));
for(k=i;k<n-1;k++)
ARGREP(*ans,k,ARG(k+1,t));
return 0;
}
}
}
}
}
return 1;
}
/*_________________________________________________________________________*/
int orrule1(term a,term u,term *ans)
/* a & (b | (a & c)) = a & ( b | c ) (dropping the inner a ) */
/* u is the OR term */
/* Also do: a & ( (a&b) | (a&c) ) = a&(b | c), ie. factor the a out
of all the disjuncts */
/* return value 0 if rule is applicable, 1 if not; if not applicable
*ans can be garbage. If the rule is applicable, it is the
new disjunction (b | c) that is returned in *ans, not a & (b|c).
*/
{ int j,k,z;
unsigned short m,w;
term v,newv;
int success = 0;
if(FUNCTOR(u)!=OR)
return 1;
m = ARITY(u);
*ans = make_term(OR,m);
for(j=0;j<m;j++)
{ v = ARG(j,u);
if(FUNCTOR(v) == AND)
{ /* got an inner conjunction */
w = ARITY(v);
for(k=0;k<w;k++)
{ if(equals(a,ARG(k,v))) /* rule applies */
break;
}
if(k==w)
newv = v;
else
{ /* drop a as an arg of v */
success = 1;
if(w==2)
newv = ARG(k ? 0 : 1, v);
else
{ newv = make_term(AND,(unsigned short)(w-1));
for(z=0;z<k;z++)
ARGREP(newv,z,ARG(z,v));
for(z=k;z<w-1;z++)
ARGREP(newv,z,ARG(z+1,v));
}
}
}
else
newv = v;
ARGREP(*ans,j,newv);
}
if(success)
return 0;
RELEASE(*ans);
return 1;
}
/*__________________________________________________________________*/
int orrule2(term t, term *ans)
/* (a & b) or a => a;
c or (a & b) or a => c or a
Return 0 for success, 1 for failure.
*/
{ unsigned short n;
int i,j,k;
term u,a;
if(FUNCTOR(t) != OR)
return 1;
n = ARITY(t);
for(i=0;i<n;i++)
{ a = ARG(i,t);
for(j=0;j<n;j++)
{ if(j ==i)
continue;
u = ARG(j,t);
if(FUNCTOR(u) != AND)
continue;
/* search for a among the args of u */
for(k = 0; k < ARITY(u); k++)
{ if(equals(a,ARG(k,u)))
goto success;
}
}
}
return 1; /* failure */
success:
/* delete the j-th arg of t */
if(n == 2)
{ *ans = ARG(j ? 0 : 1, t);
return 0;
}
*ans = make_term(OR,(unsigned short)(n-1));
for(i=0;i<n-1;i++)
ARGREP(*ans,i, i < j ? ARG(i,t) : ARG(i+1,t));
return 0;
}
/*__________________________________________________________________*/
term reduce_and(term t)
/* t is an AND, flattened, and all args have been through lpt already.
Perform further reductions; the answer produced will be returned by lpt
unless it is an interval_as_and, which might reduce further.
Does not have to return in fresh space.
*/
{ unsigned short n;
int i,j=0,k,err;
term a,b,u,v,temp,ans;
unsigned short g=0,h=0;
void *savenode;
if(FUNCTOR(t) != AND)
return t;
savenode = heapmax();
err = remove_dups(t,&u); /* remove duplicate args if any */
if(!err)
t = u;
drop_variants(t,&t); /* get rid of conjuncts that differ only
by renaming existential variables */
n = ARITY(t);
if(interval_as_and(t) && ATOMIC(ARG(1,ARG(0,t))))
{ err = eliminate_n(t,&u);
if(!err)
{ v = lpt(u);
save_and_reset(v,savenode,&ans);
return ans;
}
/* catch a < x < a which reduces to false,
and a <= x < a which reduces to x = a */
a = ARG(0,ARG(0,t));
b = ARG(1,ARG(1,t));
if(equals(a,b))
{ if(FUNCTOR(ARG(0,t)) == '<' && FUNCTOR(ARG(1,t)) == '<')
{ reset_heap(savenode);
return falseterm;
}
save_and_reset(equation(ARG(1,ARG(0,t)),a),savenode,&ans);
return ans;
}
if(seminumerical(a) && seminumerical(b))
{ double z,w;
deval(a,&w);
deval(b,&z);
if(z != BADVAL && w != BADVAL && z < w)
{ reset_heap(savenode);
return falseterm;
}
}
save_and_reset(t,savenode,&ans);
return ans;
}
else if(interval_as_and(t))
{ err = arctrig_intervals(t,&u);
if(!err)
{ if(ATOMIC(u))
{ reset_heap(savenode);
return u;
}
else
{ v = lpt(u);
save_and_reset(v,savenode,&ans);
return ans;
}
}
}
if(n==2)
{ temp = and(ARG(1,t),ARG(0,t));
if(interval_as_and(temp) && ATOMIC(ARG(1,ARG(1,t))))
{ err = eliminate_n(temp,&u);
if(!err)
v = lpt(u);
else
v = lpt(temp);
save_and_reset(v,savenode,&ans);
return ans;
}
}
if(n==2 && FUNCTOR(ARG(0,t)) == OR && FUNCTOR(ARG(1,t)) == NE)
{ /* Example: or(x < -1, 1 < x) & x != 1 reduces to or(x < -1, 1 < x) */
u = ARG(0,t);
v = ARG(1,t);
return lpt(or(and(ARG(0,u),v),and(ARG(1,u),v)));
}
if(n==2)
{ /* Example: x < 1 && x != 0 reduces to or(x < 0, 0 < x < 1) */
u = ARG(0,t);
v = ARG(1,t);
/* example: if v is x<0 or 0<x, convert it to x != 0 first
so puncture can work */
if(FUNCTOR(v) == OR && ARITY(v) == 2 &&
FUNCTOR(ARG(0,v)) == '<' && FUNCTOR(ARG(1,v)) == '<'
)
{ term p,q,r,s;
p = ARG(0,ARG(0,v));
q = ARG(1,ARG(0,v));
r = ARG(0,ARG(1,v));
s = ARG(1,ARG(1,v));
if(equals(q,r) && equals(p,s))
v = ne(p,q);
}
if(FUNCTOR(v) == NE && (FUNCTOR(u) == '<' || FUNCTOR(u) == LE || interval_as_and(u)))
{ err = puncture(u,v,&ans);
if(!err)
{ save_and_reset(ans,savenode,&ans);
return ans;
}
}
else if(FUNCTOR(u) == NE && (FUNCTOR(v) == '<' || FUNCTOR(v) == LE || interval_as_and(v)))
{ err = puncture(v,u,&ans);
if(!err)
{ save_and_reset(ans,savenode,&ans);
return ans;
}
}
}
else /* n > 2; look for two args that can be combined using puncture */
{ for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u) != '<' && FUNCTOR(u) != LE)
continue;
for(j=1;j<n;j++)
{ if(j==i)
continue;
v = ARG(j,t);
if(FUNCTOR(v) != NE)
continue;
if(!puncture(u,v,&temp))
{ ans = make_term(AND,(unsigned short)(n-1));
for(k=0;k<n-1;k++)
ARGREP(ans,k,k<i ? ARG(k,t) : k==i ? temp : k < j ? ARG(k,t) : ARG(k+1,t));
save_and_reset(ans,savenode,&v);
ans = reduce_and(v); /* put it through again */
save_and_reset(ans,savenode,&ans);
return ans;
}
}
}
}
/* next see if any pairs of inequalities among the args will conjoin */
if(FUNCTOR(t) != AND)
{ save_and_reset(t,savenode,&ans);
return ans; /* t was originally a && a for example */
}
for(i=0;i<n;i++)
{ for(j=0;j<n;j++)
{ if(j==i)
++j;
if(j==n)
break;
err = conjoin(ARG(i,t),ARG(j,t),&u);
if(!err)
{ term ans;
int p,q;
if(n==2)
return u;
if(equals(u,falseterm))
return falseterm;
ans = make_term(AND,(unsigned short)(n-1));
for(q=0;q<i && q<j;q++)
ARGREP(ans,q,ARG(q,t));
ARGREP(ans,q,u);
assert(q == (i < j ? i : j )); /* q = min(i,j) */
for(p=q+1; p<i || p < j;p++)
ARGREP(ans,p,ARG(p,t));
for(q=p; q<n-1;q++)
ARGREP(ans,q,ARG(q+1,t));
save_and_reset(ans,savenode,&v);
ans = reduce_and(v);
save_and_reset(ans,savenode,&ans);
return ans;
}
}
}
err = andrule1(t,&u);
if(err)
u=t;
/* Now see if there are two ORS among the conjuncts */
if(FUNCTOR(u) != AND)
{ save_and_reset(u,savenode,&ans);
return ans;
}
/* Invert the order of (b < c && a < b). There is no danger of loops here,
because two inequalities a f b and b f a always conjoin */
n = ARITY(u);
if(n==2)
{ g = FUNCTOR(ARG(0,u));
h = FUNCTOR(ARG(1,u));
}
if(n==2 && INEQUALITY(g) && INEQUALITY(h) &&
equals(ARG(1,ARG(1,u)),ARG(0,ARG(0,u)))
)
{ save_and_reset (and(ARG(1,u),ARG(0,u)),savenode,&ans);
return ans;
}
/* Now look for two ORS among the conjuncts; they should be
distributed */
for(i=0;i<n;i++)
{ v = ARG(i,u);
if(FUNCTOR(v) == OR)
{ for(j=i+1;j<n;j++)
{ if(FUNCTOR(ARG(j,u)) == OR)
break;
}
if(j<n)
break;
}
}
if(i<n) /* found two ORs */
{ err = pdistribute(and(ARG(i,u),ARG(j,u)),&temp);
if(err) /* arity of temp would exceed 0xffff */
{ save_and_reset(u,savenode,&ans);
return ans; /* without distributing */
}
assert(FUNCTOR(temp) == OR);
ans = make_term(OR,ARITY(temp));
for(i=0;i<ARITY(temp);i++)
{ assert(FUNCTOR(ARG(i,temp)) == AND);
ARGREP(ans,i,reduce_and(ARG(i,temp)));
}
RELEASE(temp); /* made by pdistribute */
v = reduce_or(ans);
save_and_reset(v,savenode,&ans);
return ans;
}
save_and_reset(u,savenode,&ans);
return ans; /* did not find two ORS */
}
/*______________________________________________________________________*/
static int equality_test(term u, term v)
/* u and v are equal, or are both equalities or NE's with reversed args */
{ unsigned short f,g;
if(equals(u,v))
return 1;
f = FUNCTOR(u);
g = FUNCTOR(v);
if((f == '=' && g == '=') || (f == NE && g == NE))
{ term a,b,c,d;
a = ARG(0,u);
b = ARG(1,u);
c = ARG(0,v);
d = ARG(1,v);
if(equals(a,d) && equals(b,c))
return 1;
}
return 0;
}
/*______________________________________________________________________*/
int remove_dups(term t, term *ans)
/* t is an AND or an OR; remove duplicate args in accordance with A && A == A
A || A == A. Also counts a=b and b=a as duplicates, and a!=b and b!=a.
Also, while you're at it, remove 'false' from OR's and 'true' from AND's.
Return 0 for something removed, 1 for nothing to do. */
{ int i,j,k;
unsigned short n = ARITY(t);
unsigned short f = FUNCTOR(t);
term u,v;
int *scratchpad; /* record which args are to be removed */
int cnt=0; /* count the ones to be removed */
scratchpad = (int *) callocate(n,sizeof(int));
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(scratchpad[i])
continue;
if((f==OR && equals(u,falseterm)) || (f==AND && equals(u,trueterm)))
{ scratchpad[i] = 1;
++cnt;
continue;
}
if(equals(u,falseterm) && f == AND)
{ free2(scratchpad);
*ans = falseterm;
return 0;
}
if(equals(u,trueterm) && f == OR)
{ free2(scratchpad);
*ans = trueterm;
return 0;
}
for(j=i+1;j<n;j++)
{ v = ARG(j,t);
if(!scratchpad[j] && equality_test(u,v))
{ scratchpad[j] = 1;
++cnt;
}
}
}
if(cnt == 0)
{ *ans = t;
free2(scratchpad);
return 1;
}
if(cnt == n-1)
{ i=0;
while(scratchpad[i] && i<n)
++i;
assert(i<n);
free2(scratchpad);
*ans = ARG(i,t);
return 0;
}
if(cnt == n)
{ *ans = f == AND ? trueterm : falseterm;
free2(scratchpad);
return 0;
}
*ans = make_term(f,(unsigned short)(n-cnt));
k=0;
for(i=0;i<n;++i)
{if(!scratchpad[i])
{ ARGREP(*ans,k,ARG(i,t));
++k;
}
}
free2(scratchpad);
return 0;
}
/*____________________________________________________________________*/
int conjoin(term ineq1, term ineq2, term *ans)
/* find, in some cases, a single inequality or interval (or true or falseterm)
equivalent to the conjunction of two inequalities or intervals,
e.g. 0<u && 1<u goes to 1<u,
u<x && u <= x goes to u<x, etc. Assumes ineq1 and ineq2 are not identical.
Return 0 for success, 1 for failure.
Also works if ineq2 is a disjunction of inequalities or intervals
each of which conjoins separately with ineq1.
ineq1 and ineq2 can be equalities, too.
In case and(ineq1,ineq2) is an interval_as_and, we DO count
that as conjoining, even though the conjunction won't be changed by
this application of conjoin.
*/
{ term a,b,c,d,x,x2,temp,temp2,temp3,mid,l,r;
unsigned short f,g,n,f1,f2,g1,g2,k;
int i,err;
f = FUNCTOR(ineq1);
g = FUNCTOR(ineq2);
if(g==OR && (f == LE || f == '<' || f == NE))
/* e.g. t != 1 should conjoin with 1 < t or t <= -1
because it conjoins with both disjuncts */
{ n = ARITY(ineq2);
*ans = make_term(OR,n);
k = 0;
for(i=0;i<n;i++)
{ err = conjoin(ineq1,ARG(i,ineq2),&temp);
if(err)
{ RELEASE(*ans);
return 1; /* ineq1 must conjoin with ALL disjuncts in ineq2 */
}
if(equals(temp,trueterm))
{ RELEASE(*ans);
*ans = trueterm;
return 0;
}
if(equals(temp,falseterm))
continue;
ARGREP(*ans,k,temp);
++k;
}
if(k == 0)
{ RELEASE(*ans);
*ans = falseterm;
return 0;
}
if(k == 1)
{ temp = ARG(0,*ans);
RELEASE(*ans);
*ans = temp;
return 0;
}
SETFUNCTOR(*ans,OR,k);
return 0;
}
if(interval_as_and(ineq1) && interval_as_and(ineq2) &&
equals(ARG(1,ARG(0,ineq1)),ARG(1,ARG(0,ineq2)))
)
{ a = ARG(0,ARG(0,ineq1));
b = ARG(1,ARG(1,ineq1));
c = ARG(0,ARG(0,ineq2));
d = ARG(1,ARG(1,ineq2));
x = ARG(1,ARG(0,ineq1));
copy(x,&x2);
f1 = FUNCTOR(ARG(0,ineq1));
f2 = FUNCTOR(ARG(1,ineq1));
g1 = FUNCTOR(ARG(0,ineq2));
g2 = FUNCTOR(ARG(1,ineq2));
/* (a,b) intersect (c,d) is false if b < c or d < a.
Otherwise it is (max(a,c), min(c,d)). Careful
about the cases a==c, b==d.
*/
err = infer((f2 == '<' || g1 == '<') ? le(b,c) : lessthan(b,c));
if(!err)
{ *ans = falseterm;
return 0;
}
err = infer((f1 == '<' || g2 == '<') ? le(d,a) : lessthan(d,a));
if(!err)
{ *ans = falseterm;
return 0;
}
if(equals(a,c))
{ /* answer is (a, min(b,d)) */
l = (f1 == '<' || g1 == '<') ? lessthan(a,x) : le(a,x);
if(equals(b,d))
{ *ans = and( l,
(f2 == '<' || g2 == '<') ? lessthan(x2,b) : le(x2,b)
);
return 0;
}
err = infer((g2 == '<' && f2 == LE) ? lessthan(b,d) : le(b,d));
if(!err)
{ /* answer is (a,b) */
*ans = and( l, f2 == '<' ? lessthan(x2,b) : le(x2,b));
return 0;
}
err = infer((f2 == '<' && g2 == LE) ? lessthan(d,b) : le(d,b));
if(!err)
{ /* answer is (a,d) */
*ans = and(l, g2 == '<' ? lessthan(x2,d) : le(x2,d));
return 0;
}
return 1; /* can't determine min(b,d) */
}
if(equals(b,d))
{ /* answer is (max(a,c), b) */
r = (f2 == '<' || g2 == '<') ? lessthan(x2,b) : le(x2,b);
/* don't have to handle equals(a,c) */
err = infer((g1 == '<' && f1 == LE) ? lessthan(a,c) : le(a,c));
if(!err)
{ /* max(a,c) = c so answer is (c,b) */
*ans = and( f1 == '<' ? lessthan(c,x) : le(c,x), r);
return 0;
}
err = infer((f1 == '<' && g1 == LE) ? lessthan(c,a) : le(c,a));
if(!err)
{ /* max(a,c) = a so answer is (a,b) */
*ans = and(g1 == '<' ? lessthan(a,x) : le(a,x),r);
return 0;
}
return 1; /* can't determine max(a,c) */
}
/* Now the answer is (max(a,c),min(b,d)) */
err = infer((g1 == '<' && f1 == LE) ? lessthan(a,c) : le(a,c));
if(!err)
{ /* answer is (c, min(b,d)) */
l = g1 == '<' ? lessthan(c,x) : le(c,x);
err = infer((g2 == '<' && f2 == LE) ? lessthan(b,d) : le(b,d));
if(!err)
{ /* answer is (c,b) */
r = f2 == '<' ? lessthan(x2,b) : le(x2,b);
*ans = and(l,r);
return 0;
}
err = infer((f2 == '<' && g2 == LE) ? lessthan(d,b) : le(d,b));
if(!err)
{ /* answer is (c,d) */
r = g2 == '<' ? lessthan(x2,d) : le(x2,d);
*ans = and(l,r);
return 0;
}
return 1;
}
err = infer(le(c,a));
if(!err)
{ /* answer is (a, min(b,d)) */
l = f1 == '<' ? lessthan(a,x) : le(a,x);
err = infer((g2 == '<' && f2 == LE) ? lessthan(b,d) : le(b,d));
if(!err)
{ /* answer is (a,b) */
r = f2 == '<' ? lessthan(x2,b) : le(x2,b);
*ans = and(l,r);
return 0;
}
err = infer((f2 == '<' && g2 == LE) ? lessthan(d,b) : le(d,b));
if(!err)
{ /* answer is (a,d) */
r = g2 == '<' ? lessthan(x2,d) : le(x2,d);
*ans = and(l,r);
return 0;
}
return 1;
}
return 1;
}
if(interval_as_and(ineq1))
{
if(g == '=')
{ /* x = a conjoins with a < x < b and so does x = b */
x = ARG(1,ARG(0,ineq1));
if(equals(x,ARG(0,ineq2)))
b = ARG(1,ineq2);
else if(equals(x,ARG(1,ineq2)))
b = ARG(0,ineq2);
else
return 1;
if(equals(b,ARG(0,ARG(0,ineq1))))
{ *ans = FUNCTOR(ARG(0,ineq1)) == '<' ? falseterm : trueterm;
return 0;
}
if(equals(b,ARG(1,ARG(1,ineq1))))
{ *ans = FUNCTOR(ARG(1,ineq1)) == '<' ? falseterm : trueterm;
return 0;
}
return 1;
}
/* see if ineq2 conjoins with either half */
err = conjoin(ARG(0,ineq1),ineq2,&temp);
if(!err && ATOMIC(temp))
{ if(equals(temp,falseterm))
*ans = falseterm;
else
{ assert(equals(temp,trueterm));
*ans = ARG(1,ineq1);
}
return 0;
}
if(!err && equals(ARG(1,ARG(0,ineq1)),ARG(1,temp)))
{ temp = and(temp,ARG(1,ineq1));
*ans = lpt(temp); /* don't stop with 3 < x < 3 for example */
return 0;
}
err = conjoin(ARG(1,ineq1),ineq2,&temp);
if(!err && ATOMIC(temp))
{ if(equals(temp,falseterm))
*ans = falseterm;
else
{ assert(equals(temp,trueterm));
*ans = ARG(0,ineq1);
}
return 0;
}
if(!err && equals(ARG(0,ARG(1,ineq1)),ARG(0,temp)))
{ temp = and(ARG(0,ineq1),temp);
*ans = lpt(temp);
return 0;
}
return 1;
}
if(interval_as_and(ineq2))
return conjoin(ineq2,ineq1,ans);
if(f != '<' && f != LE && f != NE && f != '=')
return 1;
if(g != '<' && g != LE && g != NE && g != '=')
return 1;
a = ARG(0,ineq1);
b = ARG(1,ineq1);
c = ARG(0,ineq2);
d = ARG(1,ineq2);
if(f == '=' && g == '<' && equals(a,c)) /* a = b & c < d */
{ temp = lpt(lessthan(b,d));
if(equals(temp,trueterm))
{ *ans = ineq1;
return 0;
}
if(equals(temp,falseterm))
{ *ans = falseterm;
return 0;
}
return 1;
}
if(f == '=' && g == '<' && equals(a,d))
{ temp = lpt(lessthan(c,b));
if(equals(temp,trueterm))
{ *ans = ineq1;
return 0;
}
if(equals(temp,falseterm))
{ *ans = falseterm;
return 0;
}
return 1;
}
if(f == '=' && g == LE && equals(a,c))
{ temp = lpt(le(b,d));
if(equals(temp,trueterm))
{ *ans = ineq1;
return 0;
}
if(equals(temp,falseterm))
{ *ans = falseterm;
return 0;
}
return 1;
}
if(f == '=' && g == LE && equals(a,d))
{ temp = lpt(le(c,b));
if(equals(temp,trueterm))
{ *ans = ineq1;
return 0;
}
if(equals(temp,falseterm))
{ *ans = falseterm;
return 0;
}
return 1;
}
if(f == '=' && g == NE && equals(a,c))
{ temp = lpt(ne(b,d));
if(equals(temp,trueterm))
/* example, x=5 and x != 0 */
{ *ans = ineq1;
return 0;
}
if(equals(temp,falseterm))
/* that is, b = d */
{ *ans = falseterm;
return 0;
}
return 1;
}
if(f == '=' && g == NE && equals(a,d))
{ temp = lpt(ne(b,c));
if(equals(temp,trueterm))
{ *ans = ineq1;
return 0;
}
if(equals(temp,falseterm))
{ *ans = falseterm;
return 0;
}
return 1;
}
if(g == '=' && f != '=')
return conjoin(ineq2,ineq1,ans);
if(f == '=' || g == '=')
return 1;
if(f == NE || g==NE)
{ if( (equals(a,c) && equals(b,d)) || (equals(b,c) && equals(a,d)))
{ if(f==g)
*ans = ineq1;
else if (g==NE)
*ans = lessthan(a,b);
else
*ans = lessthan(c,d);
return 0;
}
return 1;
}
if( (equals(a,c) && equals(b,d))
|| ((f == '=' || f == NE) && equals(a,d) && equals(b,c))
|| ((g == '=' || g == NE) && equals(a,d) && equals(b,c))
)
{
if((f == '=' && g == NE) || (g == '=' && f == NE))
{ *ans = falseterm;
return 0;
}
if(f == '=' && g == LE)
{ *ans = ineq1;
return 0;
}
if(g == '=' && f == LE)
{ *ans = ineq2;
return 0;
}
if((f == '=' && g == '<') || (g == '=' && f == '<'))
{ *ans = falseterm;
return 0;
}
}
assert(f == LE || f == '<');
assert(g == LE || g == '<');
if(equals(a,c))
{ if(equals(b,d))
{ *ans = (f=='<' ? ineq1 : ineq2);
return 0;
}
temp = le(b,d);
if(!infer(temp))
{ *ans = ineq1;
RELEASE(temp);
return 0;
}
RELEASE(temp);
temp = le(d,b);
if(!infer(temp))
{ *ans = ineq2;
RELEASE(temp);
return 0;
}
RELEASE(temp);
/* Now try harder; for example, consider x < n pi - pi/2 && x < n pi */
temp3 = strongnegate(b);
temp = sum(d,temp3);
polyval(temp,&temp2);
if(FUNCTOR(b) != '-' && !ZERO(b))
RELEASE(temp3);
if(!ZERO(d) && !ZERO(temp3))
RELEASE(temp);
temp = le(zero,temp2);
mid = lpt(temp);
if(equals(mid,trueterm))
{ destroy_term(temp); /* created by le and polyval above */
*ans = ineq1;
return 0;
}
if(equals(mid,falseterm))
{ destroy_term(temp);
*ans = ineq2;
return 0;
}
RELEASE(temp);
temp = le(temp2,zero);
mid = lpt(temp);
if(equals(mid,trueterm))
{ destroy_term(temp);
*ans = ineq2;
return 0;
}
/* nice try but no cigar, so go on */
destroy_term(temp);
}
if(equals(a,d) && equals(b,c))
{ if(f == LE && g == LE)
*ans = equation(a,b);
else
*ans = falseterm; /* forms of trichotomy */
return 0;
}
if(equals(b,c) && ISATOM(b))
{ /* result is an interval_as_and */
*ans = and(ineq1,ineq2);
return 0;
}
if(equals(a,d) && ISATOM(a))
{ *ans = and(ineq2,ineq1);
return 0;
}
if(equals(a,d) && seminumerical(b) && seminumerical(c))
/* for example: and(k<0,1 <= k) simplifies to false */
{ double bb, cc;
long k;
if(!deval(b,&bb) && !deval(c,&cc)
&& (bb < cc ||
(
((f=='<' && g == LE) || (f==LE && g=='<'))
&& nearint(bb-cc,&k) && k==0
)
)
)
{ *ans = falseterm;
return 0;
}
}
if(equals(b,d))
{ temp = le(a,c);
if(immediate(temp)==1)
{ *ans = ineq2;
RELEASE(temp);
return 0;
}
RELEASE(temp);
temp = le(c,a);
if(immediate(temp)==1)
{ *ans = ineq1;
RELEASE(temp);
return 0;
}
RELEASE(temp);
/* Now try harder; for example, consider n pi - pi/2 < x && n pi < x */
tneg(c,&temp3);
temp = sum(a,temp3);
polyval(temp,&temp2);
if(FUNCTOR(c) != '-' && !ZERO(c))
RELEASE(temp3);
if(!ZERO(a) && !ZERO(temp3))
RELEASE(temp);
temp = le(zero,temp2);
mid = lpt(temp);
if(equals(mid,trueterm))
{ destroy_term(temp); /* created by le and polyval above */
*ans = ineq1;
return 0;
}
if(equals(mid,falseterm))
{ destroy_term(temp); /* created by le and polyval above */
*ans = ineq2;
return 0;
}
RELEASE(temp);
temp = le(temp2,zero);
mid = lpt(temp);
if(equals(mid,trueterm))
{ RELEASE(temp);
destroy_term(temp2);
*ans = ineq2;
return 0;
}
/* nice try but no cigar, so go on */
destroy_term(temp);
}
/* The following rule says there's no integer between two successive
integers. (Needed in reducing domains of trig functions.) */
return archimedean_rule(ineq1, ineq2,ans); /* last chance for 'conjoin' ! */
}
/*____________________________________________________________________*/
static int archimedean_rule(term ineq1, term ineq2, term *ans)
/* return 0 with *ans= falseterm if ineq1 && ineq2 is impossible on grounds
that there can't be an integer between two successive integers */
/* else return 1 with garbage in *ans */
{ unsigned short f,g;
term a,b,c,d;
term u,v,w,z,zz;
int err;
f = FUNCTOR(ineq1);
g = FUNCTOR(ineq2);
if(f != '<' && f != LE)
return 0;
if(g != '<' && g != LE)
return 0;
a = ARG(0,ineq1);
b = ARG(1,ineq1);
c = ARG(0,ineq2);
d = ARG(1,ineq2);
if(equals(a,d))
return archimedean_rule(ineq2,ineq1,ans);
if(!equals(b,c))
return 1;
w = type(b,INTEGER);
if(immediate(w))
{ u = type(a,INTEGER);
err = infer(u);
if(!err)
{ v = sum(d,strongnegate(a));
err = polyval(v,&z);
RELEASE(u);
if(!ZERO(d) && !ZERO(a))
RELEASE(v);
if(!err)
{ if(ONE(z) && f == '<' && g == '<') /* d-a == 1, so done */
{ *ans = falseterm;
RELEASE(w);
return 0;
}
else /* d - a \le 1 , e.g. 0 < x && x < 0 */
{ zz = lessthan(z,one);
err = infer(zz);
if(!err)
{ *ans = falseterm;
RELEASE(zz);
RELEASE(w);
return 0;
}
}
}
else
destroy_term(z); /* created by polyval */
}
else
RELEASE(u);
}
RELEASE(w);
return 1;
}
/*______________________________________________________________________*/
static int eliminate_n(term t, term *ans)
/* t is an interval a < n && n < b. If n is not an atom, return 1.
If n is an existential type-integer variable, return *ans = true if
a and b must include an integer between them. In general try to
simplify the proposition exists(n,t).
Return zero for some change.
*/
/* This gets rid of pairs of assumptions like -1/2 < n && n < 1/2 that
arise e.g. from tan x when x is a limit variable. */
{ term a,b,n,u;
int err,i;
long k;
double za,zb;
int nvariables = get_nvariables();
term *varlist = get_varlist();
varinf *varinfo = get_varinfo();
assert(interval_as_and(t));
n = ARG(1,ARG(0,t));
a = ARG(0,ARG(0,t));
b = ARG(1,ARG(1,t));
if(!ISATOM(n))
return 1;
if(equals(n,left) ||
equals(n,right) ||
equals(n,infinity) ||
equals(n,undefined) ||
equals(n,bounded_oscillations) ||
equals(n,unbounded_oscillations) ||
equals(n,eulere) ||
equals(n,pi_term) ||
equals(n,complexi)
)
return 1;
for(i=0;i<nvariables;i++)
{ if(equals(varlist[i],n))
break;
}
if(i == nvariables)
assert(0); /* the above list of exceptions is complete! */
if(varinfo[i].scope != EXISTENTIAL || varinfo[i].type != INTEGER)
return 1;
if(seminumerical(a) && seminumerical(b))
{ err = deval(a,&za);
if(err)
return 1;
err = deval(b,&zb);
if(err)
return 1;
if(za >= zb)
/* can only happen by roundoff error */
{ assert(zb <= za + 0.000001);
za = zb;
}
if(nearint(za,&k))
{ if(FUNCTOR(ARG(0,t))==LE)
{ *ans = trueterm;
return 0;
}
}
if(nearint(zb,&k))
{ if(FUNCTOR(ARG(1,t))==LE)
{ *ans = trueterm;
return 0;
}
}
if(floor(za) != floor(zb))
{ *ans = trueterm;
return 0;
}
return 1;
}
/* Now a and b are not seminumerical */
polyval(sum(b,tnegate(a)),&u);
if(!seminumerical(u))
return 1;
err = deval(u,&za);
if(err)
return 1;
if(za > 1)
{ *ans = trueterm;
return 0;
}
return 1;
}
/*______________________________________________________________*/
int pdistribute(term t, term *ans)
/* t is an AND of two OR's. Apply the distributive law
and produce an OR of AND's. */
{ int i,j,k;
unsigned short n,p,q;
unsigned long nn;
term a,b;
assert(FUNCTOR(t) == AND && ARITY(t) == 2);
a = ARG(0,t);
b = ARG(1,t);
assert(FUNCTOR(a) == OR && FUNCTOR(b) == OR);
p = ARITY(a);
q = ARITY(b);
nn = (unsigned long) p*q;
if(nn > 0xffff)
return 1;
n = (unsigned short) nn;
*ans = make_term(OR,n);
k=0;
for(i=0;i<p;i++)
{ for(j=0;j<q;j++)
{ ARGREP(*ans,k,topflatten(and(ARG(i,a),ARG(j,b))));
++k;
}
}
assert(k==n);
return 0;
}
/*________________________________________________________________________*/
static int puncture(term u, term v, term *ans)
/* u is a<b or a <= b, or u is an interval_as_and.
v has functor NE.
Reduce and(u,v) if possible and put the result in *ans, returning 0.
Return 1 for no reduction; then *ans can be garbage.
Example: x < 1, x != 0 reduces to x < 0 or 0 < x < 1
*/
{ term a,b,c,d,temp,x;
int err;
unsigned short f = FUNCTOR(u);
if(f != '<' && f != LE && f != AND)
return 1;
if(f == AND && !interval_as_and(u))
return 1;
if(FUNCTOR(v) != NE)
return 1;
if(f == AND)
{ /* puncture an interval */
a = ARG(0,ARG(0,u));
b = ARG(1,ARG(1,u));
x = ARG(1,ARG(0,u));
c = ARG(0,v);
d = ARG(1,v);
if(equals(x,d))
{ /* swap c and d */
temp = c;
c = d;
d = temp;
}
if(!equals(x,c))
return 1;
/* Now, is d between a and c or not ? */
if(equals(d,a))
{ *ans = and(lessthan(a,x),ARG(1,u));
return 0;
}
if(equals(d,b))
{ *ans = and(ARG(0,u),lessthan(x,b));
return 0;
}
if(!infer(lessthan(d,a)) || !infer(lessthan(b,d)))
{ /* d outside the interval */
*ans = u;
return 0;
}
if(!infer(lessthan(a,d)) && !infer(lessthan(d,b)))
{ /* d between a and b */
*ans = or(
and( FUNCTOR(ARG(0,u)) == '<' ? lessthan(a,x) : le(a,x), lessthan(x,d)),
and( lessthan(d,x), FUNCTOR(ARG(1,u)) == '<' ? lessthan(x,b) : le(x,b))
);
return 0;
}
return 1;
}
a = ARG(0,u);
b = ARG(1,u);
c = ARG(0,v);
d = ARG(1,v);
if(equals(a,d) || equals(b,d))
{ /* swap c and d */
temp = c;
c = d;
d = temp;
}
if(equals(a,c))
{ if(equals(d,b)) // corrected 6.24.04
{ *ans = lessthan(a,b);
return 0;
}
err = infer(lessthan(d,b));
if(!err)
{ /* a < d or d < a f b */
*ans = or(lessthan(a,d), and(lessthan(d,a), f == '<' ? lessthan(a,b) : le(a,b)));
return 0;
}
err = infer(lessthan(b,d));
if(!err)
{ *ans = u;
return 0;
}
return 1;
}
if(equals(b,c))
{ /* Example: 0 < x && x != 1 reduces to 0 < x < 1 or 1 < x */
if(equals(a,d))
{ *ans = lessthan(a,b);
return 0;
}
err = infer(lessthan(a,d));
if(!err)
{ *ans = or(and(f == '<' ? lessthan(a,b) : le(a,b), lessthan(b,d)), lessthan(d,b));
return 0;
}
err = infer(lessthan(d,a));
if(!err)
{ *ans = u;
return 0;
}
return 1;
}
return 1;
}
/*___________________________________________________________________________*/
static int arctrig_intervals(term t, term *ans)
/* t is an interval_as_and. Reduce things like
2n pi - pi/2 <= (arccos x)/2 <= 2n pi + pi/2.
(This example reduces to true, since arccos is always between 0 and pi.)
Return 0 for success, with the reduced form in *ans.
Return 1 for failure, in which case *ans is garbage.
*/
{ term *atomlist;
int i,nvars,err, aflag=0,bflag=0;
long kk;
term a,b,u,n,x,c,s,p,q,alpha,beta,eq;
unsigned short f;
double z,zn,zalpha,zbeta,za,zb;
a = ARG(0,ARG(0,t));
b = ARG(1,ARG(1,t));
u = ARG(1,ARG(0,t));
nvars = variablesin(a,&atomlist);
if(nvars > 1)
{ free2(atomlist);
return 1;
}
n = nvars ? atomlist[0] : zero;
free2(atomlist);
nvars = variablesin(b,&atomlist);
if(nvars > 1 || (nvars == 1 && !ZERO(n) && !equals(n,atomlist[0])))
{ free2(atomlist);
return 1;
}
if(nvars == 1 && ZERO(n))
n = atomlist[0];
free2(atomlist);
if(!ZERO(n) && !ISEXISTENTIALVAR(n))
return 1;
nvars = variablesin(u,&atomlist);
if(nvars != 1)
{ free2(atomlist);
return 1;
}
x = atomlist[0];
if(equals(n,x))
return 1;
free2(atomlist);
if(FRACTION(u) || FUNCTOR(u) == '*')
{ ratpart2(u,&c,&s);
if(!ONE(c))
{ polyval(product(reciprocal(c),a),&p);
polyval(product(reciprocal(c),b),&q);
a = p;
b = q;
u = s;
}
}
/* Now, in the example, we have a = (4n-1)pi_term, u = arccos x, b = (4n+1)pi */
/* Now compute the ranges of the arctrig functors */
f = FUNCTOR(u);
switch(f)
{ case ACOS:
alpha = zero;
beta = pi_term;
break;
case ASIN:
alpha = tnegate(make_fraction(pi_term,two));
beta = make_fraction(pi_term,two);
break;
case ATAN: /* fall through */
case ACOT:
alpha = tnegate(pi_term);
beta = pi_term;
break;
default:
return 1; /* this function only handles arctrig in the middle. */
}
if(ZERO(n) || !contains(a,FUNCTOR(n)))
{ deval(a,&za);
if(za == BADVAL)
return 1;
deval(alpha,&zalpha);
if(zalpha == BADVAL)
return 1;
if(za > zalpha)
return 1;
aflag = 1;
}
if(ZERO(n) || !contains(b,FUNCTOR(n)))
{ deval(b,&zb);
if(zb == BADVAL)
return 1;
deval(beta,&zbeta);
if(zbeta == BADVAL)
return 1;
if(zb < zbeta)
return 1;
bflag = 1;
}
if(aflag && bflag)
{ *ans = trueterm;
return 0;
}
/* Now n is not zero, but a variable.
Choose the largest value of n that makes a <= alpha, and
then see if for that value of n we have beta <= b. If so,
set *ans = true and return 0. If not, give up. */
if(!aflag)
eq = equation(alpha,a);
else
eq = equation(beta,b);
err = solve(eq,n,-100.0, 100.0,&z);
if(err)
return 1;
if(nearint(z,&kk))
zn = kk;
else if(z >= 0.0)
zn = aflag ? floor(z)+1 : floor(z);
else
zn = aflag ? -floor(-z) : -(floor(-z)+1);
for(i=0;i<2;i++)
{ if(i)
zn = aflag ? zn - 1.0 : zn + 1.0;
SETVALUE(n,zn);
deval(beta,&zbeta);
if(zbeta == BADVAL)
return 1;
deval(alpha,&zalpha);
if(zalpha == BADVAL)
return 1;
deval(a,&za);
if(za == BADVAL)
return 1;
deval(b,&zb);
if(zb == BADVAL)
return 1;
if(zbeta <= zb+VERYSMALL && zalpha >= za-VERYSMALL)
{ *ans = trueterm;
return 0;
}
/* Don't give up, try it again with zn+1 in case a is decreasing in n;
that's the reason for the for-loop. */
}
return 1;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists