Sindbad~EG File Manager
/* public auxiliary functions used by the operators */
/* M. Beeson
12.14.90 original date
7.31.98 last modified
12.30.99 changed contains_fractional_exponents to contains_signed_fractional_exponents
1.9.00 modified polyvalop
1.15.00 modified polyvalop
2.9.05 modified includes
3.17.06 changed static contains_double to contains_double2
6.4.13 switched ARG(0,v) and ARG(1,v) around line 330, then fixed it to take either one
10.24.23 eliminated OEM characters in favor of \times
12.12.23 removed macro random() as it was never used and caused trouble
*/
#include <string.h>
#include <ctype.h>
#include <assert.h>
#include "errbuf.h"
#include "tdefn.h"
char *ltoa(long, char *,int);
#include "globals.h"
#include "ops.h" /* prototypes of operators */
#include "trig.h" /* complexform */
#include "order.h"
#include "cancel.h"
#include "factor.h"
#include "algaux.h"
#include "polynoms.h"
#include "simpsums.h"
#include "simpprod.h"
#include "eqn.h"
#include "probtype.h"
#include "fraction.h"
#include "domain.h"
#include "checkarg.h" /* automode.h needs it */
#include "graphstr.h"
#include "mpdoc.h"
#include "automode.h" /* EXPANDFLAG */
#include "symbols.h"
#include "pda.h" /* equal_mod_order */
#include "autosimp.h" /* set_pathtail etc. */
#include "cflags.h"
#include "calc.h"
#include "sqrts.h" /* restore_sqrts */
#include "pvalaux.h" /* contains_fractional_exponents */
static void clear_already_arith(term *t);
static void mark_big_exponents(term *t);
/*_____________________________________________________________________*/
term add_cancel_and_order(term a, term b)
/* form a+b (dropping zeroes);
if addeqn is LEARNING:
Just syntactically add, do not even cancel or order terms.
Do NOT collect terms.
else if addeqn is better than LEARNING:
perform all cancellations and collect terms
In either case, put the result in proper additive order.
*/
{ term p,q;
int cancelflag,collectflag;
at(a,b,&p);
if(status(addeqn) <= LEARNING)
return p;
collect_aux2(p,&q,&cancelflag,&collectflag);
return additive_order(q);
}
/*_________________________________________________________________*/
int ratpart(term t, term *r)
/* breaks a product into its 'rational part' r and its 'symbolic part' s,
which it does not save.
For example (1/3)x^2 produces *r = (1/3). This is similar to
ncs, but ncs sends all terms without atoms to the numerical part, while
ratpart sends only rational terms there, and leaves terms like \sqrt 2 or sin(2)
in the symbolic part. */
/* Return value is zero if *r is not 1, i.e. something was done */
/* works on fractions and negations of things it works on, too */
{ int i,err;
unsigned short sign,n1;
term temp,temp2,tempn,u;
unsigned short f = FUNCTOR(t);
if(f == '-')
{ ratpart(ARG(0,t),&temp);
tneg(temp,r);
return 0;
}
if(f == '/')
{ ratpart(ARG(0,t),&temp);
ratpart(ARG(1,t),&temp2);
temp = make_fraction(temp,temp2);
err = value(temp,r);
if(err)
{ if(NUMBER(temp))
{ *r = temp;
return 0;
}
*r = one;
return 1;
}
return 0;
}
if(f != '*')
{ if (INTEGERP(t) || RATIONALP(t))
{*r = t;
return 1;
}
/* Now t must be symbolic */
*r = one;
return 3;
}
tempn = make_term('*', ARITY(t)); /* doesn't matter if there's extra arg space */
n1=sign=0;
for(i=0;i<ARITY(t);i++)
{ u = ARG(i,t);
if(FUNCTOR(u) == '-')
{ sign = (sign ? (unsigned short)0 : (unsigned short)1);
u = ARG(0,u);
}
if (INTEGERP(u) || RATIONALP(u))
{ ARGREP(tempn,n1,u);
++n1;
}
else if(FUNCTOR(u) == '^' && numerical(u))
/* example, t = 3^2x, so u = 3^2;
the rational part is 3^2 */
{ err = value(u,&temp);
if(!err)
{ ARGREP(tempn,n1,u);
++n1;
}
}
}
if(n1 == 0)
{ RELEASE(tempn);
if(sign)
tneg(one,r);
else *r = one;
}
if(n1 == 1)
{ temp = ARG(0,tempn);
RELEASE(tempn);
if(sign)
tneg(temp,r);
else
*r = temp;
}
if(n1 > 1)
{ SETFUNCTOR(tempn,'*',n1);
if(sign)
tneg(tempn,r);
else *r = tempn;
}
return 0;
}
/*_________________________________________________________________*/
int polyvalop(term t, term arg, term *next, char *reason)
/* set polyval flags appropriately, call polyval, reset the flags.
If arg is passed as 'seven', return then. (It's called this way
from selectops1 to see if it will work.) If arg is anything but
'seven', as it will be when the operation is actually used,
then locate the minimum portion of the input that changed and
set the ShowStep apparatus appropriately.
*/
{ int err;
int savefactorflag = get_polyvalfactorflag();
int savecomdenomflag;
static int stopflag;
int savefractexpflag = get_polyvalfractexpflag();
int savelogflag = get_polyvallogflag();
int problemtype = get_problemtype();
int expandflag = get_expandflag();
int intflag = get_intflag();
int difflag = get_difflag();
int indenomflag = get_indenomflag();
int innumflag = get_innumflag();
int savenegexpflag = get_polyvalnegexpflag();
int currenttopic = get_currenttopic();
unsigned short *marker;
term u,v,w,temp;
unsigned short path[MAXTAIL];
char buffer[DIMREASONBUFFER];
set_polyvalfractexpflag(0);
if(FUNCTOR(t) == '^' && NEGATIVE(ARG(1,t)) &&
get_mathmode() == SELECTIONMODE
)
/* then we have to eliminate the negative exponent. For
explanation see file selectop.c, search for "negative exponent". */
set_polyvalnegexpflag(-1);
if(contains_big_exponents(t))
{ term t2;
copy(t,&t2);
mark_big_exponents(&t2);
t = t2; /* and go on */
}
if(difflag ||
(intflag && !indenomflag) ||
EXPANDFLAG ||
problemtype == LINEAR_EQUATIONS ||
problemtype == TRIG_IDENTITY ||
currenttopic == _trig_product ||
SOLVETYPE(problemtype) ||
get_complex() ||
(!get_infractionflag() && CALCULUS_TOPIC(currenttopic))
/* in calculus, even in limits, there's no need to factor sums
except in fractions. Example: lim(x->a, x-sqrt(x^2-x)); we
don't want to factor under the square root sign. */
)
set_polyvalfactorflag(0);
else
set_polyvalfactorflag(1);
if(SERIESTYPE(problemtype))
set_polyvallogflag(1);
if(FUNCTOR(t) == '+' && get_mathmode() == AUTOMODE &&
contains(t,DIFF) && !contains(t,INTEGRAL)
)
/* don't work on sums still containing unevaluated derivatives
unless there are also unevaluated integrals.
*/
err = 1;
else
{ err = polyval(t,next);
if(contains_signed_fractional_exponents(*next) &&
!contains_signed_fractional_exponents(t) &&
!restore_sqrts(*next,&temp)
/* don't gratuitiously change sqrts to fractional exponents */
)
*next = temp;
}
set_polyvalfactorflag(savefactorflag);
set_polyvalfractexpflag(savefractexpflag);
set_polyvalnegexpflag(savenegexpflag);
set_polyvallogflag(savelogflag);
if(!err && equal_mod_order(t,*next))
err = 1; /* don't succeed if it was just a re-ordering */
if(err)
{ if(err > 2)
{ errbuf(0,aem(err));
return 1;
}
if(get_mathmode() == AUTOMODE || stopflag)
return 1;
/* But in Term Selection Mode, we must be able to duplicate an
auto step, and in automode, it will eventually be tried with
some different settings of various flags. So, we must try that
also when the user chooses this operation, otherwise ShowStep
will indicate "simplify" and it won't work, or worse, it won't
even appear on the Term Selection Menu. */
problemtype = get_problemtype();
savefactorflag = get_factorflag();
savecomdenomflag = get_comdenomflag();
if(savefactorflag || savecomdenomflag)
{ set_factorflag(0);
set_comdenomflag(0);
}
else
{ set_factorflag(1);
set_comdenomflag(1);
}
set_problemtype(SIMPLIFY);
stopflag = 1; /* stop an evil recursion by preventing the
following call from entering this block and
hence from making a deeper recursive call. */
err = polyvalop(t,arg,next,reason);
stopflag = 0;
set_problemtype(problemtype);
set_factorflag(savefactorflag);
set_comdenomflag(savecomdenomflag);
if(err)
return err;
}
strcpy(reason, english(1589)); /* simplify */
if(equals(arg,seven))
return err; /* arg is passed as seven from selectops1 */
/* In general the action took place somewhere inside t, but we don't
know where; but we can at least make a token attempt to localize it
to num or denom of a fraction, or arg of a trig function,
and in particular never color 'multiplicity'. Indeed, for
use with ShowStep we want to do much better than that. We want to
color only the maximum portion that has changed.
*/
path_to_difference(t,*next,path,1);
/* But if the term at path is sqrt(n)/m, or c sqrt(n)/m,
and what simplify has done is replace it by (1/n) sqrt(n),
this won't happen if we set the focus to sqrt(n)/m;
we must back up until a '+' is included in the path.
*/
problemtype = get_problemtype();
if(SOLVETYPE(problemtype))
set_checksolutionsflag(1);
err = subterm_at_path(t,path,&u);
/* assert(!err); No need to risk a crash if this assertion fails. */
if(err)
{ HIGHLIGHT(*next);
return 0;
}
if(FUNCTOR(u) == '*' && ONE(ARG(0,u)) &&
!subterm_at_path(*next,path,&v)
)
{ if(ARITY(u) == 2 && equals(*next,ARG(1,u)))
{ SetShowStepOperation(multbyone);
strcpy(reason, "$1\\times x = x$");
set_pathtail(path);
return 0;
}
if(FUNCTOR(*next) == '*' && ARITY(*next) + 1 == ARITY(u))
{ int i;
for(i=0;i<ARITY(*next);i++)
{ if(!equals(ARG(i,*next),ARG(i+1,u)))
break;
}
if(i == ARITY(*next))
{ SetShowStepOperation(multbyone);
set_pathtail(path);
strcpy(reason, "$1\\times x = x$");
return 0;
}
}
}
/* next catch the case where ai/b has become i(a/b) or i(a/b) because it's in
a sum. This won't happen if you choose simplify on ai/b itself */
if(FRACTION(u) &&
!subterm_at_path(*next,path,&v) &&
FUNCTOR(v) == '*' && ARITY(v) == 2 &&
equals(ARG(0,v),complexi) &&
FRACTION(ARG(1,v)) &&
equals(ARG(1,ARG(1,v)),ARG(1,u))
)
{ set_pathtail(path);
SetShowStepOperation(complexform);
strcpy(reason,english(1135)); /* write in form x + iy */
return 0;
}
/* Now the other order of args of v */
if(FRACTION(u) &&
!subterm_at_path(*next,path,&v) &&
FUNCTOR(v) == '*' && ARITY(v) == 2 &&
equals(ARG(1,v),complexi) &&
FRACTION(ARG(0,v)) &&
equals(ARG(1,ARG(0,v)),ARG(1,u))
)
{ set_pathtail(path);
SetShowStepOperation(complexform);
strcpy(reason,english(1135)); /* write in form x + iy */
return 0;
}
if(path[0] == 0)
{ HIGHLIGHT(*next);
return 0;
}
if(FUNCTOR(u) == ABSFUNCTOR)
{ /* abs(z)^(2n) got changed to z^(2n). The path must be shortened */
marker = path;
while(*marker)
++marker;
marker -=2;
*marker = 0;
err = subterm_at_path(t,path,&v);
if(!err && FUNCTOR(v) == '^')
{ set_pathtail(path);
return 0;
}
}
if(FUNCTOR(u) == '^' && NEGATIVE(ARG(1,u)) && /* imitate a^-n = 1/a^n */
!subterm_at_path(*next,path,&v) && FRACTION(v) &&
ONE(ARG(0,v)) && FUNCTOR(ARG(1,v)) == '^' &&
equals(ARG(0,ARG(1,v)),ARG(0,u)) &&
equals(ARG(1,ARG(1,v)),ARG(0,ARG(1,u)))
)
{ SetShowStepOperation(eliminatenegexp);
set_pathtail(path);
strcpy(reason,"a^(-n) = 1/a^n");
return 0;
}
if(FUNCTOR(u) == '^' && NEGATIVE(ARG(1,u)) && /* imitate a^-1 = 1/a */
ONE(ARG(0,ARG(1,u))) &&
!subterm_at_path(*next,path,&v) && FRACTION(v) &&
ONE(ARG(0,v)) && equals(ARG(1,v),ARG(0,u))
)
{ SetShowStepOperation(eliminatenegexp1);
set_pathtail(path);
return 0;
}
if(FUNCTOR(u) == INTEGRAL && NEGATIVE(ARG(0,u)))
{ err = subterm_at_path(*next,path,&v);
if(!err && NEGATIVE(v) && FUNCTOR(ARG(0,v)) == INTEGRAL && equals(ARG(0,ARG(0,v)),ARG(0,ARG(0,u))))
{ err = intminus(u,zero,&temp,reason);
if(!err)
{ set_pathtail(path);
SetShowStepOperation(intminus);
return 0;
}
}
}
/* following code deals with integral(3u,x) = 3 integral(u,x),
but also with several other situations, eg. integral(3/x,x),
integral(1/(3x),x), integral(2/(3x),x), etc. */
if(FUNCTOR(u) == INTEGRAL &&
(FUNCTOR(ARG(0,u)) == '*' || FRACTION(ARG(0,u))) &&
!subterm_at_path(*next,path,&v) &&
FUNCTOR(v) == '*' && FUNCTOR(ARG(ARITY(v)-1,v)) == INTEGRAL &&
!intlinear(u,zero,&w,buffer) && equals(w,v)
)
{ set_pathtail(path);
SetShowStepOperation(intlinear);
return 0;
}
if(
FRACTION(u) && INTEGERP(ARG(1,u)) &&
(
(FUNCTOR(ARG(0,u))==SQRT && numerical(ARG(0,ARG(0,u)))) ||
(FUNCTOR(ARG(0,u))== '*' && ARITY(ARG(0,u)) == 2 && FUNCTOR(ARG(1,ARG(0,u))) == SQRT && numerical(ARG(0,u)))
) &&
!subterm_at_path(*next,path,&v) &&
FUNCTOR(v) == '*' && FRACTION(ARG(0,v))
)
{ /* The term worked on was sqrt(n)/m, which got changed to (1/m) sqrt(n);
this won't happen if polyval is called on that term directly.
Note that 'numerical' is needed, not just INTEGERP, to cover e.g.
1 + sqrt(4 - 4 sqrt 2)/2
*/
SetShowStepOperation(pulloutrational);
strcpy(reason,"au/bv = (a/b) (u/v)");
}
/* following code deals with simplifying (-v)^2n to v^(2n), in which
case the path-to-difference term is u = -v; we don't want it to
look like -v simplified to v. */
if(NEGATIVE(u))
{ unsigned short saveit;
marker = path;
while(*marker)
++marker;
marker -=2;
saveit = *marker;
*marker = 0;
err = subterm_at_path(t,path,&v);
if(FUNCTOR(v) == '^')
{ set_pathtail(path);
return 0;
}
*marker = saveit;
}
/* following code deals e.g. with cos(1/2 arccos x), which goes to
cos(arccos(x)/2); but now we've set the path to include only the
(1/2 arccos x) part, and that won't go to arccos(x)/2 in polyval,
so ShowStep won't work. We therefore want to call SetShowStepOperation
to make it multiplyfractions2, but this should only be done in automode
so the user who selected the whole term and chose "simplify" will
not see the reason a(b/c) = ab/c */
if(get_mathmode() == AUTOMODE &&
FUNCTOR(u) == '*' && RATIONALP(ARG(0,u)) && ARITY(u) == 2 &&
!subterm_at_path(*next,path,&v) && FRACTION(v) &&
equals(ARG(1,v),ARG(1,ARG(0,u)))&&
!multiplyfractions2(u,zero,&temp,reason) &&
equals(temp,v)
)
{ SetShowStepOperation(multiplyfractions2);
if(path[0])
set_pathtail(path);
return 0;
}
if(path[0])
set_pathtail(path);
/* Could this result have been achieved by 'arithmetic'? If so we
want to label it that way. */
if(numerical(u))
{ copy(u,&v);
u = v;
clear_already_arith(&u);
set_pathtail(NULL);
err = arithmetic(u,zero,&w,reason);
if(!err && !subterm_at_path(*next,path,&v) && equals(v,w))
{ SetShowStepOperation(arithmetic);
/* arithmetic may have reset pathtail, in which case
it is now wrong. */
pathcat(path,get_pathtail());
set_pathtail(path);
return 0; /* leaving 'arithmetic' in the reason string */
}
else
set_pathtail(path);
/* restore the path set before trying arithmetic */
}
return 0;
}
/*______________________________________________________________*/
int path_to_difference(term a, term b, unsigned short *path, int colorflag)
/* path is an array of dimension at least MAXTAIL. Find the
path to the first subterm where a and b are different, and
if colorflag is nonzero and the path is nonempty, then
HIGHLIGHT the different subterm in b.
Return 1 if a and b are equal, 0 if there is a difference.
If 1 is returned, path is meaningless.
*/
{ unsigned short n;
int i,err,count,flag;
unsigned short localpath[MAXTAIL];
if(ATOMIC(a) && !ATOMIC(b))
{ path[0] = 0;
return 0;
}
if(!ATOMIC(a) && ATOMIC(b))
{ path[0] = 0;
return 0;
}
if(ATOMIC(a) && ATOMIC(b))
{ if(!equals(a,b))
{ path[0] = 0;
return 0;
}
return 1;
}
if(FUNCTOR(a) != FUNCTOR(b) || ARITY(a) != ARITY(b))
{ path[0] = 0;
return 0;
}
n = ARITY(a);
path[0] = FUNCTOR(a);
count = 0; /* count how many args are different */
for(i=0;i<n;i++)
{ err = path_to_difference(ARG(i,a),ARG(i,b),localpath,colorflag);
if(!err)
{ ++count;
if(count == 1)
pathcopy(path+2,localpath);
if(count > 1)
break; /* No need to look for more than 2 different args */
flag = i+1;
}
}
if(count == 1)
{ path[1] = (unsigned short) flag;
if(path[2]==0 && colorflag)
HIGHLIGHT(ARG(flag-1,b));
return 0;
}
if(count > 1)
{ path[0] = 0;
return 0;
}
return 1; /* a and b are equal */
}
/*______________________________________________________________*/
int contains_monomially(term t, unsigned short f)
/* does t contain f(u) (where u is not econstant)
in a monomial or fraction of
monomials at top level? If so return 1, if not return 0.
Note that t is allowed to contain f also in deeper places--
it doesn't mean t contains f ONLY monomially.
When f == '^', we are looking for NONCONSTANT powers.
Don't count a SQRT or ROOT inside a power. */
{ unsigned short n = ARITY(t);
unsigned short g = FUNCTOR(t);
int i;
if(ATOMIC(t))
return (FUNCTOR(t) == f);
if(f == '^' && g == '^')
return !econstant(ARG(1,t));
if((f == SQRT || f == ROOT) && g == '^')
return 0;
if(g == f) /* and f != '^' */
return !econstant(t);
if(g == '^')
{ if(!econstant(ARG(1,t)))
return 0;
return contains_monomially(ARG(0,t),f);
}
if(g == '*' || g == '/' || g == '-' )
{ for(i=0;i<n;i++)
{ if(contains_monomially(ARG(i,t),f))
return 1;
}
}
return 0; /* when other functors are encountered */
}
/*_______________________________________________________________*/
int subterm_at_path(term t, unsigned short *path, term *ans)
/* if path is a legal path in t, return in *ans the
subterm of t specified by path. Path uses arg numbers
starting from 1, not 0, and is null-terminated.
Subranges are specified using SUBRANGE in the functor
position, example +,1,SUBRANGE,2 for a two-summand subrange.
Return 0 for success, 1 for illegal path (path runs out of t).
If 1 is returned, *ans will be garbage.
If path[1] is zero, or more generally the path length is odd,
it means this path was generated by autosimp with dir UP, and the final
entry is the functor of the desired subterm, and should be ignored.
*/
{ int i;
unsigned short n,f;
if(path[0] == 0 || path[1] == 0)
{ *ans = t;
return 0;
}
if(ATOMIC(t))
return 1;
f = FUNCTOR(t);
n = ARITY(t);
if(path[0] != f)
return 1;
if(path[1]-1 >= n)
return 1;
if(path[2] == SUBRANGE)
{ if(path[3]-1 >= n)
return 1;
*ans = make_term(f,(unsigned short)(path[3]-path[1]));
for(i=0;i<ARITY(*ans);i++)
ARGREP(*ans,i,ARG(path[1]-1+i,t));
return 0;
}
return subterm_at_path(ARG(path[1]-1,t), path+2,ans);
}
/*______________________________________________________________*/
static void clear_already_arith(term *t)
/* remove ALREADY_ARITH markers recursively from *t and its subterms;
also removed PROTECTED bits.
*/
{ unsigned short n;
int i;
if(ATOMIC(*t))
return;
UNSET_ALREADYARITH(*t);
UNPROTECT(*t);
n = ARITY(*t);
for(i=0;i<n;i++)
clear_already_arith(ARGPTR(*t)+i);
}
/*________________________________________________________________*/
static int contains_double2(term t)
/* return 1 if t contains a double, 0 if not. */
/* this is a copy of contains_double, used to make this
file more self-contained. */
{ unsigned short i,n;
if(OBJECT(t) && TYPE(t) == DOUBLE)
return 1;
if(ATOMIC(t))
return 0;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(contains_double2(ARG(i,t)))
return 1;
}
return 0;
}
/*________________________________________________________________*/
#define BIGEXPONENT 20
int contains_big_exponents(term t)
/* return 1 if t contains a numerical power (base^ exponent) with
integer exponent > BIGEXPONENT, and numerical base containing no
doubles, or base which contains a sum. Return 0 otherwise.
*/
{ unsigned short n,i;
term base,power;
if(ATOMIC(t))
return 0;
if(FUNCTOR(t) == '^' && INTEGERP(ARG(1,t)))
{ base = ARG(0,t);
power = ARG(1,t);
if(ISATOM(base))
return 0;
if(ISINTEGER(power) && INTDATA(power) <= BIGEXPONENT)
return 0;
if(contains(base,'+'))
return 1;
if(INTEGERP(base))
return 1;
if(numerical(base) && !contains_double2(base))
return 1;
}
n = ARITY(t);
for(i=0;i<n;i++)
{ if(contains_big_exponents(ARG(i,t)))
return 1;
}
return 0;
}
/*___________________________________________________________________*/
static void mark_big_exponents(term *t)
/* mark subterms of the form integer^integer with exponent > BIGEXPONENT
as ALREADY */
{ unsigned short n,i;
if(ATOMIC(*t))
return;
if(FUNCTOR(*t) == '^' && INTEGERP(ARG(0,*t)) && INTEGERP(ARG(1,*t)))
{ if(TYPE(ARG(1,*t)) == BIGNUM ||
(ISINTEGER(ARG(1,*t)) && INTDATA(ARG(1,*t)) > BIGEXPONENT)
)
SET_ALREADY(*t);
return;
}
n = ARITY(*t);
for(i=0;i<n;i++)
mark_big_exponents(ARGPTR(*t) + i);
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists