Sindbad~EG File Manager
/* speed up domain calculations */
/* M. Beeson, for Mathpert */
/* 12.28.93 original date
10.31.99 modified
7.10.00 added call to contains_undefined in domain.
4.8.04 added && !contains(t,GCD) in fastdom
4.14.04 added & err != -1 at line 259 in fastdom.
6.24.04 modified domain where it processes the nonnegative list, for fractions.
9.7.04 added err != 3 at line 261
9.3.07 added DifIntegralDomain
9.16.11 added a missing restore_lists at line 460
5.22.13 modified fastdom for deval returning 54 on Bernoulli numbers.
5.24.13 similarly for 55 for Euler numbers
9.25.14 initialized trailer= l in insert
removed unused function checkterm
11.6.24 added code to fastdom_aux to get 1/i, 1/e, 1/pi done quickly
*/
#include <assert.h>
#include <stdlib.h> /* NULL */
#include "globals.h"
#include "prover.h"
#include "cancel.h"
#include "domain.h"
#include "trigdom.h"
#include "trigpoly.h"
#include "algaux.h"
#include "deval.h"
#include "dcomplex.h"
#include "ceval.h"
#include "pvalaux.h" /* obviously_positive */
#include "fastdom.h"
#include "deriv.h"
static int mvpoly22(term t);
static int obviously_irrational(term t);
static int obviously_rational(term t);
/*____________________________________________________*/
/* We keep linked lists of terms sorted in order, first
by depth and then by term-order. This is the data structure
for a node in such a list: */
typedef struct t { term data;
unsigned short depth;
unsigned short garbage; /* mark for deletion */
struct t *next;
} ddlist;
/* The following global pointers will point to linked lists of terms
used in the domain calculations. They will contain subterms that
must satisfy the conditions corresponding to their names. */
static ddlist *nonnegatives;
static ddlist *positives;
static ddlist *nonzeroes;
static ddlist *ss; /* avoid the zeroes of sin */
static ddlist *cc; /* avoid the zeroes of cos */
static ddlist *others;
/* The following structure type collects six ddlists; it's used to
save the global lists for restoration after recursive calls */
typedef struct { ddlist *nn,*p,*nz,*s,*c,*o; } glists;
static ddlist *insert(term, unsigned short, ddlist *);
static ddlist *delete(ddlist *, ddlist *);
static int member(ddlist *, ddlist *);
static void destroy_list(ddlist *);
static void destroy_lists(void);
static glists save_lists(void);
static void restore_lists(glists);
static unsigned short length(ddlist *);
static int termorder(term, term);
static int isintpoly(term);
static unsigned short fastdom_exp(term, term);
static unsigned short fastdom_aux(term t);
static unsigned short depth(term);
static void process_nonzeroes(void);
/*_________________________________________________________________*/
static void destroy_list(ddlist *a)
/* free all nodes of list a */
{ ddlist *old;
if(a==NULL)
return;
while(a->next)
{ old = a;
a=a->next;
free2(old);
}
free2(a); // free the last node
}
/*_________________________________________________________________*/
static ddlist *insert(term t, unsigned short d, ddlist *l)
/* put node (t,d) in order in the sorted list l
and return a pointer to the head of the list.
Don't insert it if it equals a term already in the list,
so the list will be kept without duplicates.
Don't bother inserting nonzero objects.
Bigger terms go at the beginning. */
{ ddlist *newnode, *marker, *trailer=l;
int err;
if(OBJECT(t) && !ZERO(t))
return l; /* without further ado */
if(ZERO(t) && l==nonnegatives && nonnegatives != NULL)
return l;
newnode = (ddlist *) mallocate(sizeof(ddlist));
if(newnode == NULL)
nospace();
newnode->data = t;
newnode->depth = d;
newnode->garbage = 0;
if(l==NULL)
{ newnode->next = NULL;
return newnode;
}
if(d > l->depth || termorder(t,l->data) > 0)
{ /* tack newnode on at the head of the list */
newnode->next = l;
return newnode;
}
marker = l;
while(marker)
{ if(d < marker->depth)
{ trailer = marker;
marker = marker->next;
continue;
}
if(d > marker->depth) /* insert */
goto insert;
err = termorder(t,marker->data);
if(err < 0)
{ trailer = marker;
marker = marker->next;
continue;
}
if(err == 0) /* it's a duplicate, don't enter it */
{ free2(newnode); // added 2.15.25
return l;
}
goto insert;
}
insert:
newnode->next = marker;
trailer->next = newnode;
return l;
}
/*_________________________________________________________________*/
static ddlist *delete(ddlist *x, ddlist *l)
/* delete node *x from ordered list l and
return a pointer to the resulting list */
{ ddlist *marker;
if(l == NULL)
return NULL;
/* shouldn't be called with l == NULL;
this is just defensive programming. */
if(x==l)
{ marker = l->next;
free2(l);
return marker;
}
marker = l;
while(marker->next && marker->next != x)
marker=marker->next;
if(marker->next == x)
{ marker->next = x->next;
free2(x);
}
return l;
}
/*_________________________________________________________________*/
static int termorder(term a, term b)
/* an arbitrary ordering of terms, returning -1, 0, or 1, and
returning 0 only when equals(a,b). */
{ unsigned short n;
int i,err;
if(OBJECT(a))
{ short p;
if(!OBJECT(b))
return -1;
tcompare(a,b,&p);
return p;
}
if(OBJECT(b))
return 1;
if(ISATOM(a) && ISATOM(b))
{ if(FUNCTOR(a) < FUNCTOR(b))
return -1;
if(FUNCTOR(a) == FUNCTOR(b))
return 0;
return 1;
}
if(ISATOM(a))
return -1;
if(ISATOM(b))
return 1;
/* Now neither a nor b is atomic */
if(ARITY(a) < ARITY(b))
return -1;
if(ARITY(b) < ARITY(a))
return 1;
if(FUNCTOR(a) < FUNCTOR(b))
return -1;
if(FUNCTOR(b) < FUNCTOR(a))
return 1;
/* Now they have the same functor and arity */
n = ARITY(a);
for(i=0;i<n;i++)
{ err = termorder(ARG(i,a),ARG(i,b));
if(err)
return err;
}
return 0; /* all args are equal, so a and b are equal */
}
/*_________________________________________________________________*/
static unsigned short length(ddlist *l)
/* return the length of list l */
{ ddlist *marker = l;
unsigned short ans = 0;
while(marker)
{ ++ans;
marker=marker->next;
}
return ans;
}
/*_________________________________________________________________*/
term domain(term t)
/* return the domain of t, computed as efficiently as possible */
/* go through the term t and fill in the global lists of all its
subterms which must be nonzero, nonnegative, positive, or avoid the zeroes
of sin or the zeroes of cos, labelling each one in its info field by its
depth in t. All unanalyzed terms go into the 'others' list.
Sort the array by depth and functor.
Then eliminate duplicates. (This is the main source of efficiency).
Use def_aux, def_aux2, and domexp from domain.c to analyze the
unanalyzed terms, form a big AND, and pass the result through lpt.
Because it uses global lists, and destroys them at exit, it is a
delicate matter to call 'domain' recursively; but several functions in
domain.c which are called by domain do call domain in turn, so it
must be usable recursively. Therefore we use save_lists and restore_lists
in the code below.
Strictly speaking, if there are let-defined variables, it returns a
proposition which defines the domain of t when conjoined with the
proposition asserting that the right-hand-side of the definitions is defined.
*/
{ unsigned short k;
unsigned short n;
unsigned nn;
int err,flag;
dcomplex z;
double x;
ddlist *marker, *marker2;
glists saveit;
term u,ans;
if(NOTDEFINED(t))
return falseterm;
if(OBJECT(t))
return trueterm;
if(seminumerical(t)&& !contains(t,GCD) && !contains(t,RIEMANNZETA))
/* e.g. tan pi/4, which otherwise comes back
as -1/4 < n < 3/4;
called recursively on examples like x+pi/4;
also gets undefined examples like pi/2 */
/* There is at present no code for evaluating RiemannZeta */
{ err = get_complex() ? ceval(t,&z) : deval(t,&x);
if(err != 10 && err != -1 && err != 3)
{ if(err==0 || err == 54 || err == 55) // 54 is "Bernoulli number too large to evaluate". But it's still defined.
// 55 is "Euler number too large to evaluate". But it's still defined.
return trueterm;
return falseterm;
}
/* else if (err==10), as happens when t = 10^10^10, just
analyze the term as if it weren't seminumerical */
}
if(FUNCTOR(t) == DIFF && FUNCTOR(ARG(0,t)) == INTEGRAL)
{ /* Differentiating an integral */
return DifIntegralDomain(t);
}
if(FUNCTOR(t) == INTEGRAL && ARITY(t) == 2)
return domain(ARG(0,t));
/* check for polynomials and trig functions; finish fast in these cases.*/
if(mvpoly22(t)) /* mvpoly2 or eqn or AND of same */
return trueterm; /* even if there are let_defns, because we will have
already assumed that the new variable is defined */
if(trigrational(t)) /* is u a rational function of trig functions ? */
return trigdomain(t);
// You can't enter an infinite series or an improper integral
// under any other topic, such as Simplify:
if(contains_undefined(t))
return falseterm; /* don't accept e.g. 'infinity' as defined */
saveit = save_lists(); /* in case this is a recursive call */
/* Make sure the global linked lists are empty to start with: */
positives = nonnegatives = nonzeroes = others = ss = cc = NULL;
/* After this you must do restore_lists before each return */
fastdom_aux(t); /* fill in the global linked lists */
/* check for terms entered in both the nonnegatives and the nonzero lists,
and move them to the positive list. */
for(marker=nonnegatives;marker;marker=marker->next)
{ /* look for marker->data in the nonzeroes list */
for(marker2=nonzeroes;marker2;marker2=marker2->next)
{ if(marker2->depth > marker-> depth)
continue;
if(marker2->depth < marker-> depth)
break; /* too far, not found */
err = termorder(marker2->data,marker->data);
if(err < 0)
continue;
if(err > 0)
break;
/* found! */
positives = insert(marker->data,marker->depth,positives);
nonnegatives = delete(marker,nonnegatives);
nonzeroes = delete(marker2,nonzeroes);
}
}
if(nonzeroes)
{ process_nonzeroes();
/* Check for a zero entry in the nonzeroes list. This means
the term is undefined. */
while(marker)
{ if(ZERO(marker->data))
{ restore_lists(saveit);
return falseterm;
}
}
}
if(positives && nonnegatives)
/* remove any duplicate entries from the nonnegatives list */
/* example: 1/sqrt(u) + u sqrt(u) */
{ for(marker = nonnegatives;marker; marker=marker->next)
{ if(member(marker,positives))
{ nonnegatives = delete(marker,nonnegatives);
continue;
}
}
}
nn = length(positives) + length(nonnegatives) + length(nonzeroes) +
length(ss) + length(cc) + length(others);
assert(nn < 0xffff);
n = (unsigned short) nn;
if(n==0)
{
restore_lists(saveit);
return trueterm;
}
ans = make_term(AND,n);
k=0;
marker = positives;
while(marker)
{ if(ZERO(marker->data))
{ RELEASE(ans);
restore_lists(saveit);
return falseterm;
}
ARGREP(ans,k,lessthan(zero,marker->data));
++k;
marker=marker->next;
}
marker = nonnegatives;
while(marker)
{ if(FRACTION(marker->data))
{ if(obviously_nonnegative(ARG(0,marker->data)))
ARGREP(ans,k,lessthan(zero,ARG(1,marker->data)));
else if(obviously_positive(ARG(1,marker->data)))
ARGREP(ans,k,le(zero,ARG(0,marker->data)));
else if(obviously_negative(ARG(1,marker->data)))
ARGREP(ans,k,lessthan(ARG(0,marker->data),zero));
else
ARGREP(ans,k,le(zero,marker->data));
}
else
ARGREP(ans,k,le(zero,marker->data));
++k;
marker=marker->next;
}
marker=nonzeroes;
while(marker)
{ ARGREP(ans,k,ne(marker->data,zero));
++k;
marker=marker->next;
}
marker=ss;
while(marker)
/* look for terms in both ss and cc; these TWO occurrences can
be replaced by ONE term that says it avoids multiples of pi/2 */
{ flag = 0;
u = marker->data;
for(marker2=cc; marker2; marker2=marker2->next)
{ if(marker2->depth < marker->depth)
continue;
if(marker2->depth > marker->depth)
break;
if(equals(marker2->data,u))
{ flag = 1;
cc = delete(marker2,cc);
}
}
if(flag && too_complicated(u))
ARGREP(ans,k,nonzero(sin1(product(two,u))));
else if(flag)
ARGREP(ans,k,nonzeroval(SIN, product(two,u)));
else if(too_complicated(u))
ARGREP(ans,k,nonzero(sin1(u)));
else
ARGREP(ans,k,nonzeroval(SIN,u));
++k;
marker=marker->next;
}
marker=cc;
while(marker)
{ if(too_complicated(marker->data))
ARGREP(ans,k,nonzero(cos1(marker->data)));
else
ARGREP(ans,k,nonzeroval(COS,marker->data));
++k;
marker=marker->next;
}
for(marker = others; marker; marker = marker->next)
{ if(FUNCTOR(marker->data) == '^')
{ u = domexp(ARG(0,marker->data),ARG(1,marker->data));
if(equals(u,trueterm))
continue;
ARGREP(ans,k,u);
++k;
}
else if(!ISATOM(marker->data))
/* a let-defined atom is placed in the others list, but
should not go to domain_aux. Nothing is added to
the answer in this case, see the comments at the
start of the function. */
{ ARGREP(ans,k, domain_aux(marker->data));
++k;
}
}
if(k==0)
{ /* this can happen if 'others' contained only a let-defined atom */
/* or if it contained an everywhere defined exponential term */
RELEASE(ans);
restore_lists(saveit);
return trueterm;
}
else if(k==1)
{ u = ARG(0,ans);
RELEASE(ans);
ans = u;
}
else
SETFUNCTOR(ans,AND,k);
ans = lpt(ans);
restore_lists(saveit);
return ans;
}
/*_________________________________________________________________*/
static ddlist *garbage_collect(ddlist *l)
/* delete all nodes in l with 'garbage' field nonzero.
Return a pointer to the head of the new list
*/
{ ddlist *marker = l;
ddlist *marker2, *marker3, *ans, *trailer;
while(marker && marker->garbage==1)
marker = marker->next;
if(marker == NULL)
/* all nodes marked for deletion */
{ //destroy_list(l);
return NULL;
}
if(marker != l)
{ /* delete initial nodes down to but not including *marker */
marker2 = l;
while(marker2->next && marker2 != marker)
{ marker3 = marker2;
marker2 = marker2->next;
if(marker3->garbage == 1)
free2(marker3);
}
}
ans = marker;
trailer = NULL;
marker2 = marker;
while(marker2->next)
{ if(marker2->garbage == 0)
{ trailer = marker2;
marker2 = marker2->next;
continue;
}
if(trailer)
trailer->next = marker2->next;
marker3 = marker2;
marker2 = marker2->next;
if(marker3 ->garbage == 1)
free2(marker3);
}
if(marker2->garbage)
{ if(marker2->garbage == 1)
free2(marker2); /* last node */
if(trailer)
trailer->next = NULL;
}
return ans;
}
/*__________________________________________________________________*/
static void process_nonzeroes(void)
/* Process the nonzeroes list by
--if a node occurs in the positives list, delete it from the nonzeroes list
--replacing nodes containing a product with a series of nodes, one for each factor,
--when a trig function is in the nonzero list, put its arg in the
ss list or sc list instead.
--a node of the form u^n will become u instead if n is a number.
--a node of the form x^n-a^n will become x- a if !get_complex() and n is odd,
or into two nodes x+a and x-a if a is even.
This prevents wasting time factoring and then using gsturm on
the other factor.
On the first pass we just mark nodes for later deletion while
inserting new nodes. Then on a second pass we do the deletions.
This is necessary because when handling products we delete one node
and add several others, and since the list is maintained in sorted
order the new nodes go in different places; deleting at the same
time caused a number of problems.
*/
{ ddlist *marker;
term u,v,temp;
term a,b,m,x;
double z;
int i;
unsigned short n,f,d;
int r;
for(marker = nonzeroes; marker; marker = marker->next)
{ u = marker->data;
f = FUNCTOR(u);
if(positives && (r = member(marker,positives)))
{ marker->garbage = r;
continue;
}
if(f == '^' && NUMBER(ARG(1,u)))
{ u = marker->data = ARG(0,u);
f = FUNCTOR(u);
if(positives && (r = member(marker,positives)))
{ marker->garbage = r;
continue;
}
}
if(f == '+' && ARITY(u) == 2 && NEGATIVE(ARG(1,u)) &&
FUNCTOR(ARG(0,u)) == '^' && ISINTEGER(ARG(1,ARG(0,u))) &&
!get_complex() && seminumerical(ARG(1,u)) &&
!deval(ARG(1,u),&z) && z != BADVAL && z > 0.0
)
{ /* u = x^n-a */
a = ARG(0,ARG(1,u));
if(FUNCTOR(a) == '^' && equals(ARG(1,a),ARG(1,ARG(0,u))))
b = ARG(0,a);
else if(equals(ARG(1,ARG(0,u)),two))
b = sqrt1(a);
else
b = make_root(ARG(1,ARG(0,u)),a);
m = ARG(1,ARG(0,u));
x = ARG(0,ARG(0,u));
if(ISODD(m))
{ u = marker->data = sum(x,b);
if(positives && (r = member(marker,positives)))
{ marker->garbage = r;
continue;
}
}
else /* m is even, there are two roots to consider */
{ u = marker->data = sum(x,b);
if(positives && (r = member(marker,positives)))
{ u = marker->data = sum(x,tnegate(b));
if(positives && (r =member(marker,positives)))
{ marker->garbage = r;
continue;
}
}
else /* insert a new node */
{ u = marker->data;
marker->data = sum(x,tnegate(b));
if(positives && (r = member(marker,positives)))
{ marker->data = u;
marker->garbage = r;
continue;
}
temp = marker->data;
marker->data = u;
nonzeroes = insert(temp,marker->depth,nonzeroes);
}
}
}
switch(f)
{ case SIN:
ss = insert(ARG(0,u),(unsigned short)(marker->depth-1),ss);
marker->garbage = 1;
continue;
case COS:
cc = insert(ARG(0,u),(unsigned short)(marker->depth-1),cc);
marker->garbage = 1;
continue;
case COT: /* fall-through */
case TAN: /* tan and cot are both 'nonzero'
(i.e. defined and nonzero) in the same
places, namely where neither sin nor cos is zero,
i.e. at multiples of pi/2
*/
ss = insert(ARG(0,u),(unsigned short)(marker->depth-1),ss);
cc = insert(ARG(0,u),(unsigned short)(marker->depth-1),cc);
marker->garbage = 1;
continue;
case COSH:
if(get_complex())
continue;
/* else fall through, no zeroes */
case SEC: /* fall-through, no zeroes */
case CSC:
marker->garbage = 1;
continue;
/* sec and csc are never zero */
case ABSFUNCTOR:
case SG:
marker->data = ARG(0,u); /* abs(v) = 0 iff v = 0 */
continue;
case ATAN: /* fall-through */
case TANH: /* fall-through */
case SINH: /* sinh u = 0 iff u = 0 for real u */
if(!get_complex())
marker->data = ARG(0,u);
continue;
case '*' :
marker->garbage = 1; /* mark this node for deletion */
n = ARITY(u);
for(i=0;i<n;i++)
{ v = ARG(i,u);
f = FUNCTOR(v);
if(NUMBER(v) && !ZERO(v))
continue;
if(f == '^' && NUMBER(ARG(1,v)))
{ v = ARG(0,v);
f = FUNCTOR(v);
}
switch(f)
{ case SIN:
ss = insert(ARG(0,v),depth(ARG(0,v)),ss);
break;
case COS:
cc = insert(ARG(0,v),depth(ARG(0,v)),cc);
break;
case COT: /* fall-through */
case TAN:
d = depth(ARG(0,v));
ss = insert(ARG(0,v),d,ss);
cc = insert(ARG(0,v),d,cc);
break;
case COSH:
if(get_complex())
nonzeroes = insert(v,depth(v),nonzeroes);
break;
case SEC:
break; /* no zeroes */
case CSC:
break; /* no zeroes */
case SG:
case ABSFUNCTOR: /* abs(v)=0 iff v = 0 */
nonzeroes = insert(ARG(0,v),depth(ARG(0,v)),nonzeroes);
break;
case ATAN: /* fall-through */
case TANH: /* fall-through */
case SINH: /* sinh u = 0 iff u = 0 for real u */
if(!get_complex())
v = ARG(0,v);
/* and fall through */
default:
nonzeroes = insert(v,depth(v),nonzeroes);
}
}
}
}
/* Now deleted the marked nodes */
nonzeroes = garbage_collect(nonzeroes);
}
/*_________________________________________________________________*/
static unsigned short fastdom_aux(term t)
/* append subterms of t to the global linked lists defined at the top of
this file. Mark each term in the info field with its depth as it is entered.
Don't count '-' in computing the depth. Count rational numbers in exponent
as having depth 0. Return the depth of t.
If t is a let-defined atom, put t in the 'others' array;
*/
{ unsigned short n,f,g,d1,d2,d,dmax;
term num,denom,u,v;
int i;
if(OBJECT(t))
return 0;
if(ISATOM(t))
{ int nextdefn = get_nextdefn();
if(nextdefn==0)
return 0;
for(i=0;i<nextdefn;i++)
{ if(equals(t,get_defn(i).left))
break;
}
if(i<nextdefn)
others = insert(t,0,others);
return 0;
}
if(NEGATIVE(t))
return fastdom_aux(ARG(0,t)); /* don't count minus signs in the depth */
f = FUNCTOR(t);
n = ARITY(t);
if(f == '+' || f == '*' || f == VECTOR || f == MATRIX )
{ dmax = 0;
for(i=0;i<n;i++)
{ d = fastdom_aux(ARG(i,t));
if(d > dmax)
dmax = d;
}
return (unsigned short)(1+ dmax);
}
if(f == '/')
{ num = ARG(0,t);
denom = ARG(1,t);
g = FUNCTOR(denom);
d1 = (unsigned short)(ATOMIC(num) ? 0 : fastdom_aux(num));
if(g == SQRT || /* handle 1/sqrt u etc. directly getting 0 < u */
( g == '^' &&
RATIONALP(ARG(1,denom)) &&
ISEVEN(ARG(1,ARG(1,denom)))
) ||
( g == ROOT && INTEGERP(ARG(0,denom)) && ISEVEN(ARG(0,denom)))
)
{ term base = g == ROOT ? ARG(1,denom) : ARG(0,denom);
d2=fastdom_aux(base);
if(get_complex())
nonzeroes = insert(base,d2,nonzeroes);
else
positives = insert(base,d2,positives);
return (unsigned short)(d1 > d2 ? d1+1 : d2+1);
}
if(OBJECT(denom) && !ZERO(denom))
d2 = 0;
else if(equals(denom,eulere) || equals(denom,complexi) || equals(denom, pi_term))
d2 = 0;
else
{ d2 = fastdom_aux(denom);
nonzeroes = insert(denom,d2,nonzeroes);
}
return (unsigned short)(d1 > d2 ? d1+1 : d2+1);
}
if(f == '^')
return fastdom_exp(ARG(0,t),ARG(1,t));
if(f == SQRT && get_complex())
return (unsigned short)(fastdom_aux(ARG(0,t)) + 1);
if(f == ROOT && get_complex())
return (unsigned short)(fastdom_aux(ARG(1,t)) + 1);
if(f == SQRT) /* and !complex */
{ u = ARG(0,t);
if(FUNCTOR(u) == LN || FUNCTOR(u) == LOG)
{ v = ARG(0,u);
d = fastdom_aux(v);
if(FUNCTOR(v) == '+' && ARITY(v) == 2 && ONE(ARG(0,v)))
{ nonnegatives = insert(ARG(1,v),depth(ARG(1,v)),nonnegatives);
return (unsigned short)(d+2);
}
if(FUNCTOR(v) == '+' && ARITY(v) == 2 && ONE(ARG(1,v)))
{ nonnegatives = insert(ARG(0,v),depth(ARG(0,v)),nonnegatives);
return (unsigned short)(d+2);
}
v = sum(v,minusone);
nonnegatives= insert(v,depth(v),nonnegatives);
return (unsigned short)(d+2);
}
d = fastdom_aux(u);
if(!obviously_nonnegative(u))
/* omit obviously nonnegative terms */
nonnegatives = insert(u,d,nonnegatives);
return (unsigned short)(d+1);
}
if(f == ROOT) /* and !complex */
{ u = ARG(1,t);
v = ARG(0,t);
if(INTEGERP(v) && ISODD(v))
return (unsigned short)(fastdom_aux(u) + 1);
if(INTEGERP(v) && ISEVEN(v))
{ d = fastdom_aux(u);
if(!obviously_nonnegative(u))
nonnegatives = insert(u,d,nonnegatives);
return (unsigned short)(d+1);
}
d = fastdom_aux(u);
others = insert(t,(unsigned short)(d+1),others);
return (unsigned short)(d+1);
}
if(ENTIRE(f)) /* sin, cos, atan, etc. */
return (unsigned short)(fastdom_aux(ARG(0,t)) + 1);
if(isintpoly(t))
return depth(t);
if((f == LN || f == LOG) && get_complex())
{ u = ARG(0,t);
d = fastdom_aux(u);
nonzeroes = insert(u,d,nonzeroes);
return (unsigned short)(d+1);
}
if(f == LN || f == LOG) /* && !complex */
{ u = ARG(0,t);
if(FUNCTOR(u) == LN || FUNCTOR(u) == LOG)
{ v = ARG(0,u);
d = fastdom_aux(v);
if(FUNCTOR(v) == '+' && ARITY(v) == 2 && ONE(ARG(0,v)))
{ positives = insert(ARG(1,v),depth(ARG(1,v)),positives);
return (unsigned short)(d+2);
}
if(FUNCTOR(v) == '+' && ARITY(v) == 2 && ONE(ARG(1,v)))
{ positives = insert(ARG(0,v),depth(ARG(0,v)),positives);
return (unsigned short)(d+2);
}
v = sum(v,minusone);
positives = insert(v,depth(v),positives);
return (unsigned short)(d+2);
}
d = fastdom_aux(u);
if(!obviously_positive(u))
positives = insert(u,d,positives);
return (unsigned short)(d+1);
}
if(f == LOGB && get_complex())
{ u = ARG(1,t);
d = fastdom_aux(u);
nonzeroes = insert(u,d,nonzeroes);
return (unsigned short)(d+1);
}
if(f == LOGB) /* && !complex */
{ u = ARG(1,t);
d = fastdom_aux(u);
if(!obviously_positive(u))
positives = insert(u,d,positives);
return (unsigned short)(d+1);
}
if(f == TAN || f == SEC)
{ u = ARG(0,t);
if(NEGATIVE(u))
u = ARG(0,u);
d = fastdom_aux(u);
cc = insert(u,d,cc);
return (unsigned short)(d+1);
}
if(f == COT || f == CSC)
{ u = ARG(0,t);
if(NEGATIVE(u))
u = ARG(0,u);
d = fastdom_aux(u);
ss = insert(u,d,ss);
return (unsigned short)(d+1);
}
if(f == CSCH)
{ u = ARG(0,t);
if(NEGATIVE(u))
u = ARG(0,u);
d = fastdom_aux(u);
nonzeroes = insert(u,d,nonzeroes);
return (unsigned short)(d+1);
}
if(INEQUALITY(f)) /* includes '=' as well as inequalities */
{ d1 = fastdom_aux(ARG(0,t));
d2 = fastdom_aux(ARG(1,t));
d =(unsigned short)(d1 > d2 ? d1+1 : d2+1);
return d;
}
if(f == MATRIXINVERSE)
{ d = depth(t);
nonzeroes = insert(det1(ARG(0,t)),d,nonzeroes);
return d;
}
if(f == INTEGRAL && n==2)
{ d = fastdom_aux(ARG(0,t));
return d; /* indefinite integrals of functions definable in
in Mathpert are defined wherever the integrand is,
for example integral(1/x,x) is defined when x != 0 */
}
/* everything not handled up to this point is just
stashed on the 'others' list */
d = depth(t);
others = insert(t,d,others);
return d;
}
/*______________________________________________________________________*/
static unsigned short fastdom_exp(term u, term v)
/* do the work of fastdom_aux(u^v) */
{ unsigned short d, d1, d2;
if(NEGATIVE(v))
{ v = ARG(0,v);
d = fastdom_exp(u,v);
if(OBJECT(u) || equals(u,eulere) || equals(u,pi_term))
return (unsigned short)(d+1);
if(RATIONALP(v))
{ term p,q,num,denom;
int err;
num = ARG(0,v);
denom = ARG(1,v);
if(get_complex() || ISODD(denom))
/* whether the numerator is even or odd is irrelevant */
{ d = (unsigned short)(fastdom_aux(u)+1);
nonzeroes = insert(u,d,nonzeroes);
return d;
}
if(ISEVEN(denom) && ISODD(num))
{ d = fastdom_aux(u);
positives = insert(u,d,positives);
return (unsigned short)(d+1);
}
err = cancel(num,denom,&p,&q);
/* num and denom both even */
assert(!err);
return fastdom_exp(u,tnegate(q));
}
else
{ nonzeroes = insert(u,depth(u),nonzeroes);
return (unsigned short)(d+1);
}
}
if(ZERO(v))
{ d=fastdom_aux(u);
nonzeroes = insert(u,d,nonzeroes);
return (unsigned short)(d+1);
}
if(ZERO(u))
{ d=fastdom_aux(v);
nonzeroes = insert(v,d,positives);
if(OBJECT(v) && !ZERO(v))
return (unsigned short) d; // because insert didn't actually insert it
return (unsigned short)(d+1);
}
if(INTEGERP(v))
return (unsigned short)(fastdom_aux(u)+1);
if(OBJECT(u) || equals(u,eulere) || equals(u,pi_term))
return (unsigned short)(fastdom_aux(v) + 1); /* e^v is defined when v is */
if(RATIONALP(v))
{ term p,q,num,denom;
int err;
num = ARG(0,v);
denom = ARG(1,v);
if(get_complex() || ISODD(denom))
/* whether the numerator is even or odd is irrelevant */
return (unsigned short)(fastdom_aux(u) + 1);
if(ISEVEN(denom) && ISODD(num))
{ d = fastdom_aux(u);
nonnegatives = insert(u,d,nonnegatives);
return (unsigned short)(d+1);
}
err = cancel(num,denom,&p,&q);
/* num and denom both even */
assert(!err);
return fastdom_exp(u,q);
}
/* Now the exponent isn't negative or an integer or rational number,
and the base isn't a number (or pi or e).
*/
d1 = fastdom_aux(u);
d2 = fastdom_aux(v);
d=(unsigned short)(d1>d2 ? d1+1: d2+1);
if(obviously_positive(u))
return d; /* In that case the exponent doesn't matter */
if(obviously_positive(v) && obviously_irrational(v))
{ /* example, x^sqrt(3). If v is rational than u^v is defined
regardless of whether u is positive. Consider (-1)^(e^e); since
nobody knows if e^e is irrational, nobody knows if this expression
is defined or not; or if defined, whether its value is 1 or -1. */
positives = insert(u,d,positives);
return (unsigned short)(d+1);
}
else
others = insert(make_power(u,v),d,others);
return d;
}
/*_________________________________________________________________*/
static int isintpoly(term t)
/* Return 1 if t is a polynomial function of integer variables.
Return 0 if not.
*/
{ int i;
unsigned short n,f;
if(ISATOM(t))
return TYPE(t) == INTEGER;
if(INTEGERP(t) || RATIONALP(t))
return 1;
if(OBJECT(t)) /* a double */
return 0;
f = FUNCTOR(t);
if(f=='-')
return isintpoly(ARG(0,t));
if(f == '^')
return INTEGERP(ARG(1,t)) && isintpoly(ARG(0,t));
if(f == '+' || f == '*')
{ n = ARITY(t);
for(i=0;i<n;i++)
{ if(!isintpoly(ARG(i,t)))
return 0;
}
return 1;
}
return 0;
}
/*_________________________________________________________________*/
static unsigned short depth(term t)
/* Compute the depth. Don't count '-' and count rational numbers as
depth 0. */
{ unsigned short n;
int i,d,d1;
if(ISATOM(t))
return 0;
if(NEGATIVE(t))
return depth(ARG(0,t));
if(OBJECT(t) || RATIONALP(t))
return 0;
n = ARITY(t);
if(n==1)
return (unsigned short)(1+depth(ARG(0,t)));
d = 0;
for(i=0;i<n;i++)
{ d1 = depth(ARG(i,t));
if(d1 > d)
d = d1;
}
return (unsigned short)(1+d);
}
/*_________________________________________________________________*/
static glists save_lists(void)
/* save the global lists for restoration after a recursive call */
{ glists ans;
ans.nz = nonzeroes;
ans.p = positives;
ans.nn = nonnegatives;
ans.s = ss;
ans.c = cc;
ans.o = others;
return ans;
}
/*_________________________________________________________________*/
static void restore_lists(glists x)
/* restore the global lists stored in x */
{ destroy_lists();
nonzeroes = x.nz;
nonnegatives = x.nn;
positives = x.p;
ss = x.s;
cc = x.c;
others = x.o;
}
/*_________________________________________________________________*/
static void destroy_lists(void)
/* destroy all the global lists */
{ destroy_list(nonzeroes);
destroy_list(nonnegatives);
// destroy_list(positives);
destroy_list(ss);
destroy_list(cc);
destroy_list(others);
}
/*_________________________________________________________________*/
static int member(ddlist *x, ddlist *y)
/* return 1 or 2 if x points to a member of the sorted list y,
0 if not. 1 means only the data is there; 2 means the pointer is there. */
{ ddlist *marker;
for(marker=y; marker; marker=marker->next)
{ if(marker->depth == x->depth && equals(marker->data,x->data))
return marker == x ? 2 : 1;
if(marker->depth < x->depth)
return 0; /* far enough, we're beyond where x would be in y */
}
return 0;
}
/*__________________________________________________________________*/
static int mvpoly22(term t)
/* Return 1 if t is an mvpoly2 or eqn of mvpoly2s or AND of mvpoly22's;
return 0 otherwise */
{ unsigned short f = FUNCTOR(t);
int i;
unsigned short n = ARITY(t);
if(ATOMIC(t))
return 1;
if(f==AND)
{ for(i=0;i<n;i++)
{ if(!mvpoly22(ARG(i,t)))
return 0;
}
return 1;
}
if(INEQUALITY(f))
return (mvpoly2(ARG(0,t)) && mvpoly2(ARG(1,t)));
return mvpoly2(t);
}
/*___________________________________________________________________________*/
static int obviously_rational(term t)
/* return 1 if t is easily seen to be rational, 0 otherwise.
Return value 0 indicates no conclusion about the rationality or irrationality
of t. */
{ unsigned short f,n;
int i;
if(NEGATIVE(t))
t = ARG(0,t);
if(INTEGERP(t))
return 1;
if(FRACTION(t))
return obviously_rational(ARG(0,t)) && obviously_rational(ARG(1,t));
f = FUNCTOR(t);
if(f == '+' || f == '*')
/* a sum or product is obviously_rational only if all its summands or
factors are. */
{ n = ARITY(t);
for(i=0;i<n;i++)
{ if(!obviously_rational(ARG(i,t)))
return 0;
}
return 1;
}
if(f == '^' && isinteger(ARG(1,t)))
return obviously_rational(ARG(0,t));
return 0;
}
/*___________________________________________________________________________*/
static int obviously_irrational(term t)
/* return 1 if t is easily seen to be irrational, 0 otherwise.
Return value 0 indicates no conclusion about the rationality or irrationality
of t. */
{ unsigned short f,n;
int count,i;
term p,cancelled, trash;
if(NEGATIVE(t))
t = ARG(0,t);
if(FRACTION(t) && isinteger(ARG(1,t)))
t = ARG(0,t);
if(FRACTION(t) && isinteger(ARG(0,t)))
t = ARG(1,t);
f = FUNCTOR(t);
if(f == '+') /* one irrational summand and the rest rational */
{ n = ARITY(t);
count = 0;
for(i=0;i<n;i++)
{ if(obviously_rational(ARG(i,t)))
continue;
if(obviously_irrational(ARG(i,t)))
++count;
return 0;
}
return count == 1 ? 1 : 0;
}
if(f == '*') /* one irrational factor and the rest rational and nonzero */
{ n = ARITY(t);
count = 0;
for(i=0;i<n;i++)
{ if(obviously_rational(ARG(i,t)) && obviously_nonzero(ARG(i,t)))
continue;
if(obviously_irrational(ARG(i,t)))
++count;
return 0;
}
return count == 1 ? 1 : 0;
}
if(f == SQRT && INTEGERP(ARG(0,t)))
return value(make_power(ARG(0,t),reciprocal(two)),&p);
/* if the root is rational, value will return 0. */
if(f == ROOT && INTEGERP(ARG(1,t)) && ISINTEGER(ARG(0,t)))
return value(make_power(ARG(1,t),reciprocal(ARG(0,t))),&p);
if(f == '^' && NEGATIVE(ARG(1,t)))
return obviously_irrational(make_power(ARG(0,t),ARG(0,ARG(1,t))));
if(f == '^' && FUNCTOR(ARG(0,t)) == SQRT &&
obviously_irrational(ARG(0,t)) &&
isodd(ARG(1,t))
)
return 1; /* odd power of irrational square root */
if(f == '^' && FUNCTOR(ARG(0,t)) == ROOT &&
ISODD(ARG(0,ARG(0,t))) &&
iseven(ARG(1,t)) /* even power of a root with odd index. */
)
return 1;
if(f == '^' && RATIONALP(ARG(1,t)) && INTEGERP(ARG(0,t)) && /* integer base */
cancel(ARG(0,ARG(1,t)),ARG(1,ARG(1,t)),&cancelled,&trash)
/* rational exponent in lowest terms */
)
return value(t,&p); /* value computes it if it's rational, and returns 0 */
if(equals(t,eulere) || equals(t,pi_term))
/* This is stretching the meaning of 'obvious' but anyway let's get the
domain right on x^e or x^pi */
return 1;
return 0; /* I can't think of any more obviously irrational numbers. */
}
/*___________________________________________________________________*/
static int contains_nonconstant_exp(term t)
/* return 1 if t contains a nonconstant exponent */
{ unsigned short i,n;
if(ATOMIC(t))
return 0;
if(FUNCTOR(t) == '^' && !seminumerical(ARG(1,t)))
return 1;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(contains_nonconstant_exp(ARG(i,t)))
return 1;
}
return 0;
}
/*___________________________________________________________________*/
int too_complicated(term t)
/* return 1 if the zeroes of sin t should not be expressed using
existential variables but just left as sin(t) != 0.
*/
{ if(contains_trig(t))
return 1;
if(contains_nonconstant_exp(t))
return 1;
return 0;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists