Sindbad~EG File Manager
/* pre-associated operations for products
M. Beeson, for Mathpert
Original date 1.7.91
modified 1.23.98
1.13.00 added call to stop_orderfactors
6.22.04 added contains_special_exponential
*/
#define AUTOMODE_DLL
#include <assert.h>
#include <string.h>
#include "globals.h"
#include "checkarg.h" /* for operator typedef */
#include "ops.h" /* for prototypes of operators */
#include "operator.h"
#include "trig.h"
#include "calc.h"
#include "prover.h"
#include "polynoms.h"
#include "probtype.h"
#include "exec.h"
#include "algaux.h"
#include "order.h"
#include "graphstr.h"
#include "display.h"
#include "document.h"
#include "automode.h"
#include "eqn.h"
#include "symbols.h" /* radicalflag */
#include "autosimp.h" /* get_path, get_pathlength */
#include "automode.h" /* pulloutrational_aux */
#include "orderops.h" /* no_complicated_factors */
#include "cflags.h" /* get_currenttopic */
#include "tdefn.h" /* topic identifiers */
#include "preprod.h" /* special_dif_of_squares */
#include "complex.h" /* is_polar_complex */
#include "simpprod.h" /* expandable */
#include "cancel.h" /* naive_gcd */
#include "pvalaux.h" /* isinteger */
#include "surdsimp.h" /* canonical */
#include "deval.h"
#include "preops.h" /* stop_orderfactors */
static int trigproduct(term t);
static int contains_rest(term t, unsigned short f);
static int stop_evalpower(term t);
/*_____________________________________________________________*/
static int contains_special_exponential(term u)
/* Return 1 if one of the args of u is of the form e^(c/nonconstant) */
{ int n = ARITY(u);
int i;
if(ATOMIC(u))
return 0;
if(FUNCTOR(u) == '^' && equals(ARG(0,u),eulere) &&
FRACTION(ARG(1,u)) && !constant(ARG(1,ARG(1,u)))
)
return 1;
if(FUNCTOR(u) != '+' && FUNCTOR(u) != '*')
return 0;
for(i=0;i<n;i++)
{ if(contains_special_exponential(ARG(i,u)))
return 1;
}
return 0;
}
/*_____________________________________________________________*/
void pre_product(term t, actualop *o, int *nops)
/* do the work of pre_ops on products t */
{ int zeroflag,numberflag,productflag,minusflag,fractionflag,rationalflag,
sqrtflag,rootflag,symbolflag,negpowerflag,powerflag,vectorflag,
distribflag,cosflag,sinflag,sumpowerflag,sumflag,powersumflag;
aflag arithflag = get_arithflag();
unsigned i=0;
unsigned j,m;
const int intflag = get_intflag();
int topic = get_currenttopic();
term u;
int pathlength = get_pathlength();
unsigned short const *path = get_path();
int topflag = (pathlength == 0 || (pathlength == 2 && path[0] == '-'));
unsigned short n = ARITY(t);
unsigned short g;
double z;
long kk;
int radicalflag = get_radicalflag();
zeroflag=numberflag=productflag=minusflag=fractionflag=rationalflag=
sqrtflag=rootflag=symbolflag=negpowerflag=powerflag=sumflag=
vectorflag=distribflag=cosflag = sinflag = sumpowerflag = powersumflag = 0;
for(j=0;j<n;j++)
{ u = ARG(j,t);
g = FUNCTOR(u);
if (ZERO(u))
zeroflag = 1;
else if (INTEGERP(u) || RATIONALP(u) ||
(OBJECT(u) && TYPE(u)==DOUBLE) ||
(get_complex() && equals(u,complexi))
)
++numberflag;
else if(!numerical(u))
++symbolflag;
if(fractionflag && (g == INTEGRAL || g == DIFF || g == SUM || g == PRODUCT))
--fractionflag;
/* this way (1/2) integral(... won't get multiplied out. */
if(g == '+')
{ if(contains(u,INTEGRAL))
distribflag = 1;
if(contains_special_exponential(u))
distribflag = 1;
++sumflag;
}
if(g == SIN && !seminumerical(ARG(0,u)))
++sinflag;
/* sinflag and cosflag are used to control
trig product operations, which we don't want
to use e.g. on sin(pi) sin(x); instead we want
the sin(pi) to be evaluated. Hence the
!seminumerical condition just above and below. */
else if(g == COS && !seminumerical(ARG(0,u)))
++cosflag;
if(g == ROOT)
++rootflag;
if(g==SQRT || g=='^')
{ ++sqrtflag;
if(g == '^' && NEGATIVE(ARG(1,u)) &&
(!equals(ARG(0,u),eulere) || get_polyvalnegexpflag() == -1)
)
++negpowerflag;
/* we don't want to eliminate neg exps in e^-x
unless polyvalnegexpflag says we have to eliminate
ALL negative exponents. Of course, in a product
like x^(-2) e^(-x) it's going to go anyway. */
if(g == '^' && NEGATIVE(ARG(0,u)) && ONE(ARG(0,ARG(0,u))))
++powerflag; /* used to control powerofminusone only */
if(g == '^' && FUNCTOR(ARG(1,u)) == '+' && numerical(ARG(1,u)))
++sumpowerflag;
}
else if (g == '/')
{ /* count rational numbers and all fractions separately */
if(RATIONALP(u))
++rationalflag;
if(INTEGERP(ARG(1,u)) && canonical(0,u))
++rationalflag; /* treat 3 sqrt(5)/2 the same as a rational,
i.e. pull it out of a symbolic term */
++fractionflag;
}
else if (g == '-')
{ minusflag = 1;
if(FUNCTOR(ARG(0,ARG(j,t)))=='*')
productflag = 1;
}
else if (g == '*')
productflag = 1;
else if (g == '+' && FUNCTOR(ARG(0,ARG(j,t))) == '-')
minusflag = 1; /* as in 2(-a-b) */
else if (g == VECTOR || g == MATRIX)
vectorflag = 1;
if(g == '^' &&
FUNCTOR(ARG(0,u)) == '+' &&
INTEGERP(ARG(1,u)) &&
ARITY(ARG(0,u)) == 2 &&
(contains(ARG(0,u),COS) || contains(ARG(0,u),SIN))
)
++powersumflag;
}
if((sqrtflag || rootflag) && numberflag && !sumflag && limitflag &&
status(polyvalop) > LEARNING
)
/* example, 2 sqrt((x^2-4)/4) inside a limit; polyvalop was not
called at toplevel because it's inside a limit. */
{ o[i] = polyvalop; ++i;
}
if(sumflag == 2 && n == 2 && ARITY(ARG(0,t)) == 2 && ARITY(ARG(1,t)) == 3 && limitflag)
/* after rationalizing num or denom in a limit, get on with
simplifying the result. */
{ o[i] = makedifofcubes; ++i;
o[i] = makesumofcubes; ++i;
}
if(sumpowerflag)
{ o[i] = cleanupexponents; ++i; /* 3^3 2^(2+3) needs to have 2+3 become 5 */
/* but don't return here because the exponent might be unevaluable,
e.g. 3^3 2^(1+sqrt 3)
*/
}
if(powersumflag > 1)
{ o[i] = makesinpower; ++i;
o[i] = makecospower; ++i;
}
if(distribflag)
{ o[i] = distriblaw; ++i;
/* in ... + (1/2) (....+ ....), multiply out the 1/2 before
working out the ...'s on the right, which may for example be
complicated integrals. */
}
if(zeroflag)
{ o[i] = multbyzero; ++i;
}
if(numberflag)
{ o[i] = multbyone; ++i;
}
if(powerflag)
{ o[i] = intpowerofminusone; ++i;
o[i] = powerofminusone; ++i;
}
if(fractionflag > 0)
{ o[i] = recip; ++i; /* use a(1/a) = 1 instead of 'cancel a' */
o[i] = cancelop; ++i; /* before arithmetic */
}
/* (3/2) (4/9) = (1/2)(4/3) = 2/3 instead of =12/18 = 2/3 */
if(
(arithflag.negexp || numberflag + symbolflag == (int) n) &&
!stop_evalpower(t)
)
{ o[i] = arithmetic; ++i;
if(get_complex() && arithflag.complex)
{ o[i] = weakcomplexarithmetic; ++i;
}
}
else if(!arithflag.negexp && numberflag > 1)
/* example where needed: 4�5�6^(-1) �25
in which we only want 4�5 = 20 done
*/
{ o[i] = weakarithmetic; ++i;
}
if(minusflag)
{ o[i] = bringminusout3; ++i;
o[i] = bringminusout2; ++i;
o[i] = bringminusout; ++i;
}
if( sqrtflag > 1 && rootflag == 0 && radicalflag == -2 && intflag)
/* e.g. sqrt(x-1) sqrt(x-1) in an integrand => sqrt((x-1)^2) */
{ o[i] = productofsqrts; ++i;
}
if( (sqrt_exp_aux(t) && radicalflag < 0)
/* at least two roots have a common factor, so they will collect */
||
(sqrtflag && symbolflag && radicalflag == -2
&& (difflag || intflag)
/* after the differentiation or integration
is done, there's no harm in x�x */
)
)
/* there is a possibility of collecting fractional powers */
/* in calculus, radicalflag will be -2, so sqrtexp will
get used, but only on products */
{ o[i] = sqrtexp; ++i;
}
if(productflag)
{ o[i] = regroupfactors; ++i;
}
if(topflag && ARITY(t) == 2)
{ o[i] = quotientofsqrts; ++i;
o[i] = quotientofroots; ++i;
}
/* see polyval.c, search for RATRING, for comments on the next clause */
if( ( fractionflag &&
! (rationalflag == 1 && fractionflag == 1
&& (get_ringflag() & RATRING)
&& !get_infractionflag()
) &&
!(n == 2 && RATIONALP(ARG(0,t)) && FRACTION(ARG(1,t)) &&
pulloutrational_aux(product(ARG(0,ARG(0,t)),ARG(0,ARG(1,t))),product(ARG(1,ARG(0,t)),ARG(1,ARG(1,t))))
) && /* example: (1/6)(sqrt(2)/sqrt(3)). Don't loop with
pulloutrational */
/* Leave sqrt(3)/2 * f alone if f doesn't contain fractions, except
in a sum with comdenomflag on. See below for the 'in a sum' code */
!(
(get_ringflag() & RATRING) &&
FRACTION(ARG(0,t)) && INTEGERP(ARG(1,ARG(0,t))) &&
(FUNCTOR(ARG(0,ARG(0,t))) == SQRT && INTEGERP(ARG(0,ARG(0,ARG(0,t))))) &&
!contains_rest(t,'/')
) &&
(get_problemtype() != LINEAR_EQUATIONS || constant(t)) &&
/* when (sqrt 2 / sqrt 3) x occurs in a linear system,
don't multiply it out */
!(topic == _polar_form && is_polar_complex(t))
/* don't convert (1/sqrt 2) e^it to e^it/sqrt 2 */
)
||
(n == 2 && RATIONALP(ARG(0,t)) &&
(
(FUNCTOR(ARG(1,t)) == SQRT && INTEGERP(ARG(0,ARG(1,t)))) ||
(FUNCTOR(ARG(1,t)) == ROOT && INTEGERP(ARG(1,ARG(1,t)))) ||
equals(ARG(1,t),pi) ||
equals(ARG(1,t),eulere)
)
)
||
( fractionflag &&
pathlength >= 2 && path[pathlength-2] == '+' && get_comdenomflag())
/* following code prepares e.g. (sqrt(3)/2) sin x + (1/) cos x
for using common denoms. */
||
( fractionflag &&
pathlength >= 4 && path[pathlength-4] == '+' &&
path[pathlength-2] == '-' && get_comdenomflag()
)
)
{ o[i] = multiplyfractions; ++i;
}
if( numberflag > 1 && (arithflag.negexp || numberflag + symbolflag == (int) n))
/* no unevaluated numerical factors */
{ o[i] = collectnumbers; ++i;
}
if(!vectorflag)
/* don't collect powers of matrices; user can use A = IA repeatedly
and generate a product of several I's, but don't collect them
automatically. */
{ o[i] = collectpowers; ++i;
}
/* don't require presence of '^' as must be
able to collect in xyx, for example */
if( negpowerflag
&& (get_polyvalnegexpflag() == -1 ||
(!get_infractionflag() && get_polyvalnegexpflag() <= 0) ||
/* because it looks silly to leave
x^(-3) sin x + cos(x)/x^2 alone */
( limfractflag == -1 /* in a fraction in a limit */
&& (
(pathlength >= 2 && path[pathlength-2] == '+') ||
(pathlength >= 4 && path[pathlength-4] == '+' && path[pathlength-2] == '-')
)
/* e.g. lim(h->0,(c(3+h)^-1 - 3^-1)/h) */
)
)
&& !difflag && !intflag /* but leave neg exponents when doing calculus */
&& !contains(t,DIFF) && !contains(t,INTEGRAL) && !contains(t,LIMIT)
)
{ o[i] = eliminatenegexp; ++i;
}
if(!vectorflag && topic != _numerical_exponents)
/* when working problems like 2^(2^2)3^3 81 it's annoying to see
the order of factors change, since it's all going to work out to a number anyway.
*/
{ /* We must try to avoid useless "order factors" steps. For example,
if the product is in a sum that's going to be expanded anyway, we
need not order the factors. The following code doesn't prevent
ordering factors in products which are NOT expandable, even if
other terms in the sum containing the product are expandable, because
from here we can't examine the other summands. */
if( expandable(t) &&
(
(pathlength >= 2 && path[pathlength-2] == '+') ||
(pathlength >= 4 && path[pathlength-4] == '+' && path[pathlength-2] == '-')
)
)
; /* do nothing */
else if(pathlength >= 2 && path[pathlength-2] == INTEGRAL)
; /* do nothing; no point ordering factors of an integrand. */
else if(!ORDERED(t) && no_complicated_factors(t) && !stop_orderfactors(t))
{ o[i] = orderfactors; ++i;
}
else if(!ORDERED(t) && !stop_orderfactors(t))
{ o[i] = ordersimplefactors; ++i;
}
}
if(pathlength >= 2 && path[pathlength-2] == INTEGRAL &&
sinflag + cosflag == n && trigproduct(t)
)
/* sin t cos(2t) is integrated by using a product formula. But
sin t cos(2t)/cos t is better done by expanding cos(2t).
Therefore we only use product formulas on the whole integrand,
rather than the former 'intflag && !indenomflag' condition
*/
{ if(cosflag >= 2)
{ o[i] = coscos; ++i;
}
else if(sinflag >= 2)
{ o[i] = sinsin; ++i;
}
else
{ o[i] = cossin; ++i;
o[i] = sincos; ++i;
}
}
/* But even if not in an integral, we want to use coscos etc
on examples like cos(x-pi/6) cos(x + pi/6) where the sum or
difference of the args is constant. Also on sin(deg(15)) sin(deg(45)),
because if we don't use it in preops, sin(deg(45)) will get evaluated
before we get to postops on the product. */
if(sinflag || cosflag)
{ term arg = zero;
unsigned short a,b;
term temp;
for(j=0;j<n;j++)
{ u = ARG(j,t);
if(FUNCTOR(u) != SIN && FUNCTOR(u) != COS)
continue;
if(FUNCTOR(ARG(0,u)) != '+' && !numerical(ARG(0,u)))
continue;
if(ZERO(arg))
{ arg = ARG(0,u);
a = FUNCTOR(u);
}
else /* check that sum or difference of arg and ARG(0,u) is constant */
{ for(m = 0;m < 2;m++)
{ polyval(sum(arg, m ? strongnegate(ARG(0,u)) : ARG(0,u)),&temp);
if(constant(temp))
{ b = FUNCTOR(u);
if(!constant(arg))
break;
else if(FUNCTOR(temp) == DEG)
{ deval(ARG(0,temp),&z);
if(z != BADVAL && nearint(z/15.0,&kk))
break;
}
else
{ deval(temp,&z);
if(z != BADVAL && nearint(12.0*z/PI_DECIMAL,&kk))
break;
}
}
}
if(m < 2)
break;
}
}
if(j < n)
{ if(a != b)
{ o[i] = cossin; ++i;
o[i] = sincos; ++i;
}
else if(a==SIN && b==SIN)
{ o[i] = sinsin; ++i;
}
else if(a==COS && b==COS)
{ o[i] = coscos; ++i;
}
}
}
if(sumflag > 1 && special_difofsquares(t))
{ /* always multiply out (a-sqrt b)(a+sqrt b) if b is not
seminumerical or if the whole thing is seminumerical */
o[i] = difofsquares; ++i;
}
*nops = i;
}
/*_________________________________________________________________*/
static int trigproduct(term t)
/* return 1 if t is a product of trig functions with different
arguments */
{ unsigned n,i,f;
int count=1;
term u,x;
if(FUNCTOR(t) != '*')
return 0;
n = ARITY(t);
for(i=0;i<n;i++)
{ u = ARG(i,t);
f = FUNCTOR(u);
if(!TRIGFUNCTOR(f))
return 0;
if(i==0)
x = ARG(0,u);
else if(!equals(x,ARG(0,u)))
++count;
}
if(count > 1)
return 1;
return 0;
}
/*_____________________________________________________________________*/
int special_difofsquares(term t)
/* t is a product. Return 1 if t contains two
factors (a-c sqrt b) and (a+ c sqrt b) where b is
not seminumerical (or the whole term t is seminumerical).
Also, if t is a product of fractions, and the two
factors mentioned are in the denoms of the two fractions,
return 1.
Otherwise return 0.
As written, it would fail on (c-sqrt d)(a-sqrt b)(a+sqrt b)
but it will be centuries before this comes up to bother us.
*/
{ unsigned short n = ARITY(t);
unsigned short f;
int i,count=0;
unsigned short fractcount,k;
term u,v,w,a,b,temp,p;
int swapflag = 0;
if(FUNCTOR(t) != '*')
return 1;
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u) != '+' || ARITY(u) > 2)
continue;
v = ARG(1,u);
w = ARG(0,u);
if(contains_sqrt(w) == SQRT && contains_sqrt(v) != SQRT)
{ temp = w;
w = v;
v = temp;
swapflag = 1;
}
f = NEGATIVE(v) ? contains_sqrt(ARG(0,v)) : contains_sqrt(v);
if(f != SQRT || (!seminumerical(t) && seminumerical(v)))
continue;
if(count == 0)
{ a = w;
b = v;
++count;
}
else if(equals(a,swapflag ? tnegate(w) : w) && equals(b,swapflag ? v : tnegate(v)))
return 1;
}
fractcount = 0;
for(i=0;i<n;i++)
{ if(SIGNEDFRACTION(ARG(i,t)))
++fractcount;
}
if(fractcount >= 2)
{ temp = make_term('*',fractcount);
k = 0;
for(i=0;i<n;i++)
{ if(SIGNEDFRACTION(ARG(i,t)))
{ p = ARG(i,t);
if(NEGATIVE(p))
p = ARG(0,p);
ARGREP(temp,k, ARG(1,p)); /* the denominator */
++k;
}
}
if(special_difofsquares(temp))
{ RELEASE(temp);
return 1;
}
RELEASE(temp);
}
return 0;
}
/*___________________________________________________________________*/
static int contains_rest(term t, unsigned short f)
/* return 1 if some arg of t other than the first has functor f.
Return 0 if not. */
{ unsigned short n;
int i;
if(ATOMIC(t))
return FUNCTOR(t) == f;
n = ARITY(t);
for(i=1;i<n;i++)
{ if(FUNCTOR(ARG(i,t)) == f)
return 1;
}
return 0;
}
/*_______________________________________________________________________*/
int sqrt_exp_aux(term t)
/* t is a product; should we convert sqrt to fractional exponents in it?
Only if some collecting of fractional exponents can take place. For this
there must be two roots with factors in common under the root. Return 1
if this is the case, 0 if not.
*/
{ unsigned short n;
int i,j;
term u,v,a,b,temp;
if(FUNCTOR(t) != '*')
return 0;
n = ARITY(t);
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u) != SQRT && FUNCTOR(u) != ROOT)
continue;
for(j=i+1;j<n;j++)
{ v = ARG(j,t);
if(FUNCTOR(v) != SQRT && FUNCTOR(v) != ROOT)
continue;
a = FUNCTOR(u) == SQRT ? ARG(0,u) : ARG(1,u);
b = FUNCTOR(v) == SQRT ? ARG(0,v) : ARG(1,v);
if(FUNCTOR(a) != '*' && FUNCTOR(b) != '*')
return equals(a,b) ? 1 : 0;
if(!common_variables(a,b))
return 0;
naive_gcd(a,b,&temp);
return seminumerical(temp) ? 0 : 1;
}
}
return 0;
}
/*_______________________________________________________________*/
static int stop_evalpower(term t)
/* If t is a term of the form a a^n, or a^n a^m, where
n or m is an integer more than BIGEXPONENT (at the time of writing, 20),
then return 1, so that arithmetic won't be used on such terms.
*/
{ term u,v;
if(FUNCTOR(t) != '*' || ARITY(t) > 2)
return 0;
u = ARG(0,t);
v = ARG(1,t);
if(FUNCTOR(u) == '^' && FUNCTOR(v) == '^' && equals(ARG(0,u),ARG(0,v)))
return 1;
if(FUNCTOR(u) == '^' && equals(ARG(0,u),v))
return 1;
if(FUNCTOR(v) == '^' && equals(ARG(0,v),u))
return 1;
return contains_big_exponents(t);
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists