Sindbad~EG File Manager
/* some operators depending on arithmetic and deval */
/* M. Beeson
Original date 6.27.90
Last modified 6.14.98
*/
#include <string.h>
#include <assert.h>
#include <math.h>
#include "globals.h"
#include "english.h"
#include "order.h"
#include "dcomplex.h"
#include "complex4.h"
#include "deval.h"
#include "pda.h"
#include "ceval.h"
#include "dmod.h"
#include "symbols.h"
#include "errbuf.h"
#include "autosimp.h" /* set_pathtail */
#include "algaux.h" /* path_to_difference */
#include "ops.h" /* dropzero */
#include "pathtail.h" /* MAXTAIL */
static int arithmetic_aux(term in, term *next, char *reason, int semaphore);
static int differs_by_zero_or_one(term a, term b, unsigned short *path, int k, char *reason);
/*________________________________________________________________________*/
int weakarithmetic(term in, term arg, term *next, char *reason)
/* do integer arithmetic only */
{ int err;
aflag saveit = get_arithflag();
aflag arithflag;
memset(&arithflag,0,sizeof(aflag)); /* set all fields to zero */
arithflag.varadd = 1;
arithflag.intexp = 0; /* the main respect in which weakarithmetic is weak */
arithflag.complex = 0;
set_arithflag(arithflag);
err = arithmetic_aux(in,next,reason,arithflag.intexp);
set_arithflag(saveit);
return err;
}
/*________________________________________________________________________*/
int arithmetic(term in, term arg, term *next, char *reason)
/* an operator */
/* In auto mode and menu mode it is restricted by
arithflag; for example if arithflag.ratexp = 0 it won't
perform exponentiation to power 1/2. However, we set
the .intexp flag temporarily to 1 when this operation is used,
otherwise we never even can get 2^3 evaluated. We don't want
it set generally to 1 on elementary topics though because then
other operations such as cancel can evaluate exponents and give
mysterious-looking results.
In term selection mode it
is not so restricted but will go all out to try to
evaluate the term selected by the user.
In automode, if all it does is x+0 = x or x*1 = x, it
calls ShowStepOperation and disguises the reason to look as if it
called those operations.
*/
{ int err,rval;
unsigned short path[MAXTAIL];
char buffer[32];
err = arithmetic_aux(in,next,reason,1);
if(err)
return 1;
if(get_mathmode() != AUTOMODE)
return 0;
rval = differs_by_zero_or_one(in,*next,path,MAXTAIL,buffer);
if(rval == 1)
{ SetShowStepOperation(dropzero);
strcpy(reason,buffer);
set_pathtail(path);
return 0;
}
if(rval == 2)
{ SetShowStepOperation(multbyone);
strcpy(reason,buffer);
set_pathtail(path);
return 0;
}
return 0;
}
/*______________________________________________________________________*/
static int arithmetic_aux(term in, term *next, char *reason, int semaphore)
/* do the work of arithmetic and weakarithmetic. The difference
is that arithmetic passes semaphore = 1 and weakarithmetic passes semaphore = 0.
This is used to determine whether to set arithflag.intexp = 1 before
calling arith.
*/
{ int i,err,difflag,firstdif,complexflag;
aflag flag;
term u;
int mathmode = get_mathmode();
unsigned short path[MAXTAIL];
if(ALREADYARITH(in))
return 1; /* can't do anything, don't waste time trying */
if(PROTECTED(in) && mathmode == AUTOMODE)
return 1; /* Not supposed to touch protected terms in auto mode */
if(status(arithmetic) <= LEARNING)
{ unsigned short i,n;
if(ATOMIC(in))
return 1;
n = ARITY(in);
for(i=0;i<n;i++)
{ if(!AE(ARG(i,in)))
return 1;
} /* and otherwise go on */
}
if(FUNCTOR(in) == '=') /* don't reduce equalities to 'true' */
{ term a,b;
int left,right;
left = value(ARG(0,in),&a);
if(left > 2)
{ a = ARG(0,in);
errbuf(0, aem(left));
}
right = value(ARG(1,in),&b);
if(right > 2)
{ b = ARG(1,in);
errbuf(0, aem(right));
}
if(!equals(a,ARG(0,in)) || !equals(b,ARG(1,in)))
*next = equation(a,b);
else
return 1;
}
else if(FUNCTOR(in) == '+' &&
get_arithflag().comdenom == 0 &&
mathmode == AUTOMODE &&
contains(in,'/')
)
/* then don't add fractions by arithmetic, it's supposed to be
done by explicitly showing common denominator calculation or
addfractions */
return 1;
else if(mathmode == SELECTIONMODE)
{ memset(&flag,semaphore ? 0xff : 0 ,sizeof(aflag));
/* set all bitfields to 1 if semaphore is nonzero, 0 if semaphore is zero.*/
flag.mod = 0; /* not doing modular arithmetic */
flag.pure = 0;
flag.flt = 0; /* don't convert sqrt(2) to a decimal */
flag.complex = 0;
flag.varadd = 1;
copy(in,&u);
strip_protections(&u);
/* without this, you can see root(3,3^2) on the screen, select the 3^2,
and since it is PROTECTED, the operation will be refused. */
err = arith(u,next,flag);
destroy_term(u); /* arith returns in fresh space */
if(err != 0 && err != 2)
{ errbuf(0, aem(err));
return 1;
}
if(equals(*next,in))
return 1;
}
else
{ flag = get_arithflag();
flag.intexp = semaphore;
err = arith(in,next,flag);
if(err == 1)
{ nospace();
return 1;
}
else if(err != 2 && err != 0)
{ /* err = 2 is not an error; it means arithmetic done within a
not entirely arithmetical expression.
err = 1 is returned by value when arith returns 2, i.e.
an expression containing symbols with no arithmetic to be done.
*/
errbuf(0,aem(err));
*next = in;
return 1;
}
if(equals(in,*next))
return 1;
}
if(FUNCTOR(in) == OR && FUNCTOR(*next) == OR)
{ /* arithmetic works on a system of equations, for example
changing sqrt(4) to 2 in both equations; then we want
the ShowStep focus to be sqrt(4) in the first equation,
rather than the whole system of equations. */
difflag = 0;
complexflag = 0;
for(i=0;i<ARITY(in);i++)
{ if(!equals(ARG(i,in),ARG(i,*next)))
{ ++difflag;
if(difflag == 1)
firstdif = i;
path[0] = OR;
path[1] = i+1;
path_to_difference(ARG(i,in),ARG(i,*next),path+2,0);
set_pathtail(path);
if(get_arithflag().complex && iscomplex(u))
complexflag = 1;
}
if(difflag)
{ if(difflag > 1)
{ path[0] = OR;
path[1] = firstdif+1;
path_to_difference(ARG(firstdif,in),ARG(firstdif,*next),path+1,0);
}
set_pathtail(path);
if(complexflag)
strcpy(reason, english(1327)); /* complex arithmetic */
else
strcpy(reason, english(417)); /* arithmetic */
return 0;
}
}
}
if(iscomplex(in) || iscomplex(*next))
{ if (equal_mod_order(in,*next))
return 1; /* reject 2 i pi as an answer for 2 pi i */
path_to_difference(in,*next,path,0);
subterm_at_path(in,path,&u);
set_pathtail(path);
if(get_arithflag().complex && iscomplex(u))
strcpy(reason, english(1327)); /* complex arithmetic */
else
strcpy(reason, english(417)); /* arithmetic */
return 0;
}
strcpy(reason, english(417)); /* arithmetic */
path_to_difference(in,*next,path,0);
set_pathtail(path);
return 0;
}
/*_______________________________________________________________*/
int devalop(term t, term arg, term *next, char *reason)
/* evaluate t using deval. Return 0 if something is done.
But don't count it if only integers are evaluated, as this
looks like no change at all.
*/
{ int err;
double ans;
unsigned short n,f;
if(equals(t,pi_term) || equals(t,eulere))
return 1; /* don't evaluate pi, e.g. in n pi + arccos(1/3) */
if(!seminumerical2(t)) /* allows pi and e as subterms as well as
defined variables whose definitions are
seminumerical */
return 1; /* allows pi and e */
if(iscomplex(t))
return 1; /* doesn't do complex arithmetic */
if(INTEGERP(t))
return 1; /* don't evaluate integers */
if(FUNCTOR(t) == DEG)
return 1; /* otherwise sin(deg(60)) will convert deg(60) to radians */
/* deval itself WILL work on DEG terms */
err = deval(t,&ans); /* in menu mode, needs_arg and get_arg have taken
care that parameter values are correct */
if(err == -1) /* sin^22 etc. */
err = deval(t, &ans);
if(err)
{ if(err != 1 && err != 8 && err != 12)
errbuf(0, dem(err));
return 1;
}
*next = make_double(ans);
if(equals(t,*next))
return 1;
n = ARITY(t);
f = FUNCTOR(t);
/* Now call SetShowStepOperation appropriately */
if(f == ROOT || f == SQRT)
{ SetShowStepOperation(computeroot);
strcpy(reason, f == SQRT ? english(460) : english(461));
/* compute square root, compute root */
}
else if(
(n == 1 && f != '-') ||
(
n == 2 && f != '/' && f != '+' &&
f != '*' && f != '^' && f != AND && f != OR
)
)
{ SetShowStepOperation(computefunction);
strcpy(reason, english(1389)); /* compute function */
}
else if (f == '^' && NUMBER(ARG(1,t)))
{ SetShowStepOperation(computepower);
strcpy(reason, english(1390)); /* decimal value of x^n */
}
strcpy(reason, english(1391)); /* decimal calculation */
HIGHLIGHT(*next);
return 0;
}
/*________________________________________________________________________*/
int cevalop(term t, term arg, term *next, char *reason)
{ int err;
int exp1,exp2;
dcomplex ans;
if(equals(t,pi_term) || equals(t,eulere))
return 1; /* don't evaluate \pi , e.g. in n\pi + arccos(1/3) */
if(!complexnumerical2(t)) /* allows pi and e and defined variables if
the definitions are complexnumerical2 */
return 1;
err = ceval(t,&ans); /* in menu mode, needs_arg and get_arg have taken
care that parameter values are correct */
if(err == -1) /* sin^22 etc. */
err = ceval(t, &ans);
if(err)
return 1;
frexp(ans.r,&exp1);
frexp(ans.i,&exp2);
/* next lines correct for round-off error, as seen e.g. in computation
of Gaussian sums. If real or imaginary part is very small compared
to the other one, and the large one is more than .001 or so,
then call the small one zero. */
if(exp2 > -10 && exp1 + 40 < exp2)
ans.r = 0.0;
else if( exp1 > -10 && exp2 + 40 < exp1)
ans.i = 0.0;
*next = make_complex(make_double(ans.r),make_double(ans.i));
if(equals(t,*next))
return 1;
strcpy(reason, english(1392)); /* complex decimal calc. */
HIGHLIGHT(*next);
return 0;
}
/*________________________________________________________________________*/
int computefunction(term t, term arg, term *next, char *reason)
{ unsigned f =FUNCTOR(t);
int err;
if(!UNARY(f) && f != BINOMIAL && f < 95)
return 1;
if(get_complex())
err = cevalop(t,arg,next,reason);
else
err = devalop(t,arg,next,reason);
if(err)
return 1;
strcpy(reason, english(1389)); /* compute function */
return 0;
}
/*_______________________________________________________________*/
int computepower(term t, term arg, term *next, char *reason)
{ int err;
if(FUNCTOR(t) != '^')
return 1;
if(get_complex())
err = cevalop(t,arg,next,reason);
else
err = devalop(t,arg,next,reason);
if(err)
return 1;
strcpy(reason, english(1390)); /* decimal value of x^n */
return 0;
}
/*_______________________________________________________________*/
int evalpi(term t, term arg, term *next, char *reason)
/* decimal value of \pi */
{ if(!equals(pi_term,t))
return 1;
*next = make_double(PI_DECIMAL);
strcpy(reason,english(1362)); /* decimal value of \pi */
HIGHLIGHT(*next);
return 0;
}
/*_______________________________________________________________*/
int evaleulere(term t, term arg, term *next, char *reason)
/* decimal value of e */
{ if(!equals(eulere,t))
return 1;
*next = make_double(exp(1.0));
strcpy(reason,english(1363)); /* decimal value of e */
HIGHLIGHT(*next);
return 0;
}
/*________________________________________________________________________*/
static term total_sort(term t)
/* return in completely fresh space a term mathematically equal to u
but with + and * subterms sorted. The result can be destroyed without
altering u. */
{ term ans;
int i;
unsigned short n,f;
if(ISATOM(t))
return t;
if(OBJECT(t))
{ copy(t,&ans); /* allocates new arg space if the data is on the heap,
but re-uses static space (for integers <= 10) */
return ans;
}
f = FUNCTOR(t);
n = ARITY(t);
ans = make_term(f,n);
for(i=0;i<n;i++)
ARGREP(ans,i,total_sort(ARG(i,t)));
if(f == '*')
sortargs(ans);
else if(f == '+')
additive_sortargs(ans);
return ans;
}
/*________________________________________________________________________*/
int equal_mod_order(term u, term v)
/* return 1 if u and v differ only in the order of multiplicative or
additive arguments */
{ term a,b;
int ans;
a = total_sort(u);
b = total_sort(v);
ans = equals(a,b);
destroy_term(a); /* made by total_sort */
destroy_term(b);
return ans;
}
/*________________________________________________________________________*/
int complexpowers(term t, term arg, term *next, char *reason)
/* Evaluate power of complex number */
{ int err;
aflag flag;
if(FUNCTOR(t) != '^')
return 1;
if(!contains(t, 'i'))
return 1;
flag = get_arithflag();
flag.complex = 1;
flag.complexpowers = 1;
err = arith(t,next,flag);
if(err != 2 && err != 0)
{ errbuf(0,aem(err));
return err;
}
/* now err==0 (arithmetic value) or
err==2 (t contained some non-arithmetic terms) */
if(equals(t,*next))
return 1;
if(contains(t,'i') || contains(*next,'i'))
{ if (equal_mod_order(t,*next))
return 1; /* reject 2 i pi as an answer for 2 pi i */
strcpy(reason,english(1327)); /* complex arithmetic */
}
else
strcpy(reason, english(417)); /* arithmetic */
HIGHLIGHT(*next);
return 0;
}
/*________________________________________________________________________*/
int complexarithmetic(term t, term arg, term *next, char *reason)
/* does complex powers as well as +,-,/, * */
{ int err;
aflag flag = get_arithflag();
flag.complex = 1;
flag.complexpowers = 1;
err = arith(t,next,flag);
if(err != 2 && err != 0)
{ errbuf(0,aem(err));
return err;
}
/* now err==0 (arithmetic value) or
err==2 (t contained some non-arithmetic terms) */
if(equals(t,*next))
return 1;
if(contains(t,'i') || contains(*next,'i'))
{ if (equal_mod_order(t,*next))
return 1; /* reject 2 i pi as an answer for 2 pi i */
strcpy(reason,english(1327)); /* complex arithmetic */
}
else
strcpy(reason, english(417)); /* arithmetic */
HIGHLIGHT(*next);
return 0;
}
/*________________________________________________________________________*/
int weakcomplexarithmetic(term t, term arg, term *next, char *reason)
/* does not do complex powers, only +,-,/, * */
{ int err;
aflag flag = get_arithflag();
flag.complex = 1;
flag.complexpowers = 0;
err = arith(t,next,flag);
if(err != 2 && err != 0)
{ errbuf(0,aem(err));
return err;
}
/* now err==0 (arithmetic value) or
err==2 (t contained some non-arithmetic terms) */
if(equals(t,*next))
return 1;
if(contains(t,'i') || contains(*next,'i'))
{ if (equal_mod_order(t,*next))
return 1; /* reject 2 i pi as an answer for 2 pi i */
strcpy(reason,english(1327)); /* complex arithmetic */
}
else
strcpy(reason, english(417)); /* arithmetic */
HIGHLIGHT(*next);
return 0;
}
/*__________________________________________________________*/
int seminumerical2(term t)
/* Like seminumerical except it also accepts atoms which have
been let-defined, if the right side of the definition
is seminumerical2.
*/
{ int i,err,nextdefn;
term u,saveit;
defn d;
unsigned f = FUNCTOR(t);
if(f == OR || f == AND || f == NOT || f == IMPLIES || f == SEQ ||
f == CONSTANTOFINTEGRATION
)
return 0;
if(ISATOM(t))
{ if(f == 'e')
return 1;
if(f == PI_ATOM)
return 1;
nextdefn = get_nextdefn();
for(i=0;i<nextdefn;i++)
{ d = get_defn(i);
if(equals(d.left,t) && seminumerical2(d.right))
return 1;
}
return 0;
}
if(OBJECT(t))
return 1;
if(f==SIN || f == COS || f == SEC || f == CSC)
{ if(seminumerical2(ARG(0,t)))
return 1;
if(ISATOM(ARG(0,t)))
return 0;
if(FUNCTOR(ARG(0,t)) != '+')
return 0;
u = make_term('+',ARITY(ARG(0,t)));
saveit = u;
if(FUNCTOR(u) == ILLEGAL)
return 37; /* Insufficient memory ... */
err = dmod2pi(ARG(0,t),&u);
RELEASE(saveit);
return !err;
}
if(f==TAN || f == COT)
{ if(seminumerical2(ARG(0,t)))
return 1;
if(ISATOM(ARG(0,t)))
return 0;
if(FUNCTOR(ARG(0,t)) != '+')
return 0;
u = make_term('+',ARITY(ARG(0,t)));
saveit = u;
if(FUNCTOR(u) == ILLEGAL)
return 37; /* Insufficient memory ... */
err = modpi(ARG(0,t),&u);
RELEASE(saveit);
return !err;
}
for(i=0;i<ARITY(t);i++)
{ if(!seminumerical2(ARG(i,t)))
return 0;
}
return 1;
}
/*__________________________________________________________*/
int complexnumerical2(term t)
/* return 1 if t is evaluable by ceval without using parameter values;
else return 0 */
/* Differs from 'numerical' in that pi and e and i are allowed. Differs from
constant in that parameters are not allowed. Differs from seminumerical
in that complexi is allowed. */
{ int i,err,nextdefn;
defn d;
unsigned f = FUNCTOR(t);
if(f == OR || f == AND || f == NOT || f == IMPLIES || f == SEQ ||
f == CONSTANTOFINTEGRATION
)
return 0;
if(ISATOM(t))
{ if(f == 'e')
return 1;
if(f == PI_ATOM)
return 1;
if(EQUALSCOMPLEXI(t))
return 1;
nextdefn = get_nextdefn();
for(i=0;i<nextdefn;i++)
{ d = get_defn(i);
if(equals(d.left,t) && complexnumerical2(d.right))
return 1;
}
return 0;
}
if(OBJECT(t))
return 1;
if(f==SIN || f == COS || f == SEC || f == CSC)
{ term u,saveit;
if(complexnumerical2(ARG(0,t)))
return 1;
if(ISATOM(ARG(0,t)))
return 0;
if(FUNCTOR(ARG(0,t)) != '+')
return 0;
u = make_term('+',ARITY(ARG(0,t)));
saveit = u;
err = dmod2pi(ARG(0,t),&u);
RELEASE(saveit);
return !err;
}
if(f==TAN || f == COT)
{ term u,saveit;
if(complexnumerical2(ARG(0,t)))
return 1;
if(ISATOM(ARG(0,t)))
return 0;
if(FUNCTOR(ARG(0,t)) != '+')
return 0;
u = make_term('+',ARITY(ARG(0,t)));
saveit = u;
err = modpi(ARG(0,t),&u);
RELEASE(saveit);
return err;
}
for(i=0;i<ARITY(t);i++)
{ if(!complexnumerical2(ARG(i,t)))
return 0;
}
return 1;
}
/*______________________________________________________________________*/
static int differs_by_zero_or_one(term a, term b, unsigned short *path, int k, char *buffer)
/* k is the dimension of the path array. If a and b agree except
for one subterm where a has a sum including a zero summand and b
has dropped the zero, then put the path to that subterm of a in
path (in the form [functor, arity+1,...] starting with the functor of a)
and return 1. If they differ by a product including a factor of 1 in a
but not in b, do the same but return 2. If they are equal return 3.
If they are unequal and return values 1 and 2 don't apply, return 0.
If the depth of the terms exceeds k, return 4. If they differ in two or
more subterms, but in the same way (x+0=x or x*1 = x), that still counts
as success.
The array buffer is meant to hold "x + 0 = 0" etc. produced by dropzero
or multbyone.
*/
{ unsigned short n,f;
int i,flag,rval,whicharg=-1;
term u;
if(ATOMIC(a))
return equals(a,b) ? 3 : 0;
f = FUNCTOR(a);
if(f == '*' && ARITY(a) == 2 && ONE(ARG(0,a)) && equals(ARG(1,a),b))
{ path[0] = 0;
strcpy(buffer,"$1\\cdot a = a$");
return 2;
}
if(f == '*' && ARITY(a) == 2 && ONE(ARG(1,a)) && equals(ARG(0,a),b))
{ path[0] = 0;
strcpy(buffer,"$a\\cdot 1 = a$");
return 2;
}
if(f == '+' && ARITY(a) == 2 && ZERO(ARG(0,a)) && equals(ARG(1,a),b))
{ path[0] = 0;
strcpy(buffer,"0 + a = a");
return 1;
}
if(f == '+' && ARITY(a) == 2 && ZERO(ARG(1,a)) && equals(ARG(0,a),b))
{ path[0] = 0;
strcpy(buffer,"a + 0 = a");
return 1;
}
if(f == '+' && ARITY(a) == 2 && NEGATIVE(ARG(1,a)) && ZERO(ARG(0,ARG(1,a))) && equals(ARG(0,a),b))
{ path[0] = 0;
strcpy(buffer,"a - 0 = a");
return 1;
}
if(f != FUNCTOR(b))
return 0;
n = ARITY(a);
if(k <= 0)
return 4;
if(f == '+' && ARITY(b) < ARITY(a) && !dropzero(a,zero,&u,buffer) && equals(u,b))
{ path[0] = 0;
return 1;
}
if(f == '*' && ARITY(b) < ARITY(a) && !multbyone(a,zero,&u,buffer) && equals(u,b))
{ path[0] = 0;
return 2;
}
if(n != ARITY(b))
return 0;
path[0] = f;
flag = 3;
for(i=0;i<n;i++)
{ rval = differs_by_zero_or_one(ARG(i,a),ARG(i,b),path+2,k-2,buffer);
if(rval == 0)
return 0;
if(rval == 4)
return 4;
if(rval == 3)
continue;
if(flag != rval && (flag == 1 || flag == 2))
return 0; /* only one subterm may differ, unless in the same way */
if(flag == 3)
{ flag = rval;
whicharg = i;
}
}
if(whicharg == -1)
return 3; /* all args were equal, so the terms are equal */
path[1] =(unsigned short)(whicharg+1);
if(whicharg != n-1)
differs_by_zero_or_one(ARG(whicharg,a),ARG(whicharg,b),path+2,k-2,buffer);
/* repeat the (first) successful call, because path has been screwed up by
subsequent calls. The alternative is to save the path, which means
having a path buffer for each recursive call. With a 32 K stack,
and a path buffer of 256, this might severely limit recursion depth,
whereas this method will only slow it down an unnoticeable amount. */
return flag; /* if flag is 3 it doesn't matter that path[1] got a garbage value */
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists