Sindbad~EG File Manager
/*
MathXpert's theorem prover
M. Beeson
Original date 12.30.90
6.4.99 last modified
6.19.04 modified tred in case get_complex() so e.g. sqrt(2):R can be inferred.
7.21.05 added n=2 at line 1273
1.18.06 replaced GlobalReallocate with realloc
1.19.06 modified check after infer_literally returns; return values 2 and 1 should be switched!
1.25.06 modified infer where it calls infer_by_constraints.
1.27.06 added the "nothing to do" line to eliminatevariables
3.17.06 changed 'LE' to LE. This must have happened when eliminating the OEM character for LE.
9.8.07 modified reduce_or's loop so the j loop starts at i+1, which is OK since domain is symmetric.
Moved disjoin to this file (so it can be static) and broke odd_or_even out of it.
Called odd_or_even and join near where disjoin is called
9.9.07 added zeromodpi and implies2 and code that calls implies2 in reduce_or
1.2.11 modified careful_assume to properly use a negative currentline.
5.5.13 changed malloc.h to stdlib.h; added include activate.h
5.28.13 added code around line 608 to implies_instantly
7.7.13 modified the line, proverDLL->permhistory = (unsigned long *) realloc(proverDLL->permhistory, mm * sizeof(unsigned));
which had the second "perm" omitted!
8.8.24 changed math.h to sincos.h; removed unused term ans in tred
removed unused variable in infer;
8.8.24 fixed the handling of realloc in record_theorem and assume
11.10.24 changed term *newspace to assumtion **newspace in assume
*/
#include <assert.h>
#include <string.h>
#include <stdlib.h>
#include <stdio.h> // printf for error logging
#include <math.h>
#include "globals.h"
#include "dcomplex.h"
#include "prover.h"
#include "functors.h"
#include "mplimits.h"
#include "algaux.h"
#include "order.h"
#include "deval.h"
#include "interval.h"
#include "trig.h"
#include "nextline.h" /* subcomputation */
#include "graphstr.h"
#include "mpdoc.h"
#include "automode.h" /* get_activeline */
#include "probtype.h"
#include "cancel.h"
#include "pvalaux.h" /* obviously_positive */
#include "binders.h"
#include "mpmem.h"
#include "activate.h"
static int careful_assume(term t);
static int implies_by_transitivity(term p, term q);
// static int refute_numerically(term t);
static int same_form(term t, term s);
static int variant(term t, term s);
static int disjoin(term ineq1, term ineq2, term *ans);
static int odd_or_even(term a, term b, term *ans);
static int implies2(term, term);
static int trig_instantiate(term, term);
/*_____________________________________________________________*/
/* Prover.dll maintains the 'assumptions' array, whose entries
are linked lists of assumptions. This array is allocated by
allocate_doc_data. When we activate a document,
init_proverDLL is called and it makes the assumptions array
point to the space indicated in the doc data. */
static proverdata *proverDLL;
/* the only global variable in prover.dll,
and it is static. */
/*__________________________________________________________*/
eqnsolver get_solver(void)
{ return proverDLL->solver;
}
/*__________________________________________________________*/
assumption ** get_assumptions(void)
{ return proverDLL->assumptions;
}
/*__________________________________________________________*/
short get_nextassumption(void)
{ return proverDLL->nextassumption;
}
/*__________________________________________________________*/
void set_nextassumption(short n)
{ if(n > proverDLL->nextassumption && proverDLL->nextassumption != -1)
assert(0);
/* it can be set to -1 temporarily to turn off assumptions
and assumption-making, as when taking the derivative in setupdata */
proverDLL->nextassumption = n;
}
/*__________________________________________________________*/
term get_assumption(int i)
/* for i < nextassumption, returns the current value of the i-th assumption */
{ return proverDLL->assumptions[i]->prop;
}
/*__________________________________________________________*/
term * get_theorems(void)
{ return proverDLL->theorems;
}
/*__________________________________________________________*/
short get_nexttheorem(void)
{ return proverDLL->nexttheorem;
}
/*__________________________________________________________*/
void replace_assumption(int i, term t)
/* replace the i-th assumption */
{ permcopy(t,&(proverDLL->assumptions[i]->prop));
}
/*______________________________________________________*/
void init_proverDLL(proverdata *pData)
/* Called whenever we switch documents; it's passed pointers to
valid space for the assumptions and theorems. */
{ proverDLL = pData;
}
/*__________________________________________________________*/
term history(int n)
{ if(n < 0)
assert(0);
return proverDLL->history[n];
}
/*__________________________________________________________*/
static void adjust_colors(term *t)
/* Set the color bit in all colored subterms, hereditarily.
*/
{ unsigned short n;
int i;
term u,v;
if(ATOMIC(*t))
return;
n = ARITY(*t);
if(COLOR(*t))
{ if(NEGATIVE(*t))
{ v = ARG(0,*t);
if(ONE(v))
{ *t = tnegate(one);
HIGHLIGHT(*t);
HIGHLIGHT(ARG(0,*t));
return;
}
if(equals(v,infinity))
{ *t = tnegate(infinity);
HIGHLIGHT(*t);
HIGHLIGHT(ARG(0,*t));
return;
}
}
for(i=0;i<n;i++)
{ v = ARG(i,*t);
if(NEGATIVE(v))
/* avoid access violations on minusone and minusinfinity */
{ u = ARG(0,v);
if(ONE(u))
ARGREP(*t,i,tnegate(one));
if(equals(u,infinity))
ARGREP(*t,i,tnegate(infinity));
}
HIGHLIGHT(ARG(i,*t));
}
}
for(i=0;i<n;i++)
adjust_colors(ARGPTR(*t) + i);
}
/*__________________________________________________________*/
void set_history(int n, term t)
/* enter a permanent copy of t in history[n], after
setting the color bit of all subterms of colored subterms of t.
*/
{ if(n+5 >= (int) proverDLL->maxhistory)
{ unsigned mm = proverDLL->maxhistory + 100;
proverDLL->history = (term *) realloc(proverDLL->history,mm * sizeof(term));
if(!proverDLL->history)
nospace();
proverDLL->maxhistory = (unsigned)(proverDLL->maxhistory + 100);
proverDLL->permhistory = (unsigned long *) realloc(proverDLL->permhistory, mm * sizeof(unsigned));
if(!proverDLL->permhistory)
nospace();
}
adjust_colors(&t);
permcopy(t,&proverDLL->history[n]);
proverDLL->permhistory[n] = proverDLL->nextworkspace; // added 7.7.13
}
/*_________________________________________________________________*/
term * historyp(int n)
/* needed because we have to alter the bits of history[n]
when it is a checked solution. We can't just replace it
with a new copy with the bits set because that would
screw up permhistory and hence undo.
*/
{ return &proverDLL->history[n];
}
/*_________________________________________________________________*/
unsigned long get_nextperm(void)
/* used in conjunction with reset_nextperm to conserve
document-duration memory
*/
{ return proverDLL->nextworkspace;
}
/*_________________________________________________________________*/
void reset_nextperm(unsigned long n)
/* used in conjunction with get_nextperm to conserve
document-duration memory
*/
{ assert(n < proverDLL->maxworkspace);
proverDLL->nextworkspace = n;
}
/*_________________________________________________________________*/
void * permalloc(unsigned n)
/* substitute for malloc that gets space from permspace */
/* If the allocation fails, nospace() is called. */
/* Allocate n bytes in permspace. Since permspace is
measured in longs, we actually must allocate a multiple
of 4 bytes. Since terms are 10 bytes this wastes only
1/6 of the space when permspace is used to store terms,
so out of 128K, we could expect 21K to be wasted.
*/
{ void *ans;
unsigned long required;
int extra = (n & 3) ? 1 : 0; /* 1 if n is not divisible by 4 */
n = (n >> 2) + extra; /* divide by 4 to get the number of longs required, rounding up */
required = n + proverDLL->nextworkspace;
if(required > proverDLL->maxworkspace) /* need more space */
nospace(); /* don't realloc; if we get here there is
probably an infinite regress anyway. */
ans = (void *) ((unsigned long *) proverDLL->workspace + proverDLL->nextworkspace);
/* cast to void * to make pointer arithmetic work right
i.e. not wrap around
*/
proverDLL->nextworkspace += n;
return ans;
}
/*__________________________________________________________*/
/* if the memory-management of permspace changes, you
may want this function */
void permfree(void *x)
{ ; }
/*__________________________________________________________*/
/* 'theorems' is used to record derivations of indeterminate limits
prior to using L'Hopital's rule, and also to record results of proof
by induction. Things once put into 'theorems' are not removed by
'undo'. (If it's proved it's proved.) */
static int infer_literally(term);
static int refute_literally(term);
static term neg_ineq(term t);
static void delete_var(term);
static void erasecolors(term *);
#define DIR (dir == LEFTDIR ? LT : (dir == RIGHTDIR ? RT : centered))
#define KIND (kind == FULL ? full : punctured)
/*_______________________________________________________________________*/
/* TERM-MAKERS for some constants #-defined in maketerm.h
that are primarily used in the prover.
*/
term lambda1(term x,term t) /* for lambda-abstraction */
/* Not actually used in MathXpert */
{ term ans;
assert(ISATOM(x));
ans = make_term(LAM,2);
ARGREP(ans,0,x);
ARGREP(ans,1,t);
return ans;
}
/*_______________________________________________________________________*/
term infinitesimal(term x,term y)
/* x and y are infinitesimally close; y is standard */
{ term ans;
ans = make_term(INFINITESIMAL,2);
ARGREP(ans,0,x);
ARGREP(ans,1,y);
return ans;
}
/*_______________________________________________________________________*/
term ap1(term a,term b) /* for function application */
/* Not actually used in MathXpert */
{ term ans;
ans = make_term(AP,2);
ARGREP(ans,0,a);
ARGREP(ans,1,b);
return ans;
}
/*________________________________________________________________________*/
term denom1(term t)
/* must be defined on all t, but only needs to be correct if
t: RATIONAL */
{ term ans;
unsigned short f = FUNCTOR(t);
if(f == '-')
return denom1(ARG(0,t));
if(f == '/' && INTEGERP(ARG(0,t)))
return ARG(1,t);
if(INTEGERP(t))
return one;
if(equals(tred(type(t,INTEGER)),trueterm))
return one;
ans = make_term(DENOM,1);
ARGREP(ans,0,t);
return ans;
}
/*________________________________________________________________________*/
term numerator1(term t)
/* must be defined on all t, but only needs to be correct if
t: RATIONAL */
{ term ans;
unsigned short f = FUNCTOR(t);
if(f == '-')
return numerator1(ARG(0,t));
if(f == '/' && INTEGERP(ARG(0,t)))
return ARG(0,t);
if(INTEGERP(t))
return t;
if(equals(tred(type(t,INTEGER)),trueterm))
return t;
ans = make_term(NUMERATOR,1);
ARGREP(ans,0,t);
return ans;
}
/*________________________________________________________________*/
term tred(term t)
/* t should be of the form u:sometype (such terms are created by
type(u,sometype), usually by assumptions); we try to
reduce it to a simpler expression, eliminating the functor ':'.
Possible values of the type variable are INTEGER, R, RATIONAL, NATNUM,
DCOMPLEX. However, setup_varlist only uses INTEGER, R, and/or DCOMPLEX.
Types in MathXpert are like subsets, not like typings in a programming
language; an INTEGER is also of type R and type DCOMPLEX.
*/
/* IT IS ASSUMED THAT u HAS ALREADY BEEN ALGEBRAICALLY AND ARITHMETICALLY
SIMPLIFIED */
/* Can return t itself; does not ensure fresh space for the answer */
{ term u,v,a,b,ans,temp;
unsigned short f;
assumption **assumptions = proverDLL->assumptions;
int i,k,typecode;
unsigned short j;
assert(FUNCTOR(t) == ':');
u = ARG(0,t);
f = FUNCTOR(u);
assert(ISINTEGER(ARG(1,t)));
typecode = (int) INTDATA(ARG(1,t));
k = immediate(t);
if(k==1)
return trueterm;
if(k== -1)
return falseterm;
if(ISATOM(u))
/* check whether u:v is an assumption */
{ int i;
int nextassumption = proverDLL->nextassumption;
if(equals(u,eulere) || equals(u,pi_term))
{ if(typecode == R || typecode == DCOMPLEX)
return trueterm;
else
return falseterm; /* e and pi are irrational */
}
if(equals(u,complexi) && constant(complexi))
{ return (typecode == DCOMPLEX ? trueterm : falseterm);
}
for(i=0;i<nextassumption;i++)
{ if (assumptions[i] != NULL && equals(assumptions[i]->prop,t))
return trueterm;
}
return t; /* can't do anything */
}
if(f == '-' && typecode != NATNUM)
{ ARGREP(t,0,ARG(0,u));
return tred(t);
}
if(f == '-' && typecode == NATNUM)
return and(type(u,INTEGER),le(u,zero));
if(FUNCTOR(u) == '^' && typecode == INTEGER)
{ a = ARG(0,u);
b = ARG(1,u);
if(equals(tred(type(a,INTEGER)),trueterm) && equals(tred(type(b,INTEGER)),trueterm))
return or(ne(a,zero),ne(b,zero));
}
if(OBJECT(u))
{ switch(TYPE(u))
{ case DOUBLE :
if(typecode==DCOMPLEX)
return trueterm;
if(typecode==R)
return trueterm;
else
return falseterm;
/* e.g. (-1)^2.0 will be undefined then */
case INTEGER: /* deliberate fall-through */
case BIGNUM:
if(typecode == INTEGER)
return trueterm;
if(typecode == RATIONAL)
return trueterm;
if(typecode == R)
return trueterm;
if(typecode == DCOMPLEX)
return trueterm;
}
}
if(f == '/')
{ a = ARG(0,u);
b = ARG(1,u);
if(typecode == RATIONAL)
{ if(INTEGERP(a) && INTEGERP(b) && !ZERO(b))
return trueterm;
return and3(type(a,INTEGER),type(b,INTEGER),ne(b,zero));
}
if(typecode == INTEGER && numerical(u))
return falseterm; /* remember it's assumed u has been simplified already */
if(typecode == R) /* rational numbers in particular are real */
{ if(INTEGERP(a) && INTEGERP(b) && !ZERO(b))
return trueterm;
return and3(type(a,R), type(b,R), ne(b,zero));;
}
if(typecode == DCOMPLEX) /* rational numbers in particular are real */
{ if(INTEGERP(a) && INTEGERP(b) && !ZERO(b))
return trueterm;
return and3(type(a,DCOMPLEX), type(b,DCOMPLEX), ne(b,zero));;
}
if(typecode == INTEGER || typecode == NATNUM)
{ /* example, q!/n! : Z reduces to n<=q */
/* Mathpert does not have a functor DIVIDES, let alone
rules to deal with DIVIDES, but this examples is useful
in infinite series. */
if(FUNCTOR(a) == FACTORIAL && FUNCTOR(b) == FACTORIAL)
return lpt(le(ARG(0,b),ARG(0,a)));
}
return t; /* can't do anything */
}
if(
(f == '*' || (f == '+' && typecode != INTEGER))
&& (typecode == INTEGER || typecode == NATNUM ||
typecode == R || typecode == DCOMPLEX
)
)
{ unsigned short n = ARITY(u);
for(i=0;i<n;i++)
{ v = type(ARG(i,u),typecode);
temp = tred(v);
if(!equals(temp,trueterm))
break;
}
if(i==n)
return trueterm;
}
if(f == '*' && (typecode == RATIONAL))
/* for example, 2*n: rational goes to n:rational */
{ unsigned short n = ARITY(u);
temp = make_term('*',n);
j=0;
for(i=0;i<n;i++)
{ v = type(ARG(i,u),RATIONAL);
k = immediate(v);
if( k != 1)
{ ARGREP(temp,j,ARG(i,u));
++j;
}
}
if(j==n)
{ RELEASE(temp);
return t;
}
if(j==0)
return trueterm;
if(j==1)
{ ans = type(ARG(0,temp),RATIONAL);
RELEASE(temp);
return ans;
}
else
{ SETFUNCTOR(temp,'*',(unsigned short) j);
return type(temp,RATIONAL);
}
}
if(f=='+' && (typecode == INTEGER))
/* for example, 2 + n: integer goes to n: integer */
{ unsigned short n = ARITY(u);
temp = make_term('+',n);
j=0;
for(i=0;i<n;i++)
{ v = type(ARG(i,u),INTEGER);
k = immediate(v);
if( k != 1)
{ ARGREP(temp,j,ARG(i,u));
++j;
}
}
if(j==n)
{ RELEASE(temp);
return t;
}
if(j==0)
return trueterm;
if(j==1)
{ ans = type(ARG(0,temp),INTEGER);
RELEASE(temp);
return ans;
}
else
{ SETFUNCTOR(temp,'+',j);
return type(temp,INTEGER);
}
}
if(typecode == NATNUM || typecode == INTEGER)
{ /* closure under integer-valued functions */
if(f == FACTORIAL)
return tred(type(ARG(0,u),NATNUM)); /* needed in Weierstrass */
if(f == ABSFUNCTOR)
return tred(type(ARG(0,u),INTEGER));
if(f == '^' && INTEGERP(ARG(1,u)))
return tred(type(ARG(0,u),typecode));
if(f == SUM || f == PRODUCT)
{ /* example, sum(q!/n!,n,0,q) is an integer */
int savebinderflag;
fillbinders(u);
savebinderflag = get_lpt_binderflag();
set_lpt_binderflag(0);
temp = tred(type(ARG(0,u),typecode));
set_lpt_binderflag(savebinderflag);
releasebinders();
if(!contains(temp,FUNCTOR(ARG(1,u))))
return temp;
}
}
if(typecode == NATNUM && equals(tred(type(ARG(0,u),INTEGER)),trueterm))
return lpt(le(zero,ARG(0,u))); /* example, in the proof of irrationality of e,
Weierstrass gets here with ARG(0,u) = q-1 and 0 < q assumed.
Then lpt converts 0 <= q-1 to 1<=q and manages to deduce it
since q: Z */
if(typecode == INTEGER && f == FLOOR)
return tred(type(ARG(0,u),R)); /* floor is not defined for complex args */
if(!get_complex() && typecode == R)
return domain(u); /* anything defined is real provided !complex */
if(typecode == DCOMPLEX)
return domain(u);
if(get_complex() && typecode == R && !is_complex(u))
{
set_complex(0);
ans = domain(u); // e.g. sqrt(-1) will not satisfy domain(u) with complex off
set_complex(1);
}
return t;
}
/*_____________________________________________________________________*/
int implies_instantly(term a, term b)
/* if a=>b is NUMERICALLY or otherwise obvious return 1;
else return 0. */
/* Tests NE,LE,'<', but not GE and '>' */
/* examples: 1 <= n implies 0 < n;
1 <= n implies 0 <=n;
1 < x implies x != 0 */
/* But: (0 < x or x != 0 ) implies instantly (1 < x or x != 0),
because each disjunct of the first implies instantly one of the
disjuncts of the second.
And: 2x+1 = 0 implies_instantly (x != 0 and x!= 1), because
it implies_instantly each conjunct. */
/* if b differs from a only by re-naming an EXISTENTIAL variable,
then a=>b. That's because exists(n,a(n)) => exists(m,a(m)). */
/* Also: (x < y) implies (x^2 < y^2) and so on for even exponents */
/* Also: abs(x) != abs(y) implies x != y */
/* Also: abs(x) < abs(y) implies 0 < y^2 - x^2, and x^2 < y^2 */
/* and finally, calls fasttrig for inference of trig inequalities like
sin x != 0 from the intervals like n\pi < x < (n+1)\pi recorded
in the assumptions */
/* also: 0 <= cos t implies 0 <= sec t
and 0 <= sin t implies 0 <= csc t
as needed in trig substitutions */
{ unsigned short f = FUNCTOR(b);
unsigned short g = FUNCTOR(a);
int i,r,err;
term u,v,p,q;
double x,y;
if(equals(a,b))
return 1;
if(variant(a,b))
return 1;
if(g==OR && f==OR)
{ unsigned short na = ARITY(a);
unsigned short nb = ARITY(b);
int i,j;
for(i=0;i<na;i++)
{ u = ARG(i,a);
for(j=0;j<nb;j++)
{ if(implies_instantly(u,ARG(j,b)))
break;
}
if(j == nb)
return 0; /* u doesn't imply_instantly any disjunct of b */
}
return 1; /* every arg of a implies_instantly some arg of b */
}
if(f==OR)
{ for(i=0;i<ARITY(b);i++)
{ if(implies_instantly(a,ARG(i,b)))
return 1;
}
}
if(g == OR)
{ for(i=0;i<ARITY(a); i++)
{ if(!implies_instantly(ARG(i,a),b))
break;
}
if(i == ARITY(a))
return 1;
}
if(f==AND && g==AND && interval_as_and(a) && interval_as_and(b) && equals(ARG(1,ARG(0,a)),ARG(1,ARG(0,b))))
{ if(implies_instantly(ARG(0,a),ARG(0,b)) && implies_instantly(ARG(1,a),ARG(1,b)))
return 1;
if(trig_instantiate(b,a))
return 1; /* example, -pi/2 < x < pi/2 implies npi - pi/2 < x < npi + pi/2 */
}
if(f==AND)
{ for(i=0;i<ARITY(b);i++)
{ if(!implies_instantly(a,ARG(i,b)))
break;
}
if(i==ARITY(b))
return 1;
}
if(g==AND)
{ if(implies_instantly(ARG(0,a),b))
return 1;
if(implies_instantly(ARG(1,a),b))
return 1;
if(interval_as_and(a) && ATOMIC(ARG(1,ARG(0,a))) &&
(f == NE || f == LE || f == '<')
) /* avoid calling domain_implies (which is overlaid)
in cases where it obviously can't help. */
{ term x;
if(implies_by_transitivity(a,b))
return 1;
v = ARG(0,b);
u = ARG(1,b);
x = ARG(1,ARG(0,a));
if(f == NE &&
(ZERO(v) || ONE(v))
)
{ term temp = u;
u=v;
v = temp;
}
if(ZERO(u) || ONE(u))
{ if(
(
TRIGFUNCTOR(FUNCTOR(v)) ||
(FUNCTOR(v) == '^' &&
TRIGFUNCTOR(FUNCTOR(ARG(0,v))) &&
equals(ARG(1,v),two) &&
equals(x,ARG(0,v))
) ||
(FUNCTOR(v) == '+' && /* sin x \pm 1 !=0 */
ARITY(v) == 2 &&
(ONE(ARG(1,v)) || equals(ARG(1,v),minusone)) &&
TRIGFUNCTOR(FUNCTOR(ARG(0,v))) &&
equals(x,ARG(0,ARG(0,v)))
) ||
(FUNCTOR(v) == '+' && /* 1 \pm sin x != 0 */
ARITY(v) == 2 &&
(ONE(ARG(0,v)) || equals(ARG(0,v),minusone)) &&
TRIGFUNCTOR(FUNCTOR(ARG(1,v))) &&
equals(x,ARG(0,ARG(1,v)))
) ||
(FUNCTOR(v) == '+' && /* sin x \pm cos x != 0 */
ARITY(v) == 2 &&
FUNCTOR(ARG(0,v)) == SIN &&
equals(x,ARG(0,ARG(0,v))) &&
((FUNCTOR(ARG(1,v)) == COS && equals(x,ARG(0,ARG(1,v))))
||
(NEGATIVE(ARG(1,v)) && FUNCTOR(ARG(1,v))==COS &&
equals(x,ARG(0,ARG(0,ARG(1,v))))
)
)
)
)
&&
domain_implies(a,b)
)
return 1;
}
}
}
if(f == LE && g == '=')
{ /* u=v implies u <= v */
if(equals(ARG(0,a),ARG(0,b)) && equals(ARG(1,a),ARG(1,b)))
return 1;
if(equals(ARG(0,a),ARG(1,b)) && equals(ARG(1,a),ARG(0,b)))
return 1;
}
if(f != NE && f != LE && f != '<')
return 0;
if(g != NE && g != LE && g != '<' && g != '=')
return 0;
p = ARG(0,b);
q = ARG(1,b);
u = ARG(0,a);
v = ARG(1,a);
/* z + m <= n implies m <= n if z:N */
/* this clause is needed in Weierstrass' proof of the irrationality of e */
if(FUNCTOR(u) == '+' && ARITY(u) == 2 &&
ISATOM(ARG(0,u)) && TYPE(ARG(0,u)) == NATNUM &&
equals(q,v) && equals(p,ARG(1,u))
)
return 1;
/* 0 < q implies 1 <= q if q:N; more generally u < q implies p <= q if
q:N and p<= u+1 */
if(ISINTEGER(u) && ISINTEGER(p) &&
INTDATA(p) <= INTDATA(u) + 1 &&
equals(v,q) && isinteger(v)
)
return 1;
if(f == g && ZERO(p) && ZERO(u) && ARITY(q) == 1 && ARITY(v) == 1 &&
((FUNCTOR(v) == COS && FUNCTOR(q) == SEC) || (FUNCTOR(v) == SIN && FUNCTOR(v) == CSC)) &&
equals(ARG(0,v),ARG(0,q))
)
return 1;
if((f== NE || f == '=') && seminumerical(p) && !seminumerical(q))
/* then switch the args so p is the non-seminumerical one */
{ term temp = make_term(f,2);
ARGREP(temp,0,q);
ARGREP(temp,1,p);
r = (equals(temp,a) || implies_instantly(a,temp));
RELEASE(temp);
return r;
}
if(f == NE && g == NE)
{ if(equals(p,v) && equals(q,u)) /* args are switched */
return 1;
/* abs(p) != abs(q) => p != q */
if(FUNCTOR(u) == ABSFUNCTOR && FUNCTOR(v) == ABSFUNCTOR &&
(
(equals(ARG(0,u),p) && equals(ARG(0,v),q)) ||
(equals(ARG(0,u),q) && equals(ARG(0,v),p))
)
)
return 1;
else
return 0;
}
if( (f==g || (g == '<' && f == LE)) &&
FUNCTOR(p) == '^' && FUNCTOR(q) == '^' &&
INTEGERP(ARG(1,p)) && ISEVEN(ARG(1,p)) &&
equals(ARG(1,p),ARG(1,q)) &&
equals(u,ARG(0,p)) && equals(v,ARG(0,q))
)
return 1; /* u < v => u^(2n) < v^(2n) */
if(f == LE && (g == LE || g == '<') && ZERO(p) && ZERO(u) && !ZERO(v) &&
!(ATOMIC(q) && ATOMIC(v)) /* no need wasting time on cancel then */
)
{ /* 0 < 2a => 0 < a; this arises when there is an
interval 0 < x < 2a in the assumption list and we
try to infer 0 <= a */
term cancelled,zz;
int err = cancel(q,v,&cancelled,&zz);
if(!err && obviously_positive(zz))
return 1;
}
if(
(f == g || (g == '<' && f == LE)) &&
FUNCTOR(u) == ABSFUNCTOR && FUNCTOR(v) == ABSFUNCTOR &&
FUNCTOR(p) == '^' && FUNCTOR(q) == '^' &&
equals(ARG(1,p),two) && equals(ARG(1,q),two) &&
equals(ARG(0,p),ARG(0,u)) && equals(ARG(0,q),ARG(0,v))
)
return 1; /* abs(w) < abs(z) => w^2 < z^2 */
if(
(f == g || (g == '<' && f == LE)) &&
FUNCTOR(u) == ABSFUNCTOR && FUNCTOR(v) == ABSFUNCTOR &&
ZERO(p) && FUNCTOR(q) == '+' && ARITY(q) == 2
)
{ /* abs(w) < abs(z) => 0 < z^2-w^2 */
term w = ARG(0,u);
term z = ARG(0,v);
term c = ARG(0,q);
term d = ARG(1,q);
if(FUNCTOR(c) == '^' && equals(ARG(1,c),two) && equals(ARG(0,c),z) &&
NEGATIVE(d) && FUNCTOR(ARG(0,d)) == '^' && equals(ARG(1,ARG(0,d)),two) &&
equals(ARG(0,ARG(0,d)),w)
)
return 1;
}
switch(f)
{ case NE: if(equals(p,v)) /* u g v => v != q */
{ if((g == '<' || g == '>') && equals(u,q))
return 1;
if(!seminumerical(q) || !seminumerical(u))
return 0;
err = deval(u,&x);
if(err)
return 0;
err = deval(q,&y);
if(err)
return 0;
if(g == '<')
return y<=x ? 1 : 0;
if(g == LE)
return y<x ? 1 : 0;
if(g == '=')
return fabs(y-x) < VERYSMALL ? 0 : 1;
return 0;
}
else if(equals(p,u)) /* u g v => u != q */
{ if((g == '<' || g == '>') && equals(v,q))
return 1;
if(!seminumerical(q) || !seminumerical(v))
return 0;
err = deval(v,&x);
if(err)
return 0;
err = deval(q,&y);
if(err)
return 0;
if(g == '<')
return y>=x ? 1 : 0;
if(g == LE)
return y>x ? 1 : 0;
if(g == '=')
return fabs(y-x) < VERYSMALL ? 0 : 1;
return 0;
}
else if(equals(q,v)) /* example, 1<x implies instantly 0!=x */
{ if(g != '<' )
return 0;
if(!seminumerical(p) || !seminumerical(u))
return 0;
err = deval(u,&x);
if(err)
return 0;
err = deval(p,&y);
if(err)
return 0;
return (y >= x ? 1 : 0);
}
return 0;
case '<': if(equals(u,p)) /* u g v => u < q */
{ if(!seminumerical(v) || !seminumerical(q))
return 0;
err = deval(v,&x);
if(err)
return 0;
err = deval(q,&y);
if(err)
return 0;
if(g == '<')
return x<=y ? 1 : 0;
if(g == LE)
return x<y ? 1 : 0;
if(g == '=')
return (x + VERYSMALL < y) ? 1 : 0;
return 0;
}
if(equals(q,v)) /* u g v => p < v */
{ if(!seminumerical(u) || !seminumerical(p))
return 0;
err = deval(u,&x);
if(err)
return 0;
err = deval(p,&y);
if(err)
return 0;
if(g == '<')
return y<=x ? 1 : 0;
if(g == LE)
return y<x ? 1 : 0;
if(g == '=')
return (y + VERYSMALL) < x ? 1 : 0;
return 0;
}
return 0;
case LE: if(equals(u,p)) /* u g v => u \le q */
{ if(g == '<' && equals(v,q))
return 1;
if(g == NE || !seminumerical(v) || !seminumerical(q))
return 0;
err = deval(v,&x);
if(err)
return 0;
err = deval(q,&y); /* u g x => u \le y */
if(err)
return 0;
return x<=y ? 1 : 0;
}
if(equals(q,v)) /* u g v => p \le v */
{ if(g == NE || !seminumerical(u) || !seminumerical(p))
return 0;
err = deval(u,&x);
if(err)
return 0;
err = deval(p,&y);
if(err)
return 0;
return y<=x ? 1 : 0;
}
return 0;
}
return 0;
}
/*_____________________________________________________________________*/
int immediate(term t)
/* return 1 if proposition t can be 'immediately' proved;
return -1 if it can be 'immediately' refuted;
return 0 if neither is the case */
/* specifically, if t is an assumption (but not a PROVISIONAL assumption)
or axiom, or the reverse of an inequality which is an axiom;
or t is a != b and abs(a) != abs(b) is an assumption,
or t is a != -b and abs(a) != abs(b) is an assumption,
or if t follows by simple type embedding arguments. */
/* Numerical computation is NOT considered 'immediate'; it
is tried separately by lpt before 'immediate' is called, so what is passed
to immediate should already be simplified as much as 'value' can do. */
/* However, things like x != -1 when 0<x is an assumption are not
'numerical computation' in the sense that the assumptions must be examined;
so these DO fall to 'immediate'; they are handled by implies_instantly. */
/* Some things involving infinitesimals are handled by 'nonstandard', not
by immediate; but inequalities in the binders list are used here. */
{ int i,k,typecode;
termlist *marker, *marker2;
assumption **assumptions = proverDLL->assumptions;
int nextassumption = proverDLL->nextassumption;
term u,v,w,temp;
unsigned short f = FUNCTOR(t);
if(equals(t,trueterm))
return 1;
if(f==EVEN1 && COMPOUND(t) && OBJECT(ARG(0,t)))
{ u = ARG(0,t);
if(TYPE(u)==INTEGER)
return (EVEN(u) ? 1 : -1);
if(TYPE(u)==BIGNUM)
return (BIGEVEN(u) ? 1 : -1);
return 0;
}
if(f==ODD1 && COMPOUND(t) && OBJECT(ARG(0,t)))
{ u = ARG(0,t);
if(TYPE(u)==INTEGER)
return (ODD(u) ? 1 : -1);
if(TYPE(u)==BIGNUM)
return (BIGODD(u) ? 1 : -1);
return 0;
}
if((f== '<' || f == '=' || f == LE || f == NE) && isbinder(t))
return 1;
if(f == LE && ISATOM(ARG(1,t)) && TYPE(ARG(1,t)) == NATNUM)
{ if(ZERO(ARG(0,t)))
return 1;
if(obviously_negative(ARG(0,t)))
return 1;
}
if(f==NE && ATOMIC(ARG(0,t)) && ATOMIC(ARG(1,t)) && (NOTDEFINED(ARG(0,t)) || NOTDEFINED(ARG(1,t))))
return !equals(ARG(0,t),ARG(1,t)); /* infinity != 5, etc. */
if(f=='=' && ATOMIC(ARG(0,t)) && ATOMIC(ARG(1,t)) && (NOTDEFINED(ARG(0,t)) || NOTDEFINED(ARG(1,t))))
return equals(ARG(0,t),ARG(1,t));
if(f==LE && ATOMIC(ARG(0,t)) && ATOMIC(ARG(1,t)) && (NOTDEFINED(ARG(0,t)) || NOTDEFINED(ARG(1,t))))
return (equals(ARG(1,t),infinity) || equals(ARG(0,t),minusinfinity));
if(f=='<' && ATOMIC(ARG(0,t)) && ATOMIC(ARG(1,t)) && (NOTDEFINED(ARG(0,t)) || NOTDEFINED(ARG(1,t))))
return ((equals(ARG(1,t),infinity) || equals(ARG(0,t),minusinfinity)) && !equals(ARG(0,t),ARG(1,t)));
for(i=0;i<nextassumption;i++)
{ u = assumptions[i]->prop;
if(PROVISIONAL(u))
continue; /* don't use provisional assumptions */
if( equals(t,u))
return 1;
if(implies_instantly(u,t))
return 1;
if(INEQUALITY(f))
{ temp = neg_ineq(t);
if(equals(u,temp) || implies_instantly(u,temp))
{ RELEASE(temp);
return -1;
}
RELEASE(temp);
}
if( ((f == '<' && FUNCTOR(u) == '>') ||
(f == LE && (FUNCTOR(u) == GE || FUNCTOR(u) == '>'))
)
&& equals(ARG(0,t),ARG(1,u)) && equals(ARG(1,t),ARG(0,u))
)
return 1;
}
/* Now do the same thing with the binders as with the assumptions */
for(marker = get_binders(); marker != NULL; marker = marker->next)
{ u = marker->data;
if( equals(t,u))
return 1;
if(implies_instantly(u,t))
return 1;
if(INEQUALITY(f) && implies_instantly(u,neg_ineq(t)))
return -1;
if( ((f == '<' && FUNCTOR(u) == '>') ||
(f == LE && (FUNCTOR(u) == GE || FUNCTOR(u) == '>'))
)
&& equals(ARG(0,t),ARG(1,u)) && equals(ARG(1,t),ARG(0,u))
)
return 1;
/* In case of nested binders we need to use transitivity
chaining, e.g. after limittointegral we need to deduce
x<=1 from the two binder inequalities x<=t and t<=1;
or 1<=x from 1<=t and t<=x. */
if((f == LE || f == '<' || f == NE) && equals(ARG(0,t),ARG(0,u)))
/* return immediate(le(ARG(1,u),ARG(1,t))); (for f == LE)
I don't dare include this because it might cause
loops if the assumptions are inconsistent. */
{ /* Just look through the binders list. */
v = (f == LE || FUNCTOR(u) == '<') ? le(ARG(1,u),ARG(1,t)) : lessthan(ARG(1,u),ARG(1,t));
for(marker2 = get_binders(); marker2 != NULL; marker2 = marker2->next)
{ w = marker2->data;
if(equals(w,u))
continue;
if(equals(w,v))
return 1;
if(f == LE && FUNCTOR(w) == '<' && equals(ARG(0,w),ARG(0,v)) && equals(ARG(1,w),ARG(1,v)))
return 1;
if(implies_instantly(w,v))
return 1;
}
}
if(f == NE && equals(ARG(1,t),ARG(0,u)))
/* switch the role of ARG(1,t) and ARG(0,t) in the code above */
{ v = FUNCTOR(u) == '<' ? le(ARG(1,u),ARG(0,t)) : lessthan(ARG(1,u),ARG(0,t));
for(marker2 = get_binders(); marker2 != NULL; marker2 = marker2->next)
{ w = marker2->data;
if(equals(w,u))
continue;
if(equals(w,v))
return 1;
if(implies_instantly(w,v))
return 1;
}
}
}
if(f == ':')
{ u = ARG(0,t);
if(!ISINTEGER(ARG(1,t)))
return 0; /* atomic types are the only types used in Mathpert, but in
future theorem-provers assert(0) may not be appropriate here. */
typecode = (int) INTDATA(ARG(1,t));
if(typecode != NATNUM && FUNCTOR(u) == '-')
{ ARGREP(t,0,ARG(0,u));
return immediate(t);
}
if(!ATOMIC(u) && FUNCTOR(u) != '*' && FUNCTOR(u) != '+')
return 0; /* it won't be immediate */
else if(!ATOMIC(u)) /* u is a sum or product */
{ for(i=0;i<ARITY(u);i++)
{ k = immediate(type(ARG(i,u),typecode));
if(k != 1)
return 0;
}
return 1; /* these types are closed under sum and product */
}
if(ATOMIC(u)) /* type is in the .info field of the term */
{ if(typecode==TYPE(u))
return 1;
if(embedded_type(TYPE(u),typecode))
return 1;
}
if(typecode == INTEGER)
{ if(INTEGERP(u))
return 1;
v = type(u,NATNUM);
k = immediate(v);
if(k==1)
{ RELEASE(v);
return 1;
}
RELEASE(v);
v = even(u);
k = immediate(v);
if(k==1)
{ RELEASE(v);
return 1;
}
RELEASE(v);
v = odd(u);
k = immediate(v);
if(k==1)
{ RELEASE(v);
return 1;
}
RELEASE(v);
return 0;
}
if(typecode == RATIONAL)
{ v = type(u,NATNUM);
k = immediate(v);
RELEASE(v);
if(k==1)
return 1;
v = type(u,INTEGER);
k = immediate(v);
RELEASE(v);
if(k==1)
return 1;
if(FUNCTOR(u)== '/')
{ v = type(ARG(0,u),INTEGER);
k = immediate(v);
if(k==1)
{ RELEASE(v);
v = type(ARG(1,u),INTEGER);
k = immediate(v);
if(k==1)
{ RELEASE(v);
v = ne(ARG(1,u),zero);
k = immediate(v);
if(k==1)
{ RELEASE(v);
return 0;
}
RELEASE(v);
return 1;
}
RELEASE(v);
return 0;
}
RELEASE(v);
return 0;
}
}
if(typecode == R)
{ int nextdefn;
if(FUNCTOR(u)==REALPART)
return 1;
if(FUNCTOR(u)==IMAGPART)
return 1;
nextdefn = get_nextdefn();
/* following allows for "let z = x+iy" */
for(i=0;i<nextdefn;i++)
{ v = get_defn(i).right;
if(FUNCTOR(v) == '+' && ARITY(v)==2 &&
ISATOM(ARG(0,v)) && FUNCTOR(ARG(1,v))=='*'
&& ARITY(ARG(1,v))==2 && equals(ARG(0,ARG(1,v)),complexi)
&& ISATOM(ARG(1,ARG(1,v))) &&
(equals(u,ARG(0,v)) || equals(u,ARG(1,ARG(1,v))))
)
return 1;
}
return 0;
}
if(typecode == DCOMPLEX)
return get_complex() ? 1 : -1;
}
return 0; /* can't do anything */
}
/*_____________________________________________________________________*/
/* While calculating domains, we need to make "check" mean "infer", so
no assumptions are made. Making assumptions during domain calculations
leads to wrong answers that expressions are undefined, e.g.
1/(a^2 + b^2) leads to solving the equation a^2 + b^2 = 0, which leads
it to assume b = 0 as the domain of sqrt(-b^2).
*/
static int stopcheckflag;
void stopcheck(void)
{ stopcheckflag = 1;
}
void startcheck(void)
{ stopcheckflag = 0;
}
/*_____________________________________________________________________*/
int check1(term t)
/* Return 0 for successful inference or assumption after failure to
infer or refute.
Return 1 for refutation after failure to infer.
Return 2 for failure to infer or refute, and refusal to assume because
it involves the eigenvariable while solving equations. */
/* check must terminate */
/* When an operator has a side condition, 'check' is called before executing
it. It tries to check the side condition by first inferring it (in which
case no assumption will be generated), then refuting it (in which case the
operator will fail), and finally gives up and assumes it.
This is made more complicated by the presence of bound variables, as
when sqrt(x+h) occurs inside lim(h->0, sqrt(x+h)). Then the
condition to be checked is not what is literally specified by the
side condition of the rule. (In this case the actual condition is x > 0,
while the literally specified condition is x+h \ge 0.)
This is handled as follows: when traversing the term, when we go into
a term with a binding functor, we make appropriate assumptions, which
are discharged when the traversal exits from that term. These assumptions
are kept in a special linked list 'binders' that is handled by fillbinders'.
When solving equations, however, we don't want to make assumptions
that involve the eigenvariable.
*/
/* Technical note: in MATHPERT, the same variable never occurs both free
and bound in any expression. Variables can occur bound twice, but scopes
can't be nested and binding operators must be identical.
So variables can be unambiguously labelled
'free' or 'bound' in any expression (or 'halfbound', as in integral(u,x)
and diff(u,x)), and if t contains a bound variable, that occurrence is in
the scope of a binding of that variable. */
{
int currentline = get_currentline();
int problemtype = get_problemtype();
int err;
if(!ALREADY(t))
{ err = immediate(t);
if(err == 1)
return 0; /* sometimes this will work when after lpt infer won't work,
e.g. if t is cot x != 0 and the assumptions contain
cot x = 1. lpt(cot(x) != 0) is n pi/2 < x < (n+1)pi/2.
*/
if(err == -1)
return 1; /* refuted */
}
if(stopcheckflag)
{ err = infer(lpt(t));
if(err == 1)
return 2;
if(err == 2)
return 1;
if(err != 0)
assert(0);
return 0;
}
if(SOLVETYPE(problemtype) &&
problemtype != INEQUALITIES &&
currentline >= 0 &&
implies_instantly(history(currentline),t)
)
return 0; /* as above, sometimes we need to beat lpt to the punch */
return(check_literally(lpt(t)));
}
/*_________________________________________________________________*/
int check_literally(term t)
/* implement the infer,refute,assume idea without prior symbolic
reductions or checking for bound variables */
/* Return value 0 means success, t was inferred or assumed.
Return value 1 means it was refuted.
Return value 2 means it was neither inferred, refuted, or assumed,
because it involved the eigenvariable while solving equations.
*/
{ int err,i,j,count,first=0,second=0;
term u,v,w;
if(FUNCTOR(t)==AND)
{ unsigned short n = ARITY(t);
int nvariables = get_nvariables();
varinf *varinfo = get_varinfo();
int variantflag = 0;
int *scratchpad = callocate(n,sizeof(int));
if(scratchpad == NULL)
nospace();
/* We want to drop duplicate conditions like x != n pi and x!= m pi.
This is logically legitimate to do here (as opposed to in lpt)
because these are implicitly preceded by forall, and
forall(n,x!=n pi_term) is equivalent to forall(m,x!=m pi_term). The
function 'variant' called to check this equivalence assumes
the conditions have at most one existential variable each.
If this fails to hold, no error will result, only some duplicate
assumptions won't be eliminated. */
for(i=0;i<nvariables;i++)
{ if(varinfo[i].scope == EXISTENTIAL)
++variantflag;
}
/* if variantflag < 2 we don't have to worry about m pi and n pi */
for(i=0;i<n;i++)
{ v = ARG(i,t);
err = infer_literally(v);
if(err)
{ err = refute_literally(v);
if(!err)
{ free2(scratchpad);
return 1; /* check fails, t is refuted */
}
else if(variantflag >= 2)
/* check that v isn't a duplicate of an earlier arg */
{ for(j=0;j<i;j++)
{ if(variant(ARG(j,t),v))
break;
}
if(j==i) /* not a variant */
scratchpad[i] = 1; /* assume v later if t isn't refuted */
/* and if it IS a variant, don't assume it. */
}
else
scratchpad[i] = 1; /* assume v later if t isn't refuted */
}
}
count = 0; /* count the remaining terms */
for(i=0;i<n;i++)
{ if(scratchpad[i])
{ if(count == 0)
first = i;
else if (count == 1)
second = i;
++count;
}
}
if(count == 2) /* don't miss an interval_as_and occurring as
an arity-4 and with two variants */
{ t = and(ARG(first,t),ARG(second,t));
n = 2;
}
if(interval_as_and(t))
{ err = careful_assume(t);
free2(scratchpad);
return err;
}
for(i=0;i<n;i++)
{ if(scratchpad[i])
{ w = ARG(i,t);
if(FUNCTOR(w)== OR)
{ for(j=0;j<n;j++)
{ if(scratchpad[j] && j != i)
{ err = orrule1(ARG(j,t),w,&u);
if(!err)
{ ARGREP(t,i,u);
break;
}
}
}
err = careful_assume(ARG(i,t)); /* which might not still be w */
if(err == 2)
{ free2(scratchpad);
return 2;
}
}
else if(
(FUNCTOR(w) == '<' || FUNCTOR(w) == LE) &&
i<n-1 && scratchpad[i+1]
)
{ term r = ARG(i+1,t);
if(FUNCTOR(r) == '<' || FUNCTOR(r) == LE)
{ term temp = and(w,r);
if(interval_as_and(temp))
{ err = careful_assume(temp);
if(err == 2)
{ free2(scratchpad);
return 2;
}
++i;
}
else
{ RELEASE(temp);
err = careful_assume(w);
if(err == 2)
{ free2(scratchpad);
return 2;
}
}
}
else
{ err = careful_assume(w);
if(err == 2)
{ free2(scratchpad);
return 2;
}
}
}
else
{ err = careful_assume(w);
if(err == 2)
{ free2(scratchpad);
return 2;
}
}
}
}
free2(scratchpad);
return 0;
}
err = infer_literally(t);
if(!err)
return 0;
err = refute_literally(t);
if(!err)
return 1;
return careful_assume(t);
}
/*____________________________________________________________________*/
static int careful_assume(term t)
/* Return 2 if we're solving inequalities and t contains the
eigenvariable, and get_currentline() is nonnegative.
Return 2 if we're solving equations and t contains the eigenvariable
and get_currentline() is nonnegative and t can't be deduced from the
current line. If it CAN be deduced from the current line, return 0.
Otherwise, assume t and return 0.
Purpose: don't make assumptions involving the eigenvariable while
solving equations, or else you lose roots, as in dividing x(x-1)= 0 by x.
When solving equations (not inequalities) it is permissible to use
the current (or previous) lines to derive t, as in dividing x = 1 by x,
we can derive x != 0 from x = 1.
*/
{ int problemtype = get_problemtype();
int currentline = get_currentline();
int activeline = get_activeline();
short savenextassumption;
int savenvariables, saveeigen, err;
term p,q;
term x = get_eigenvariable();
if(activeline > 0)
currentline = activeline; // currentline < 0 before we have the problem checked; activeline is ALWAYS >=0.
if(!SOLVETYPE(problemtype) || currentline < 0 ||
/* currentline < 0 because after analyzing the domain,
before starting to solve the problem, you MUST make domain
assumptions involving the eigenvalue */
!contains(t,FUNCTOR(x)) ||
(SOLVETYPE(problemtype) &&
problemtype >= LIMITS && /* e.g. in implicit differentiation */
problemtype != MINMAX /* here we're not solving for a derivative */
)
)
{ assume(t);
return 0;
}
if(problemtype == INEQUALITIES)
return 2;
/* Now check whether t can be derived from the current line. */
if(inconsistent(t))
return 2; /* example, dividing x = 0 by x */
saveeigen = get_eigenindex();
savenvariables = get_nvariables();
savenextassumption = get_nextassumption();
p = history(currentline);
assume(p);
copy(t,&q);
clear_already(&q); /* otherwise lpt won't touch it, but it should because
there's a new assumption to use. */
err = infer(q);
destroy_term(q);
set_nvariables(savenvariables);
set_eigenvariable(saveeigen);
set_nextassumption(savenextassumption);
return err ? 2 : 0;
}
/*_____________________________________________________________________*/
int infer(term t)
/* return 0 for successful inference,
return 1 for failure to infer, but not refutation either
return 2 for refutation */
/* infer must terminate */
/* Unsuccessful inferences should not create new variables; thus
before returning an error, we reset nvariables to eliminate
any new variables that may have been created. lpt can create new
(integer) variables and even make assumptions about those variables.
Unsuccessful inferences must therefore eliminate any assumptions
that were made, too.
Successful inferences ALSO must eliminate new variables unless
those variables occur in the (new) assumptions.
*/
{ int err,retval,r;
int nvariables;
int saveit = get_nvariables();
int saveeigenvariable = get_eigenindex();
short savenextassumption = get_nextassumption();
varinf *varinfo;
term *varlist;
term mid;
if(ALREADY(t))
mid = t;
else
{ r = immediate(t);
if(r==1)
/* sometimes t will be immediate but lpt(t) will not be inferred,
e.g. if t is cot(x) != 0 and the assumptions list contains cot x = 1,
lpt will reduce cot(x) != 0 to n pi/2 < x < (n+1)pi/2 which is
not inferred from cot x = 1.
*/
{ retval = 0;
goto success;
}
else if(r == -1)
{ retval = 2;
goto fail;
}
#if 0
/* This code is logically incorrect. Just because t is false for SOME values of the variables doesn't mean it's refuted. */
if(INEQUALITY(FUNCTOR(t)) && !get_binders() && !refute_numerically(t))
return 2; /* quickly */
#endif
mid = lpt(t);
}
if(equals(mid,falseterm))
{ retval = 2;
goto success;
}
err = infer_literally(mid);
if(!err)
{ retval = 0;
goto success;
}
if(err == 2)
{ retval = 2;
goto success;
}
if(FUNCTOR(mid) == AND)
{ int i;
nvariables = get_nvariables();
varinfo = get_varinfo();
varlist = get_varlist();
for(i=0;i<nvariables;i++)
{ if(varinfo[i].scope == EXISTENTIAL && contains(mid,FUNCTOR(varlist[i])))
{ err = infer_by_constraints(mid,i);
if(err)
goto fail;
else
{ retval = 0;
goto success;
}
}
}
}
fail:
set_nvariables(saveit);
set_nextassumption(savenextassumption);
set_eigenvariable(saveeigenvariable);
return 1;
success:
eliminate_vars(saveit,savenextassumption);
return retval;
}
/*___________________________________________________________________________*/
void eliminate_vars(int savenvariables, short savenextassumption)
/* eliminate unnecessary variables and assumptions. Specifically
all variables varlist[j] with j >= savenvariables are candidates
for elimination. ("new variable"). A new variable can be eliminated
if it is not contained in any assumption with index >= savenextassumption
that also contains another variable. Assumptions containing only
eliminated variables also should be eliminated.
*/
{ short nextassumption = get_nextassumption();
int scratch[MAXVARIABLES];
int *scratch2;
int *scratch3;
int i,j,n,k;
int nvariables= get_nvariables();
term *varlist = get_varlist();
term u;
term *atomlist;
assumption **assumptions;
memset(scratch,0,sizeof(scratch));
if(nvariables == savenvariables)
return; /* nothing to do */
if(nextassumption == savenextassumption)
{ /* eliminate all the new variables */
set_nvariables(savenvariables);
return;
}
scratch2 = (int *) callocate(nextassumption,sizeof(int));
if(scratch2==NULL)
nospace();
scratch3 = (int *) callocate(nextassumption,sizeof(int));
if(scratch3==NULL)
nospace();
for(i=savenvariables; i<nvariables;i++)
{ memset(scratch3,0,nextassumption*sizeof(int));
for(j=savenextassumption; j < nextassumption; j++)
{ u = get_assumption(j);
if(contains(u,FUNCTOR(varlist[i])))
{ /* does it contain any other variable ? */
n = variablesin(u,&atomlist);
free2(atomlist);
if(n > 1)
break; /* this variable can't be eliminated */
scratch[i] = 1; /* mark varlist[i] for possible elimination */
scratch3[j] = 1; /* mark assumptions[j] for possible elimination */
}
}
if(j < nextassumption)
scratch[i] = 0; /* don't eliminate varlist[i] even if it was marked before,
there was an assumption that contained it and
another variable */
else /* j == nextassumption, so either varlist[i] wasn't contained in
any new assumptions or those assumptions contained only that variable. */
{ /* copy new entries in scratch3 into scratch2 */
for(k=0;k<nextassumption;k++)
scratch2[k] |= scratch3[k];
}
}
/* Now go through varlist, moving variables down to
fill up the gaps where variables are to be eliminated */
for(i=nvariables-1;i >= savenvariables;i--)
{ if(scratch[i])
{ if(i==nvariables-1)
{ --nvariables;
set_nvariables(nvariables);
}
else
{ for(j=i; j < nvariables-1; j++)
swapvars(i,j);
/* Now the unwanted variable is last */
--nvariables;
set_nvariables(nvariables);
}
}
}
/* Now eliminate the assumptions marked in scratch2 for elimination. */
assumptions = get_assumptions();
for(i=nextassumption-1; i>=savenextassumption;i--)
{ if(scratch2[i])
{ for(j=i+1;j<nextassumption;j++)
assumptions[j-1] = assumptions[j];
--nextassumption;
set_nextassumption(nextassumption);
}
}
free2(scratch2);
free2(scratch3);
}
/*_____________________________________________________________________*/
int refute(term t)
/* return 0 for successful refutation, 1 for failure to refute*/
/* refute must terminate */
{ return refute_literally(lpt(t));
}
/*_____________________________________________________________________*/
static int infer_literally(term t)
/* return 0 for successful inference, 1 for failure to infer*/
/* Must terminate. Assumes t has already been through lpt and
does not check for bound variables (it's been done already).
Adds constraints on existential variables to the binders list and
leaves them there; does not attempt to determine if they are
consistent or to solve them. */
{ unsigned short f = FUNCTOR(t);
term p,q,u,v;
unsigned short n;
termlist *marker;
int i,j,err,saveit,nextassumption;
term saveu;
assumption **assumptions;
if(equals(t,trueterm))
return 0;
if(equals(t,falseterm))
return 1; /* without further ado */
nextassumption = proverDLL->nextassumption;
assumptions = proverDLL->assumptions;
for(i=0;i<proverDLL->nexttheorem;i++)
{ if(equals(t,proverDLL->theorems[i])) /* already proved */
return 0;
}
for(i=0;i<nextassumption;i++)
{ u = assumptions[i]->prop;
if(PROVISIONAL(u))
continue; /* don't use provisional assumptions */
if(equals(t,u)) /* Gentzen's axiom rule Gamma,A=>A */
return 0;
if(FUNCTOR(u) == OR)
{ /* Gentzen's rule is B or C => A provided B => A and C => A */
/* We need this in Mathpert e.g. to infer 0 < x when one of the
assumptions is or(0 < x < 1, 1 < x). */
saveu = u;
err = 0;
copy(t,&v);
/* t contains many ALREADY and PRIME markers that will interfere
with the next few lines of code, so make a temporary copy
from which we can remove those markers. */
for(j=0;j<ARITY(u);j++)
{ assumptions[i]->prop = ARG(j,u);
clear_already(&v);
err = infer(v);
if(err)
break;
}
destroy_term(v);
assumptions[i]->prop = saveu;
return err;
}
}
/* Temporary assumptions are also kept in the binders list */
for(marker = get_binders(); marker != NULL; marker = marker->next)
{ if(equals(t,marker->data))
return 0;
}
switch(f) /* Rules for introducing a connective in the succedent */
{ case AND :
n = ARITY(t); /* => and rule */
for(i=0;i<n;i++)
{ err = infer_literally(ARG(i,t));
if(err)
return 1;
}
return 0;
case OR :
n = ARITY(t); /* => or rule */
for(i=0;i<n;i++)
{ err = infer_literally(ARG(i,t));
if(!err)
return 0;
}
return 1;
case IMPLIES:
/*
Rule => -> is NEVER used in MATHPERT, even for definite integrals
as was originally planned, because the assumptions and discharges
prescribed in the code have to be mixed with the symbolic evaluation;
the assumption is made when we enter the integral and discharged when
we come out, so it is valid while the integral is being processed
by one_step or exec.
*/
p = ARG(0,t);
q = ARG(1,t);
saveit = nextassumption;
assume(p); /* temporarily */
err = infer_literally(q);
assert(nextassumption == saveit + 1);
discharge(saveit);
return err;
case NOT:
return refute_literally(ARG(0,t));
case FORALL:
break; /* return forall_rule(t); NOT USED in Mathpert */
}
/* Now the rules for introducing connectives in the antecedent */
/* Not needed in Mathpert */
return 1;
}
/*_____________________________________________________________________*/
static int refute_literally(term t)
/* return 0 for successful refutation, 1 for failure to refute */
/* Must terminate. Assume t has already been through lpt and checked
for bound variables. */
{ int i,err;
term temp;
unsigned short f = FUNCTOR(t);
unsigned short n;
if(equals(t,falseterm))
return 0;
if(equals(t,trueterm))
return 1;
if(PROTECTED(t))
return 1; /* don't try to refute protected propositions */
if(FUNCTOR(t)==AND)
{ n = ARITY(t);
for(i=0;i<n;i++)
{ err = refute_literally(ARG(i,t));
if(!err)
return 0;
}
return 1; /* failed to refute any conjunct */
}
if(FUNCTOR(t)==NOT)
return infer_literally(ARG(0,t));
if(FUNCTOR(t)==OR)
{ n = ARITY(t);
for(i=0;i<n;i++)
{ if (PROTECTED(ARG(i,t)))
return 1;
/* stop immediately, the protected propositions are too
hard to refute, so don't try. */
}
for(i=0;i<n;i++)
{ err = refute_literally(ARG(i,t));
if(err)
return 1; /* failed to refute one arg */
}
return 0; /* refuted all disjuncts */
}
if(f == LE) /* swap args */
return infer_literally(lessthan(ARG(1,t),ARG(0,t)));
if(f == '<')
return infer_literally(le(ARG(1,t),ARG(0,t)));
if(f == NE || f == '=')
{ SETFUNCTOR(t,(unsigned short)(f==NE ? '=' : NE),2);
return infer_literally(t);
}
if(f == ':')
{ term u = ARG(0,t);
int typecode;
temp = ARG(1,t);
assert(ISINTEGER(temp));
typecode = (int) INTDATA(temp);
if(typecode != NATNUM && FUNCTOR(u) == '-')
{ ARGREP(t,0,ARG(0,u));
return infer(t);
}
if(OBJECT(u))
{ if(typecode == INTEGER)
switch(TYPE(u))
{ case BIGNUM : /* fall-through */
case INTEGER: return 1; /* failure to refute */
case RATIONAL: if(REDUCED(u))
return 0; /* not an integer */
default: return 1; /* failure to refute */
}
}
if(ISATOM(u) && typecode == RATIONAL)
{ if(equals(u,eulere) || equals(u,pi_term))
return 0; /* e and pi are irrational */
else
return 1;
}
}
/* finally, unwind any variable definitions */
if(get_nextdefn())
{ err = unwind(t,&temp);
if(err)
return 1;
return refute(temp);
}
return 1;
}
/*___________________________________________________________*/
int embedded_type(int a, int b)
/* if type a is a (proper) subtype of type b, return 1, else return 0 */
/* assumes a and b are NATNUM, INTEGER, R, or DCOMPLEX, the four types
dealt with in MATHPERT. See terms.h for a full discussion of types. */
{ if (a == NATNUM)
return 1; /* smallest type in MATHPERT */
if (b == NATNUM)
return 0;
if (b == INTEGER)
return 0; /* since a isn't NATNUM now */
if (a == INTEGER)
return 1; /* now b can't be NATNUM or INTEGER */
if (b == R)
return 0; /* a can't be NATNUM or INTEGER any more */
if (a == R)
return 1; /* b can only be DCOMPLEX now */
if (a == DCOMPLEX)
return 0;
if (b == DCOMPLEX)
return 1;
return 0;
}
/*__________________________________________________________________*/
static term neg_ineq(term t)
/* assuming t is an inequality, return another inequality equivalent
to the negation of t, e.g. if t is 0 < x, return x\le 0 */
{ unsigned short f = FUNCTOR(t);
unsigned short g;
int i = 0; /* used to get args switched on <, LE, GE, > , but not on = and NE */
term ans;
switch(f)
{ case '<' : g = LE; break;
case LE : g = '<'; break;
case GE : g = '>'; break;
case '>' : g = GE ; break;
case NE : g = '='; i=1; break;
case '=' : g = NE; i=1; break;
default: assert(0);
}
ans = make_term(g,2);
ARGREP(ans,i,ARG(1,t));
ARGREP(ans,(i ? 0: 1),ARG(0,t));
return ans;
}
/*___________________________________________________________________*/
int interval_as_and(term u)
/* return 1 if u is an interval, that is, an AND of two inequalities
with the same middle term, as a < x && x < b. Return 0 if not. */
{ unsigned short f,g;
if(FUNCTOR(u) != AND)
return 0;
if(ARITY(u) != 2)
return 0;
f = FUNCTOR(ARG(0,u));
if(f != '<' && f != LE)
return 0;
g = FUNCTOR(ARG(1,u));
if(g != '<' && g != LE)
return 0;
return equals(ARG(1,ARG(0,u)),ARG(0,ARG(1,u)));
}
/*_______________________________________________________________*/
void record_theorem(term t)
/* enter t into the theorems array */
{ if(proverDLL->nexttheorem == proverDLL->maxtheorems)
{ proverDLL->maxtheorems += (short) 10;
term *newspace = realloc(proverDLL->theorems, proverDLL->maxtheorems * sizeof(term *));
if(newspace != NULL)
proverDLL->theorems = newspace;
else
{ printf("Error in record_theorem in prover.c, out of space.\n");
return; // no need to die over this problem!
}
}
permcopy(t,proverDLL->theorems + proverDLL->nexttheorem);
/* hence there are no pointers
to earlier theorems which would get screwed up by the
realloc above, and no parts of terms to get ruined by undo.
*/
++proverDLL->nexttheorem;
}
/*______________________________________________________________*/
void clear_already(term *t)
/* remove ALREADY markers recursively from *t and its subterms;
remove PRIME markers from inequalities.
*/
{ unsigned short n,f;
int i;
if(ATOMIC(*t))
return;
UNSET_ALREADY(*t);
n = ARITY(*t);
f = FUNCTOR(*t);
for(i=0;i<n;i++)
clear_already(ARGPTR(*t)+i);
if(INEQUALITY(f))
UNSETPRIME(*t);
}
/*______________________________________________________________*/
static void clear_logical_already(term *t)
/* remove ALREADY markers recursively from *t and its logical subterms;
remove PRIME markers from inequalities. lpt checks ALREADY and
reduce_ineq checks PRIME, so you have to remove both markers
before simplifying old assumptions. Unlike clear_already,
this function leaves ALREADY markers on mathematical terms so
they don't have to be run through polyval again.
*/
{ unsigned short n;
int i;
if(ATOMIC(*t))
return;
if(PROPOSITIONAL(FUNCTOR(*t)))
{ UNSET_ALREADY(*t);
n = ARITY(*t);
for(i=0;i<n;i++)
{ clear_logical_already(ARGPTR(*t)+i);
}
}
if(INEQUALITY(FUNCTOR(*t)))
UNSETPRIME(*t);
}
/*_________________________________________________________________*/
static int variant(term t, term s)
/* return 1 if t and s differ by renaming EXISTENTIAL variables,
more explicitly, each of t and s contains exactly ONE existential
variable, and no assumption contains both of the existential variables
in question, and the current line does not contain either variable.
Here's the soundness proof for dropping variants in the list of
assumptions. Let phi be the current line, Gamma the current assumptions
other than variants t and s, u and v the two variables and suppose
Gamma does not contain u. Then
exists(u,v)[ t(u), s(v), Gamma => phi ]
is equivalent to [all(u,t), all(v,s), all(v,Gamma) => phi]
since Gamma does not contain u; this is equivalent to
[all(v,s), all(v,Gamma) => phi]
which in turn is equivalent to
exists(v)[ s(v), Gamma => phi]
*/
{ int i,j,nvariables,ans;
term temp,u,v,phi;
term *varlist;
varinf *varinfo;
assumption **assumptions;
int activeline,nextassumption;
void *savenode;
if(FUNCTOR(t) != FUNCTOR(s))
return 0;
if(ARITY(t) != ARITY(s))
return 0; /* fail quickly most of the time */
nvariables = get_nvariables();
varinfo = get_varinfo();
varlist = get_varlist();
for(i=0;i<nvariables;i++)
{ if(varinfo[i].scope == EXISTENTIAL && contains(t,FUNCTOR(varlist[i])))
break;
}
if(i==nvariables)
return 0;
for(j=0;j<nvariables;j++)
{ if(varinfo[j].scope == EXISTENTIAL && contains(s,FUNCTOR(varlist[j])))
break;
}
if(j==nvariables || i==j)
return 0;
u = varlist[i];
v = varlist[j];
if(!same_form(u,v))
return 0; /* without using any memory */
savenode = heapmax();
subst(u,v,s,&temp);
ans = equals(t,temp);
destroy_term(temp); /* subst uses fresh space */
if(!ans)
{ reset_heap(savenode);
return 0;
}
/* Now check that the current line should contain neither u nor v */
activeline = get_activeline();
if(activeline >= 0)
{ phi = history(activeline);
if(contains(phi,FUNCTOR(u)) || contains(phi,FUNCTOR(v)))
{ reset_heap(savenode);
return 0;
}
}
/* Now check that no assumption contains both u and v */
nextassumption = get_nextassumption();
assumptions = get_assumptions();
for(i=0;i<nextassumption;i++)
{ temp = assumptions[i]->prop;
if(contains(temp,FUNCTOR(u)) && contains(temp,FUNCTOR(v)))
{ reset_heap(savenode);
return 0;
}
}
reset_heap(savenode);
return 1;
}
/*______________________________________________________________*/
void drop_variants(term t, term *ans)
/* t is an AND term; eliminate conjuncts which differ by renaming
existential variables and return the result in *ans. It only is
guaranteed when the conjuncts contain at most one existential variable
each. It's written so that drop_variants(t,&t) is acceptable. */
{ int i,j;
unsigned short k;
term u,temp,answer;
unsigned short n = ARITY(t);
if(FUNCTOR(t) != AND)
{ *ans = t;
return;
}
answer = make_term(AND,n);
k=0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
for(j=0;j<i;j++)
{ if(variant(u,ARG(j,t)))
break;
}
if(j==i) /* not a variant */
{ ARGREP(answer,k,u);
++k;
}
}
assert(k>0);
if(k==1)
{ temp = ARG(0,answer);
RELEASE(answer);
*ans = temp;
return;
}
SETFUNCTOR(answer,AND,k);
*ans = answer;
}
/*_____________________________________________________________________*/
static void erasecolors(term *t)
/* erase the color info in all subterms of *t */
/* This is a static copy, for speed, of a global function in exec.c */
{ unsigned short n;
int i;
if(COLOR(*t))
SETCOLOR(*t,0);
if(!ATOMIC(*t))
{ n = ARITY(*t);
for(i=0;i<n;i++)
erasecolors(ARGPTR(*t) + i);
}
}
/*______________________________________________________________________*/
void assume(term p)
/* enter proposition p in 'assumptions' array.
If p has functor > or GE, however, enter the
equivalent < or LE term so assumptions are
always kept as < or LE.
*/
{ assumption *newnode;
assumption **assumptions = proverDLL->assumptions;
if(proverDLL->nextassumption < 0) /* this means assumptions have been purposely
turned off--see 'saveit' in file singular.c
and minmax.c. */
return; /* so do nothing */
if(equals(p,trueterm))
return; /* doing nothing. Don't clutter up the assumption list. */
if(equals(p,falseterm))
assert(0);
if(proverDLL->nextassumption == proverDLL->maxassumptions)
{ proverDLL->maxassumptions += (short) 50;
assumption **newspace = realloc(proverDLL->assumptions, proverDLL->maxassumptions * sizeof(assumption *));
if(newspace != NULL)
{ proverDLL->assumptions = newspace;
}
else
{ printf("Too many assumptions, out of space.\n");
assert(0); // will cause this client to die
}
}
assumptions[proverDLL->nextassumption] = (assumption *) permalloc(sizeof(assumption));
newnode = proverDLL->assumptions[proverDLL->nextassumption];
if(newnode==NULL)
nospace();
if(FUNCTOR(p) == '>')
p = lessthan(ARG(1,p),ARG(0,p));
else if(FUNCTOR(p) == GE)
p = le(ARG(1,p),ARG(0,p));
erasecolors(&p);
if(FUNCTOR(p)==DEFINED && (FUNCTOR(ARG(0,p))==LIMIT || FUNCTOR(ARG(0,p))== INTEGRAL))
SETPROVISIONAL(p); /* don't use it, and make sure it's eventually eliminated */
permcopy(p,&newnode->prop);
newnode->line = get_currentline() + 1;
newnode->link = NULL;
++proverDLL->nextassumption;
}
/*__________________________________________________________________*/
static assumption **stashhere[32];
static int nstashed[32];
static int stacktop = 0;
// used by stash_assumptions and unstash_assumptions
void stash_assumptions(void)
/* Move the assumptions from proverDLL->assumptions to stashhere. */
{ if(stashhere[stacktop])
++stacktop;
if(stacktop >= 32)
assert(0);
assert(stashhere[stacktop] == NULL);
stashhere[stacktop] = proverDLL->assumptions;
nstashed[stacktop] = proverDLL->nextassumption;
proverDLL->nextassumption = 0;
proverDLL->assumptions = calloc(proverDLL->maxassumptions, sizeof(assumption *));
if(proverDLL->assumptions == NULL)
assert(0);
}
/*__________________________________________________________________*/
void unstash_assumptions(void)
// put the stashed assumptions back, releasing the space they occupied.
{ if(stashhere[stacktop] == NULL)
assert(0); // that would mean unstash_assumptions has been been called incorrectly
assumption **temp = proverDLL->assumptions; // the new assumptions
int k = proverDLL->nextassumption; // the number of new assumptions
// first restore the stashed assumptions
proverDLL->assumptions = stashhere[stacktop];
proverDLL->nextassumption = nstashed[stacktop]; // now the old ones are restored
// Now save the new assumptions, if any
int i;
int n = proverDLL->nextassumption;
for(i=0;i<k && n+i < proverDLL->maxassumptions;i++)
proverDLL->assumptions[n+i] = temp[i];
// In the event there are more than maxassumptions of them, we just don't copy them all,
// rather than crash or fail.
proverDLL->nextassumption += k;
free(temp);
nstashed[stacktop] = 0;
stashhere[stacktop] = NULL;
if(stacktop > 0)
--stacktop;
}
/*__________________________________________________________________*/
term reduce_or(term t)
/* t is an OR, flattened, and all args have been through lpt already. */
/* Perform further reductions; the answer produced will be processed
further by lpt */
/* does not have to return in fresh space */
{ unsigned short n = ARITY(t);
int i,j,err;
term u,ans;
assumption **assumptions = proverDLL->assumptions;
err = remove_dups(t,&u); /* remove duplicate args if any */
if(!err)
{ t = u;
if(FUNCTOR(u) != OR)
return u;
n = ARITY(t); /* it's gotten smaller now that dups have been eliminated */
}
err = orrule2(t,&u);
/* (a & b) or a => a , also c or (a & b) or a => c or a */
if(!err)
return reduce_or(u);
/* next see if any pairs of inequalities among the args will disjoin, or if we have both even(x) and odd(x) */
for(i=0;i<n;i++)
{ for(j=i+1;j<n;j++)
{ unsigned short f = FUNCTOR(ARG(i,t));
unsigned short g = FUNCTOR(ARG(j,t));
if(f == ODD1 || g == ODD1)
err = odd_or_even(ARG(i,t),ARG(j,t),&u);
else if((f == NE || f == LE || f == '<') && (g == NE || g == LE || g == '<'))
err = disjoin(ARG(i,t),ARG(j,t),&u);
else if (
((f == LE || f == '<') && interval_as_and(ARG(j,t))) ||
((g == LE || g == '<') && interval_as_and(ARG(i,t)))
)
{ u = join(ARG(i,t),ARG(j,t));
err = equals(u,falseterm) ? 1 : 0;
}
else if( implies2(ARG(i,t),ARG(j,t)))
{ u = ARG(j,t);
err = 0;
}
else if( implies2(ARG(j,t),ARG(i,t)))
{ u = ARG(i,t);
err = 0;
}
else
err = 1;
if(!err)
{ term ans;
int p,q;
if(n==2)
return u;
if(equals(u,trueterm))
return trueterm;
ans = make_term(OR,(unsigned short)(n-1));
for(q=0;q<i && q<j;q++)
ARGREP(ans,q,ARG(q,t));
ARGREP(ans,q,u);
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));
return ans;
}
}
}
for(i=0;i<proverDLL->nextassumption;i++)
{ err = orrule1(assumptions[i]->prop,t,&u);
/* (b | (a & c)) = ( b | c ) (dropping the inner a ),
where a is already in the list of assumptions */
if(!err)
return u;
}
/* Next see if any disjunct is an equation which implies another
disjunct; such things arise from the differentiability condition
on abs(u); example: differentiating abs(x^2+x) we get
or(and(x!=0, x!=1), 2x+1 = 0) */
for(i=0;i<n;i++)
{ for(j=0;j<n;j++)
{ u = ARG(i,t);
if(FUNCTOR(u) != '=' || i==j)
continue;
if(implies_instantly(ARG(i,t),ARG(j,t)))
/* we can drop u */
break;
}
if(j<n)
break;
}
if(i<n) /* drop the i'th arg */
{ if(n==2)
return ARG(i ? 0 : 1,t);
ans = make_term(OR,(unsigned short)(n-1));
for(j=0;j<n-1;j++)
ARGREP(ans,j,ARG((j<i?j:j+1),t));
return ans;
}
return t;
}
/*______________________________________________________________________*/
void discharge(int k)
/* remove all assumptions with indices k or above */
/* so afterwards nextassumption is k */
{ assert(k>=0);
while (proverDLL->nextassumption > k)
{ --proverDLL->nextassumption;
/* assumptions are in permspace, so don't try to
destroy the assumptions */
}
}
/*______________________________________________________________________*/
int undo_assumptions(void)
/* remove and free the nodes of all assumptions made at line currentline,
or more precisely, just BEFORE line currentline was printed; at that
time currentline was one smaller */
/* return 1 if anything is undone, zero if not */
/* called after currentline has been incremented before another op is chosen,
so the most recent assumptions were made at line currentline, hence the
validity of the assertion in the code */
{ int i;
int flag = 0;
assumption *temp;
assumption **assumptions;
int currentline;
if(proverDLL->nextassumption==0)
return 0; /* nothing to do */
assumptions = proverDLL->assumptions;
currentline = get_currentline();
for(i=proverDLL->nextassumption-1;i>=0;i--)
{ if(assumptions[i]->line == currentline && assumptions[i]->link==NULL)
{ /* an assumption made at the last step for the first time */
if(i!=proverDLL->nextassumption-1)
assert(0);
--proverDLL->nextassumption;
flag =1;
}
else if(assumptions[i]->line == currentline)
{ /* but the link field is non-NULL, so this was an assumption
that was made earlier, but simplified at the last step;
or it could have been made at this same step and then
simplified by making use of other assumptions. */
for(temp = assumptions[i]; temp->link != NULL; temp = temp->link)
{ if(temp->line != currentline)
break;
}
/* temp either points to the first node not created at this
line or the last node of the list (or both) */
if(temp->line == currentline)
{ /* all nodes in this list were created at this line */
assert(i==proverDLL->nextassumption-1);
--proverDLL->nextassumption;
}
else
assumptions[i] = temp;
flag =1;
}
}
return flag;
}
/*_____________________________________________________________________*/
void push_assumption(term p, int i)
/* push p onto the linked list assumptions[i] */
/* assumes that currentline hasn't been incremented yet, so
the new assumption gets line number currentline+1 */
{ assumption *newnode;
newnode = (assumption *) permalloc(sizeof(assumption));
if(ISATOM(p))
newnode->prop = p;
else
permcopy(p, &newnode->prop);
erasecolors(&newnode->prop); /* else they come out with yellow/black
parts in the assumption window */
newnode->line = get_currentline() + 1; /* when this is called, currentline
still corresponds to the old (previous) line;
the new assumption should be associated with
the NEXT line */
newnode->link = proverDLL->assumptions[i];
proverDLL->assumptions[i] = newnode;
}
/*_____________________________________________________________________*/
void pop_assumption(int i)
/* pop the top item off the linked list assumptions[i] */
{ assumption *p = proverDLL->assumptions[i];
proverDLL->assumptions[i] = p->link; /* even if NULL */
permfree(p);
}
/*_________________________________________________________________*/
void deletep(term t)
/* remove assumptions of the form p:Z where p does not occur in any
other assumption or in t or in history[currentline]. If currentline < 0,
it doesn't check the current line; this happens in checkproblem.
When this is called, t is proverDLL->history[currentline].
*/
{ int i,j;
term u,p;
int currentline;
assumption **assumptions = proverDLL->assumptions;
for(i=proverDLL->nextassumption-1;i>=0;i--)
/* go backwards so last-introduced variables are found first,
so delete_var will get rid of them */
{ u = assumptions[i]->prop;
if(FUNCTOR(u) != ':' || !ISATOM(ARG(0,u)))
continue;
p = ARG(0,u);
for(j=0;j<proverDLL->nextassumption;j++)
{ if(j==i)
continue;
if(contains(assumptions[j]->prop,FUNCTOR(p)))
break;
}
if(j<proverDLL->nextassumption) /* p was contained in another assumption */
continue; /* so forget about p */
currentline = get_currentline();
if(currentline>= 0 && contains(proverDLL->history[currentline],FUNCTOR(p)))
continue; /* p isn't a 'dead' variable after all */
if(contains(t,FUNCTOR(p)))
continue; /* p isn't a 'dead' variable after all */
if(i==proverDLL->nextassumption-1)
--proverDLL->nextassumption;
else
push_assumption(trueterm,i);
delete_var(p);
}
}
/*_________________________________________________________________*/
static void delete_var(term p)
/* get rid of variable p from the varlist if it happens to be the
last one, and no other variable depends on it. */
{ int i;
int nvariables = get_nvariables();
term *varlist = get_varlist();
varinf *varinfo = get_varinfo();
assert(nvariables > 0);
if(!equals(p,varlist[nvariables-1]))
return; /* forget it */
for(i=0;i<nvariables-1;i++)
{ if(varinfo[i].dp & (1<<(nvariables-1)))
return; /* forget it */
}
--nvariables; /* delete it */
set_nvariables(nvariables);
}
/*______________________________________________________________*/
int simplify_assumptions(term t)
/* go through the list of current assumptions. One by one, 'reduce'
each assumption by temporarily replacing it with 'true', then calling
lpt on it. If it changes, push the new assumption on the list above
the old version.
Before calling this, you should be sure that some assumption was
made or changed at the current line, otherwise you'll be wasting time.
When this is called, currentline hasn't been incremented yet, so
assumptions just made will have their line field == currentline+1
Also, this function checks whether any of the assumptions made at the
last line (i.e. with line field=currentline+1) are OR's; if so,
and if there are two or more OR's in the assumption list,
it uses the distributive law on these ORS, eliminating the old OR's
and putting the result in place of the last assumption. Example:
in calculating the domain of sqrt(x/a) + sqrt(a/x) we otherwise get two
disjunctions, each containing two conjunctions. Only by distributing
them do we get the right answer, (0<x & 0<a) | (x<0 & a<0).
Also, if one of the assumptions is a<=b and another is a != b
then these two should be replaced by a<b and true, respectively.
At the end, delete any assumptions of the form "p:Z" where
p doesn't occur in any OTHER assumptions or in history[currentline]
or in the term 't' passed as argument. (In practice this term will
contain any just-introduced variables; when this is called a new
line has been (partially) generated but currentline hasn't yet
been incremented, so history[currentline] is the line being worked on.)
*/
{ int i,j,err;
unsigned short n;
assumption *newterm;
assumption **assumptions = proverDLL->assumptions;
int currentline = get_currentline();
int savenvariables, saveeigen,savenextdefn;
short savenextassumption;
void *savenode=NULL;
int mflag=0; /* set if we need to use heapmax, reset_heap */
int flag = 0; /* set when some assumption simplifies */
term saveit,target,simplified,u,v,temp,result;
int nextassumption = proverDLL->nextassumption;
if(nextassumption <= 1)
return 1; /* nothing to do */
if(nextassumption > 3)
mflag = 1;
for(i=0;i<nextassumption;i++)
{ saveit = assumptions[i]->prop;
if(PROTECTED(saveit))
continue; /* used in trig substitutions */
copy(saveit,&target);
clear_logical_already(&target); /* so lpt won't ignore it */
assumptions[i]->prop = trueterm;
if(mflag)
savenode = heapmax();
savenvariables = get_nvariables();
saveeigen = get_eigenindex();
savenextassumption = get_nextassumption();
savenextdefn = get_nextdefn();
simplified = lpt(target);
if(equals(simplified,target))
{ assumptions[i]->prop = saveit;
if(mflag)
reset_heap(savenode);
/* restore apparatus that lpt may have altered */
set_nvariables(savenvariables);
set_nextdefn(savenextdefn);
set_eigenvariable(saveeigen);
set_nextassumption(savenextassumption);
continue;
}
++flag;
#if 0
if(assumptions[i]->line == currentline + 1)
{ permcopy(simplified,&assumptions[i]->prop);
erasecolors(&assumptions[i]->prop);
}
else
#endif
if(FUNCTOR(simplified) == AND && !interval_as_and(simplified))
/* AND terms must be separated and given separate entries */
{ assumptions[i]->prop = trueterm; /* wipe out the old assumption */
n = ARITY(simplified);
for(j=0;j<n;j++)
assume(ARG(j,simplified));
}
else
{ assumptions[i]->prop = saveit;
/* Now push 'simplified' on the linked list assumptions[i] */
/* (if it's 'true' that has the effect of wiping out the
assumption) */
push_assumption(simplified,i);
}
if(mflag)
reset_heap(savenode);
/* the new assumptions are now in permspace so not affected */
}
/* Now, look for a pair of the form a<b and a != b */
for(i=0;i<nextassumption;i++)
{ for(j=0;j<nextassumption;j++)
{ if(j==i)
continue;
u = assumptions[i]->prop;
v = assumptions[j]->prop;
if(FUNCTOR(u) == LE && FUNCTOR(v) == NE &&
(
(equals(ARG(0,u),ARG(0,v)) && equals(ARG(1,u),ARG(1,v)))||
(equals(ARG(1,u),ARG(0,v)) && equals(ARG(0,u),ARG(1,v)))
)
)
{ push_assumption(lessthan(ARG(0,u),ARG(1,u)),i);
push_assumption(trueterm,j);
}
}
}
/* Now, do we need to use the distributive law? */
for(i=nextassumption-1; i>=0;i--) /* look for a just-added OR */
{ if(assumptions[i]->line <= currentline)
{ deletep(t);
return !flag; /* no OR just added */
}
u = assumptions[i]->prop;
if(FUNCTOR(u) == OR)
break;
}
if(i<0) /* no OR just added */
{ deletep(t);
return !flag;
}
for(j=i-1;j>=0;j--)
{ u = assumptions[j]->prop;
if(FUNCTOR(u) == OR)
break; /* another OR found */
}
if(j<0)
{ deletep(t);
return !flag; /* no more OR's found */
}
/* Now we have at least two OR's in the assumption list */
/* We don't look for a third one; we only can distribute 2 at a time;
so if there was one OR already and two more are added at the
current line we could conceivably get more than one OR into the
assumption list. */
temp = and(assumptions[i]->prop, assumptions[j]->prop);
push_assumption(trueterm,i);
push_assumption(trueterm,j);
/* push 'true' on the list assumptions[i] */
err = pdistribute(temp,&result);
if(!err)
temp = lpt(result);
newterm = (assumption *) permalloc(sizeof(assumption));
if(newterm == NULL)
nospace();
newterm->link = assumptions[i];
permcopy(temp,&newterm->prop);
newterm->line = currentline + 1;
assumptions[i] = newterm;
deletep(t);
return 0;
}
/*_____________________________________________________________________*/
static term permspace_make_term(unsigned short f, unsigned short n)
/* like make_term, but calls 'permalloc' instead of mallocate */
{ term ans;
unsigned long lnbytes = n*sizeof(term);
unsigned nbytes = (unsigned) lnbytes;
if(nbytes != lnbytes)
{ /* in 16-bit Mathpert you can't have more than about six thousand
arguments for a term because you can't have a memory block
larger than 64K */
nospace();
SETFUNCTOR(ans,ILLEGAL,0);
ans.args = NULL;
return ans;
}
SETFUNCTOR(ans,f,n);
ans.info = 0;
if(n==0)
return ans; /* don't allocate space for any args */
ans.args = permalloc(nbytes);
if(ans.args==NULL)
assert(0); /* permalloc will get more space if possible and if not will call nospace() */
SETARGS(ans);
SETTYPE(ans,NOTYPE);
return ans;
}
/*________________________________________________________________*/
void permcopy(term t, term *ans)
/* This is just like 'copy' except that it uses permalloc instead
of mallocate, and it DOES copy bignum data too. Since the
args cannot be freed by free2 (which undoes mallocate), the
HASARGS bit of the info field of the copied terms must be
set to zero.
*/
/* return 0 for success, 1 if can't get enough space */
{ int i;
if(OBJECT(t))
{ switch(TYPE(t))
{ case INTEGER:
SETFUNCTOR(*ans,0,1);
ans->args = permalloc(sizeof(long));
*((long *) ans->args) = INTDATA(t);
break;
case DOUBLE:
SETFUNCTOR(*ans,0,1);
ans->args = permalloc(sizeof(double));
*((double *) ans->args) = DOUBLEDATA(t);
break;
case BIGNUM:
SETFUNCTOR(*ans,0,1);
ans->args = permalloc(sizeof(bignum));
*((bignum *) ans->args) = BIGNUMDATA(t);
/* but the bignum digits are still on the heap! */
{ unsigned ndigits = BIGNUMDATA(t).ln;
((bignum *) ans->args)->ln = ndigits;
((bignum *) ans->args)->val = permalloc(ndigits * sizeof(digit));
memcpy(((bignum *) ans->args)->val, BIGNUMDATA(t).val, ndigits *sizeof(digit));
}
break;
}
ans->info = t.info;
KILLARGS(*ans);
return;
}
if(ISATOM(t))
{ *ans = MAKE_ATOM(FUNCTOR(t)); /* does not allocate space */
ans->args = t.args;
ans->info = t.info;
if(HASARGS(*ans)) /* don't cause an access violation on eulere or pi */
KILLARGS(*ans);
return;
}
*ans = permspace_make_term(FUNCTOR(t),ARITY(t));
for(i=0;i<ARITY(t);i++)
permcopy(ARG(i,t),ARGPTR(*ans) + i);
ans->info = t.info;
if(HASARGS(*ans)) /* don't cause an access violation on constant ints */
KILLARGS(*ans);
return;
}
/*_______________________________________________________________________*/
void setprimes(term t, term *next)
/* *next is passed as a term obtained by substituting something into t.
Go through t and *next, to the depths where they differ, and mark
ABSFUNCTOR terms in *next PRIME if the corresponding subterms of t are PRIME.
*/
{ unsigned short n,f;
int i;
if(ATOMIC(t))
return;
f = FUNCTOR(t);
if(f == ABSFUNCTOR && PRIME(t))
{ SETPRIME(*next);
return;
}
n = ARITY(t);
if(ARITY(*next) != n || FUNCTOR(*next) != f)
return;
for(i=0;i<n;i++)
setprimes(ARG(i,t),ARGPTR(*next)+i);
}
/*_______________________________________________________________________*/
int unwind(term t, term *next)
/* reason-free version of unwinddefinitions */
/* expand the most recently made let-defn such that the left side of
one of its equations appears in t; return 0 for
success (so *next is instantiated) and 1 for failure (*next is garbage) */
{ int i,j;
defn u;
unsigned short f;
term safecopy;
int err;
term temp,temp2;
int nextdefn = get_nextdefn();
if(nextdefn == 0)
return 1;
j=0;
for(i=nextdefn-1;i>=0;--i)
{ u = get_defn(i);
if(u.permanent) /* don't expand 'permanent' definitions */
/* This won't make trouble in calculating domains,
e.g. if y = 1/x, the assumption x!=0 was
generated when or before y was defined */
continue;
if(ISATOM(u.left))
{ f = FUNCTOR(u.left);
err = contains_bound(t,f);
if(FUNCTOR(t) == '=' &&
FUNCTOR(ARG(0,t)) == INTEGRAL &&
equals(ARG(1,ARG(0,t)),u.left) &&
!contains(ARG(1,t),INTEGRAL)
)
/* example: integral(cos(ln x),x), substitute u = ln x,
get integral(e^u cos u), do it twice by parts and solve,
you get integral(e^u cos u) = ... and you want to
get rid of u, getting the answer in terms of x again.
If you don't intercept this case, the following code
won't permit you to unwind u without evaluating the
integral. We just drop the left-hand side of the
equation.
*/
return unwind(ARG(1,t),next);
if( err)
continue;
}
else
f = FUNCTOR(ARG(j,u.left));
if(contains(t,f))
break; /* out of the for-loop */
if(FUNCTOR(u.left)==AND && j < ARITY(u.left) - 1)
++j;
else
j=0;
}
if(i<0)
return 1;
/* now one of the atoms defined in u occurs free in t */
set_eigenvariable(get_defn(i).oldeigen); /* reset 'eigenvariable' to its value before this definition was made */
if(FUNCTOR(u.left)==AND)
{ /* because of the restriction in the comments on 'let', it
doesn't matter if we do the substitution serially or
simultaneously */
copy(t,&temp);
copy(u.right,&safecopy); /* because undo will destroy u.right */
for(j=0;j<ARITY(u.left);j++)
{ HIGHLIGHT(ARG(j,safecopy));
subst(ARG(j,safecopy),ARG(j,u.left),temp,&temp2);
if(contains(temp2,ABSFUNCTOR))
setprimes(temp,&temp2);
temp = temp2;
}
*next = temp;
}
else
{ copy(u.right,&safecopy);
HIGHLIGHT(safecopy);
subst(safecopy,u.left,t,next);
if(contains(t,ABSFUNCTOR))
setprimes(t,next);
}
return 0;
}
/*______________________________________________________________*/
int contains_bound(term t, unsigned short f)
/* return nonzero iff t contains f (functor or atom) bound or half-bound */
/* The nonzero return value is the binding operator: INTEGRAL, SUM, etc. */
{ int i,err;
unsigned short n;
unsigned short g = FUNCTOR(t);
if(ATOMIC(t))
return 0;
n = ARITY(t);
switch(g)
{ case INTEGRAL:
case DIFF:
case SUM:
case PRODUCT:
case LAM:
case BIGOH:
if(FUNCTOR(ARG(1,t))==f)
return g;
case LIMIT:
if(f == FUNCTOR(ARG(0,ARG(0,t))))
return g;
}
for(i=0;i<n;i++)
{ err = contains_bound(ARG(i,t),f);
if(err)
return err;
}
return 0;
}
/*_______________________________________________________________*/
int negate_eq(term t, term *ans)
/* t is an equation or inequality, or AND or OR, possibly containing
existential integer variables n.
Return a proposition *ans such that not exists(n,t(n)) is
equivalent to exists(n,*ans(n)). Return 0 for success, 1 for failure.
When there are existential integer variables, only an equation t can
be handled, not an inequality; and only equations with
no more than 1 existential integer variable, and of the
the special form r = f(n) where f is monotone and r doesn't contain n;
also f even and monotone for positive n can be handled.
We could make this handle an OR or AND if no two args contained the
same existential variable, but there is no need for this in Mathpert.
Examples: if t is x = n pi then *ans is n pi < x < (n+1) pi
*/
{ term left,right,n,temp,u,v,w;
int i,err,flag;
short savenextassumption;
unsigned short f = FUNCTOR(t);
term *varlist;
int nvariables;
if(!INEQUALITY(f) && f != AND && f != OR)
return 1; /* assert(0); */
left = ARG(0,t);
right = ARG(1,t);
if(!contains_existentials(t))
{ switch(f)
{ case '=' :
*ans = ne(left,right);
return 0;
case NE:
*ans = equation(left,right);
return 0;
case '<':
*ans = le(right,left);
return 0;
case LE:
*ans = lessthan(right,left);
return 0;
case '>':
*ans = le(left,right);
return 0;
case GE:
*ans = lessthan(left,right);
return 0;
case AND: /* fall through */
case OR:
*ans = make_term((unsigned short)(f == AND ? OR : AND),ARITY(t));
for(i=0;i<ARITY(t);i++)
{ err = negate_eq(ARG(i,t),ARGPTR(*ans)+i);
if(err)
return 1;
}
return 0;
}
return 1;
}
/* So now we can assume t does contain one or more existential variables */
/* We can only handle the case where there is just one such variable n,
and t has the form r = f(n) and f is strictly monotone in n (or is even
and monotone for positive n, as in x = n^2 pi.)
Then the answer is f(n) < r < f(n+1).
if f is increasing, or f(n+1) < r < f(n) if f is decreasing.
*/
if(f != '=')
return 1; /* inequalities cannot be handled */
/* First find the variable n and reject input with too many variables. */
varlist = get_varlist();
nvariables = get_nvariables();
flag = 0;
for(i=0;i<nvariables;i++)
{ if(TYPE(varlist[i]) != INTEGER)
continue;
if(contains(t,FUNCTOR(varlist[i])))
{ ++flag;
n = varlist[i];
}
if(flag == 2)
return 1;
}
left = ARG(0,t);
right = ARG(1,t);
if(contains(left,FUNCTOR(n)) && contains(right,FUNCTOR(n)))
return 1;
if(!contains(right,FUNCTOR(n)))
{ temp = left;
left = right;
right = temp;
/* since t is an equality it doesn't matter if we switch sides */
}
/* Now is right monotone in n ? */
subst(sum(n,one),n,right,&u);
polyval(sum(u,tnegate(right)),&temp);
if(contains(temp,FUNCTOR(n)))
return 1; /* too hard */
err = infer(lessthan(zero,temp));
if(!err)
{ /* right is increasing */
*ans = and(lessthan(right,left),lessthan(left,u));
return 0;
}
err = infer(lessthan(temp,zero));
if(!err)
{ /* right is decreasing */
*ans = and(lessthan(u,left),lessthan(left,right));
return 0;
}
/* Now what about the example x = n^2 pi? */
subst(tnegate(n),n,right,&v);
polyval(sum(right,v),&w);
if(!ZERO(w))
return 1; /* give up, right is not an even function of n */
savenextassumption = get_nextassumption();
assume(lessthan(zero,n));
err = infer(lessthan(zero,temp));
if(!err)
{ /* right is increasing */
*ans = and(lessthan(right,left),lessthan(left,u));
set_nextassumption(savenextassumption);
return 0;
}
err = infer(lessthan(temp,zero));
if(!err)
{ /* right is decreasing */
*ans = and(lessthan(u,left),lessthan(left,right));
set_nextassumption(savenextassumption);
return 0;
}
return 1;
}
/*___________________________________________________________________*/
static int implies_by_transitivity(term p, term q)
/* p is an interval_as_and, q is an inequality with functor < or LE or NE;
return 1 if p implies q by transitivity, 0 if not.
Example: 0 < x < 2a implies 0 < a.
*/
{ term a,b,r,s,cancelled,trash;
unsigned short f1 = FUNCTOR(ARG(0,p));
unsigned short f2 = FUNCTOR(ARG(1,p));
unsigned short g = FUNCTOR(q);
if(g == '<' && f1 == LE && f2 == LE)
return 0; /* no hope */
a = ARG(0,ARG(0,p));
b = ARG(1,ARG(1,p));
r = ARG(0,q);
s = ARG(1,q);
if(equals(r,a))
{ if(equals(s,b))
return 1;
if(ZERO(a)&& !cancel(b,s,&trash,&cancelled))
{ if(OBJECT(cancelled) || obviously_positive(cancelled))
return 1; /* this handles the example */
}
}
return 0;
}
/*________________________________________________________________________*/
#if 0
static int refute_numerically(term t)
/* t is an inequality or equation. Plug in some numerical
values and try to refute it QUICKLY. If you succeed return 0.
If not return 1.
*/
{ term *atomlist;
term x,p;
double a,b,z,saveval;
unsigned short f = FUNCTOR(t);
int nvars = variablesin(t,&atomlist);
int i,j,err;
unsigned short g;
int nextassumption;
if(nvars != 1)
return 1;
x = atomlist[0];
free2(atomlist);
g = FUNCTOR(x);
if(NOTDEFINED(x))
return 1;
if(g == ILLEGAL ||
g == TRUEFUNCTOR ||
g == FALSEFUNCTOR ||
g == LEFT ||
g == RIGHT ||
g == VAR ||
g == INFINITYFUNCTOR ||
g == UNDEFINED ||
g == BOUNDED_OSCILLATIONS ||
g == UNBOUNDED_OSCILLATIONS
)
return 1; /* trap atoms with no value pointers */
saveval = VALUE(x);
for(i=0;i<10;i++)
{ SETVALUE(x, (double) (i-3));
deval(ARG(0,t),&a);
if(a==BADVAL)
continue;
deval(ARG(1,t),&b);
if(b==BADVAL)
continue;
err = 1;
switch(f)
{ case '=':
if(fabs(a-b) > VERYSMALL)
err = 0;
break;
case '<':
case LE:
if(a > b + VERYSMALL)
err = 0;
break;
case '>':
case GE:
if(b > a + VERYSMALL)
err = 0;
break;
case NE:
if(a == b)
err = 0;
break;
}
if(!err)
{ /* Now check that this value of x makes the assumptions true */
nextassumption = get_nextassumption();
for(j=0;j<nextassumption;j++)
{ p = get_assumption(j);
if(!contains(p,FUNCTOR(x)))
continue;
g = FUNCTOR(p);
if(!INEQUALITY(g))
return 1;
deval(p,&z);
if(z != 1.0)
break;
}
if(j==nextassumption)
{ SETVALUE(x,saveval);
return 0;
}
}
}
SETVALUE(x,saveval);
return 1;
}
#endif
/*________________________________________________________*/
static int same_form(term t, term s)
/* return 1 if t and s have expression trees that
differ only at the variables */
{ unsigned short i,n;
if(ISATOM(t) && ISATOM(s))
return 1;
if(ATOMIC(t) || ATOMIC(s))
return 0;
if(FUNCTOR(t) != FUNCTOR(s))
return 0;
if(ARITY(t) != ARITY(s))
return 0;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(!same_form(ARG(i,t),ARG(i,s)))
return 0;
}
return 1;
}
/*_____________________________________________________________________*/
static int disjoin(term ineq1, term ineq2, term *ans)
/* find, in some cases, a single inequality (or a more convenient
logical condition) equivalent to
the disjunction of two inequalities.
Assumes ineq1 and ineq2 are not identical.
Return 0 for success, 1 for failure.
This function is symmetric: if it succeeds on ineq1, ineq2 then it should get the same
answer on ineq2,ineq1.
*/
{ term a,b,c,d,temp,temp2;
int err;
unsigned short f,g;
f = FUNCTOR(ineq1);
g = FUNCTOR(ineq2);
if(f == ODD1 || f == EVEN1)
return odd_or_even(ineq1,ineq2,ans);
if(f != '<' && f != LE && f != NE && f != '=')
return 1;
if(g != '<' && g != LE && g != NE && f != '=')
return 1;
a = ARG(0,ineq1);
b = ARG(1,ineq1);
c = ARG(0,ineq2);
d = ARG(1,ineq2);
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 = trueterm; /* trichotomy */
return 0;
}
if(f == '=' && g == LE)
{ *ans = ineq2;
return 0;
}
if(g == '=' && f == LE)
{ *ans = ineq1;
return 0;
}
if(f == '=' && g == '<')
{ *ans = le(c,d);
return 0;
}
if(g == '=' && f == '<')
{ *ans = le(a,b);
return 0;
}
}
if(f == NE || g == NE)
{ if((equals(a,c) && equals(b,d)) || (equals(b,c) && equals(a,d)))
{ if(f==LE || g == LE)
*ans = trueterm; /* trichotomy */
else
*ans = (f == NE ? ineq1 : ineq2);
return 0;
}
if(f == '<' && g == NE && equals(a,c))
/* a < b || a != d <==> true if d < b */
{ temp =lessthan(d,b);
err = value(temp,&temp2);
if((err == 0 && equals(temp2,trueterm)) || immediate(temp))
{ RELEASE(temp);
*ans = trueterm;
return 0;
}
else
RELEASE(temp);
}
return 1;
}
if(f == '=' || g == '=')
return 1;
/* Now f and g are < or LE */
if(equals(a,c))
{ if(equals(b,d))
{ *ans = (f=='<' ? ineq2 : ineq1);
return 0;
}
temp = le(b,d);
if(immediate(temp)==1)
{ *ans = ineq2;
RELEASE(temp);
return 0;
}
temp = le(d,b);
if(immediate(temp)==1)
{ *ans = ineq1;
RELEASE(temp);
return 0;
}
}
if(equals(a,d) && equals(b,c))
{ if(f == '<' && g == '<')
*ans = ((!ZERO(a)) ? ne(a,b) : ne(b,a));
else
*ans = trueterm; /* forms of trichotomy */
return 0;
}
if(equals(b,d))
{ temp = le(a,c);
if(immediate(temp)==1)
{ *ans = ineq1;
RELEASE(temp);
return 0;
}
temp = le(c,a);
if(immediate(temp)==1)
{ *ans = ineq2;
RELEASE(temp);
return 0;
}
}
if(equals(b,c))
/* a<b or b<d reduces to a\le d or a<b or b<d so that if a<d
is immediate, we'll get true in a hurry */
{ temp = lessthan(a,d);
err = value(temp,&temp2);
if(!err && equals(temp2,trueterm))
{ *ans = trueterm;
return 0;
}
}
return 1;
}
/*_____________________________________________________________________*/
static int odd_or_even(term a, term b, term *ans)
/* If a and b have the forms odd(n) and even(n) (in either order)
then return 0 with n:INTEGER in *ans. Else return 1.
*/
{ unsigned short f,g;
f = FUNCTOR(a);
g = FUNCTOR(b);
if(
((f == ODD1 && g == EVEN1) || (g == ODD1 && f == EVEN1)) &&
equals(ARG(0,a),ARG(0,b))
)
{ *ans = type(ARG(0,a),INTEGER);
return 0;
}
return 1;
}
/*_________________________________________________________________________*/
static int zeromodpi(term a)
/* return 1 if a is a rational multiple of pi. Return value 0 does not mean
that a is NOT such a multiple, just that it's not obvious by mere cancellations. */
{ int i,piflag;
unsigned short n;
if(equals(a,pi_term))
return 1;
if(ATOMIC(a))
return 0;
if(FRACTION(a) && isinteger(ARG(1,a)))
return zeromodpi(ARG(0,a));
if(NEGATIVE(a))
return zeromodpi(ARG(0,a));
n = ARITY(a);
if(FUNCTOR(a) == '+')
{ for(i=0;i<n;i++)
{ if(!zeromodpi(ARG(i,a)))
return 0;
}
return 1;
}
if(FUNCTOR(a) == '*')
{ piflag = 0;
for(i=0;i<n;i++)
{ if(equals(ARG(i,a),pi_term))
{ if(piflag)
return 0;
piflag = 1;
continue;
}
if(isinteger(ARG(i,a)))
continue;
return 0;
}
return piflag;
}
return 0;
}
/*_________________________________________________________________________*/
static int implies2(term u, term v)
/* return 1 if u can be quickly seen to imply v;
return 0 otherwise. (This does not mean that u does not in fact imply v.)
Example: 2m pi < x < (2m+1) pi implies x != 0.
This example is used in analyzing the domain of fundamental theorem problem 38.
*/
{ term a,b,x;
if(interval_as_and(u) && FUNCTOR(ARG(0,u)) == '<' && FUNCTOR(ARG(1,u)) == '<')
{ a = ARG(0,ARG(0,u));
b = ARG(1,ARG(1,u));
x = ARG(1,ARG(0,u));
if(FUNCTOR(v) == NE && ZERO(ARG(1,v)) && equals(x,ARG(0,v)) && zeromodpi(a) && zeromodpi(b))
return 1;
}
return 0; /* The example case is the only one handled so far. */
}
/*___________________________________________________________________________*/
static int trig_instantiate(term a, term b)
/* Example: if a is npi -pi/2 < x < npi + pi/2, and b is -pi/2 < x < pi/2,
then return 1. Generally return 1 if instantiating a variable introduced by trig domains to zero
can make a and b identical. We treat variables of type INTEGER that are not bound as
variables that can be instantiated here. */
{ term *Avars, *Bvars;
int nA, nB;
term aval,p,q,r,s,u,v;
nA = variablesin(a,&Avars);
nB = variablesin(b,&Bvars);
if(nB ==0 && nB == 0)
return 0;
if(nB == 1 && nA == 2 && TYPE(Avars[0]) == INTEGER && equals(Avars[1],Bvars[0]))
{ term n = Avars[0];
subst(zero,n,a,&aval);
polyval(ARG(0,ARG(0,aval)),&p);
polyval(ARG(1,ARG(1,aval)),&q);
polyval(ARG(0,ARG(0,b)),&s);
polyval(ARG(1,ARG(1,b)),&r);
polyval(sum(p,tnegate(s)),&u);
if(!ZERO(u))
return 0;
polyval(sum(q,tnegate(r)),&v);
if(ZERO(v))
{ // success
if(nA > 0) freespace(Avars);
if(nB > 0) freespace(Bvars);
return 1;
}
}
// failure
if(nA > 0) freespace(Avars);
if(nB > 0) freespace(Bvars);
return 0;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists