Sindbad~EG File Manager
/* operators from square_roots menu, plus factorunderroot */
/*
M. Beeson, for MathXpert
12.24.90 Original date
11.12.98 last modified
6.13.04 Modified sqrtofproduct for complex arguments.
2.9.05 modified includes
3.25.06 modified es_aux and code that calls it to eliminate dependence on path_to_color, which
is in ShowStepFocus. This improves modularity and in particular is helpful in compiling Otter-lambda on Unix.
*/
#define ALGEBRA_DLL
#include <string.h>
#include <assert.h>
char *ltoa(long, char *, int);
#include "globals.h"
#include "ops.h"
#include "probtype.h"
#include "order.h"
#include "cancel.h"
#include "prover.h"
#include "algaux.h"
#include "checkarg.h"
#include "graphstr.h"
#include "document.h"
#include "automode.h" /* set_locus */
#include "radsimp.h" /* radsimpaux */
#include "getprob.h"
#include "factor.h" /* sqrt_aux */
#include "mplimits.h" /* rationalize_ok */
#include "sqrts.h" /* grf_aux */
#include "calc.h" /* polyvalop */
#include "symbols.h"
#include "sqrtfrac.h" /* cancel_sqrts */
#include "errbuf.h"
#include "pvalaux.h" /* obviously_nonnegative */
#include "autosimp.h" /* set_pathtail etc */
#include "trig.h" /* factorbase */
#include "simpprod.h" /* square */
#include "nfactor.h" /* factor_integer */
#include "deval.h" /* seminumerical */
static int get_rationalizing_factor(term,term *);
static int fs_aux(long, term, term *);
static int merge(term *a, int na, term *b, int nb, term *ans, int nans);
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int productofsqrts(term t, term arg, term *next, char *reason)
/* �x�y = �(xy) */
/* If you change this, change productofsqrts2 in lcm.c also */
{ int i,j,err;
unsigned short mark,k;
int flattenflag = 0; /* set if one of the terms under a sqrt is a product */
term temp,rest,x,y;
char tempbuf[128];
unsigned short n;
if(FUNCTOR(t) != '*')
return 1;
n = ARITY(t);
mark = 0;
/* find the first sqrt among the factors of t */
tryagain:
while( mark < n && FUNCTOR(ARG(mark,t)) != SQRT)
++mark;
if(mark == n)
return 1; /* no sqrts, operator inapplicable */
if(mark == n-1)
return 1; /* only last arg is a sqrt, operator inapplicable */
if(mark == n-2 && FUNCTOR(ARG(n-1,t)) != SQRT)
return 1;
x = ARG(0,ARG(mark,t));
/* If there aren't two square roots, fail before calling 'check' */
for(i=mark+1;i<n;i++)
{ if(FUNCTOR(ARG(i,t)) == SQRT)
break;
}
if(i==n)
return 1;
err = check(le(zero,x));
if(FUNCTOR(x) == '*')
flattenflag = 1;
if(err)
{ char temp[128];
strcpy(temp, english(613)); /* $�x�y = �(xy)$ */
strcat(temp, english(614)); /* requires $x�0$ and $y�0$" */
errbuf(0,temp);
if(mark < n-2)
{ ++mark;
goto tryagain; /* deal with e.g. �(-1) �3�4 */
}
return 1;
}
/* Now go through the rest of the args of t,
collect all the positive square roots, and make one square root out of it */
if(mark == n-2 && n>2) /* and last arg IS a sqrt */
{ *next = make_term('*',(unsigned short)(n-1));
for(i=0;i<n-2;i++)
ARGREP(*next,i,ARG(i,t));
y = ARG(0,ARG(n-1,t));
err = check(le(zero,y));
if(err)
{ strcpy(tempbuf, english(613)); /* $�x�y = �(xy)$ */
strcat(tempbuf, english(614));
errbuf(0,tempbuf);
return 1;
}
if(FUNCTOR(y) == '*')
flattenflag = 1;
temp = product(ARG(0,ARG(n-2,t)),y);
if(status(productofsqrts) > LEARNING && FUNCTOR(temp) == '*')
sortargs(temp);
ARGREP(*next,n-2,make_sqrt(flattenflag ? topflatten(temp) : temp));
HIGHLIGHT(ARG(n-2,*next));
strcpy(reason, "$�x�y = �(xy)$");
return 0;
}
if(n==2)
{ y = ARG(0,ARG(1,t));
err = check(le(zero,y));
if(err)
{ strcpy(tempbuf, english(613)); /* �x�y = �(xy) */
strcat(tempbuf, english(614));
errbuf(0,tempbuf);
return 1;
}
temp = product(ARG(0,ARG(0,t)),y);
if(status(productofsqrts) > LEARNING && FUNCTOR(temp) == '*')
sortargs(temp);
*next = make_sqrt(flattenflag ? topflatten(temp) : temp);
HIGHLIGHT(*next);
strcpy(reason, "$�x�y = �(xy)$");
return 0;
}
/* Now n > 2 and there are at least two more args after the first sqrt */
temp = make_term('*',(unsigned short)(n-mark)); /* the product to go under � */
rest = make_term('*',n); /* the non-sqrts */
for(i=0;i<mark;i++)
ARGREP(rest,i,ARG(i,t));
k=0;
j=mark;
for(i=mark;i<n;i++)
{ if(FUNCTOR(ARG(i,t)) == SQRT)
{ y = ARG(0,ARG(i,t));
err = check(le(zero,y));
if(!err)
{ ARGREP(temp,k,y);
++k;
if(FUNCTOR(y) == '*')
flattenflag = 1;
}
else
{ ARGREP(rest,j,ARG(i,t));
++j;
strcpy(tempbuf,english(613)); /* �x�y = �(xy) */
strcat(tempbuf, english(614)); /* requires x�0 and y�0" */
errbuf(0,tempbuf);
/* but don't fail yet, because there might still be
two or more positive square roots to combine */
}
}
else
{ ARGREP(rest,j,ARG(i,t));
++j;
}
}
if(k==1) /* only one sqrt */
{ RELEASE(temp);
RELEASE(rest);
return 1;
}
if(k==n) /* all factors were sqrts */
{ if(status(productofsqrts) > LEARNING && FUNCTOR(temp) == '*')
sortargs(temp);
*next = make_sqrt(temp);
RELEASE(rest);
strcpy(reason, "$�x�y = �(xy)$");
HIGHLIGHT(*next);
return 0;
}
*next = make_term('*',(unsigned short)(n-k+1));
SETFUNCTOR(temp,'*',k);
if(status(productofsqrts) > LEARNING && FUNCTOR(temp) == '*')
sortargs(temp);
if(flattenflag)
temp = topflatten(temp);
for(i=0;i<mark;i++)
ARGREP(*next,i,ARG(i,t));
ARGREP(*next,mark,make_sqrt(temp));
HIGHLIGHT(ARG(mark,*next));
for(i=mark+1;i<n-k+1;i++)
ARGREP(*next,i,ARG(i-1,rest));
RELEASE(rest); /* but don't RELEASE(temp), temp has been used! */
strcpy(reason, "$�x�y = �(xy)$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int sqrtofproduct(term t, term arg, term *next, char *reason)
/* sqrt(ab) = sqrt a sqrt b */
/* If you change this, change sqrtofproduct2 in lcm.c also */
/* In case of complex numbers, fails if there are two or more complex factors
under the square root, rather than try to check the correct condition. */
{ int i,err,count;
unsigned short n;
term u,x;
if (FUNCTOR(t) != SQRT)
return 1;
if (FUNCTOR(ARG(0,t)) != '*')
return 1;
u = ARG(0,t);
n = ARITY(u);
*next = make_term('*',n);
count = 0;
for(i=0;i<n;i++)
{ x = ARG(i,u);
if(get_complex())
err = is_complex(x);
else
err = check(le(zero,x));
if(err && (!get_complex() || count == 1))
{ char temp[128];
strcpy(temp,english(882)); /* $�(ab) = �a�b$ */
strcat(temp,english(881));
/* requires a>=0 and b>=0 */
errbuf(0,temp);
RELEASE(*next);
return 1;
}
++count;
ARGREP(*next,i,make_sqrt(x));
}
HIGHLIGHT(*next);
strcpy(reason,"$�(ab) = �a�b$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int sqrtsimp(term t, term arg, term *next, char *reason)
/* sqrt(a^2b) = a sqrt b if a >= 0 (even if b is complex this is OK */
/* examples: sqrt(2^2 sqrt 3) = 2 sqrt 3 in one step.
sqrt(2^3 sqrt 3) = 2 sqrt (2*3), not 2 sqrt 6,
unless this operator is wellknown, in which case
it WILL go all the way to 2 sqrt 6
When this operator is wellknown, it will also work when t is an integer,
first factoring t (internally)
*/
{ int err;
term out,in,temp,u,mid;
unsigned nfactors;
if(FUNCTOR(t) != SQRT)
return 1;
u = ARG(0,t);
if(ISINTEGER(u) && get_mathmode() == MENUMODE || status(sqrtsimp) == WELLKNOWN)
{ err = factor_integer(u,&nfactors,&mid);
if(! err)
return sqrtsimp(make_sqrt(mid),arg,next,reason);
}
err = radsimpaux(two,u,&out,&in);
if(err)
return 1;
if(ONE(in))
{ temp = out;
if(FUNCTOR(out)==ABS)
strcpy(reason,english(1130)); /* sqrt(a^2)=|a| */
else
strcpy(reason, english(883)); /* sqrt(a^2)=a if a >= 0 */
}
else
{ temp = product(out, make_sqrt(in));
if(FUNCTOR(out)==ABS)
strcpy(reason, english(1129)); /* sqrt (a^2 b)=|a| sqrt b */
else
strcpy(reason, english(884)); /* sqr (a^2 b)=a sqrt b if a >= 0 */
}
if(status(sqrtsimp)==WELLKNOWN)
err = value(temp,next);
else
err = 1;
if(err)
*next = temp;
HIGHLIGHT(*next);
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int powerofsqrt(term t, term arg, term *next, char *reason)
/* (sqrt a)^2n = a^n if a>=0 */
{ term u,n,q,cancelled;
int err;
if(FUNCTOR(t) != '^')
return 1;
if(FUNCTOR(ARG(0,t)) != SQRT)
return 1;
u = ARG(0,ARG(0,t));
n = ARG(1,t); /* so t = (sqrt u)^n */
err = check(le(zero,u));
if(err)
return 1;
if(OBJECT(n) && TYPE(n) == INTEGER && INTDATA(n) == 2)
/* so t = (sqrt u)^2 */
{ *next = u;
HIGHLIGHT(*next);
strcpy(reason, english(883)); /* (sqrt a)^2=a if a>=0 */
return 0;
}
strcpy(reason, english(886)); /* (sqrt a)^2n = a^n if a>=0 */
/* Now compute n/2 */
err = cancel(n,two,&cancelled,&q);
if(err)
return 1;
*next = make_power(u,q);
HIGHLIGHT(*next);
release(factorsquareofsum); /* possibly inhibited by squareofsum */
release(factorsquareofdif);
release(factorquadratic);
release(sqrtofquotient); /* possibly inhibited by powereqn */
release(polyvalop); /* possibly inhibited by rationalizedenom */
release(cancelop); /* possibly inhibited by rationalizedenom */
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int powerofsqrt2(term t, term arg, term *next, char *reason)
/* sqrt(x)^(2n+1) = x^n sqrt x*/
{ term u,n,q,cancelled,nminusone;
int err;
if(FUNCTOR(t) != '^')
return 1;
if(FUNCTOR(ARG(0,t)) != SQRT)
return 1;
u = ARG(0,ARG(0,t));
n = ARG(1,t); /* so t = (�u)� */
strcpy(reason, english(886)); /* (�a)^2� = a� if a�0 */
/* Now compute (n-1)/2 */
if(iseven(n))
return 1;
if(ISINTEGER(n))
nminusone = make_int(INTDATA(n)-1);
else if(isodd(n))
polyval(sum(n,minusone),&nminusone);
else
return 1;
err = cancel(nminusone,two,&cancelled,&q);
if(!err && isinteger(q))
{ *next = product(make_power(u,q),make_sqrt(u));
HIGHLIGHT(*next);
release(factorsquareofsum); /* possibly inhibited by squareofsum */
release(factorsquareofdif);
release(factorquadratic);
release(sqrtofquotient); /* possibly inhibited by powereqn */
release(polyvalop); /* possibly inhibited by rationalizedenom */
release(cancelop); /* possibly inhibited by rationalizedenom */
return 0;
}
return 1; /* failure */
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int sqrtofsquare(term t, term arg, term *next, char *reason)
/* sqrt(a^2)=a if a>=0 */
{ term u,n;
int err;
if(FUNCTOR(t) != SQRT)
return 1;
u = ARG(0,t);
if(ONE(u))
{ *next = one;
HIGHLIGHT(*next);
strcpy(reason,"$�1 = 1$");
return 0;
}
if(OBJECT(u))
{ err = value(make_power(u,make_fraction(one,two)),next);
if(err)
return 1;
HIGHLIGHT(*next);
err = infer(nonnegative(*next));
if(err)
return 1;
strcpy(reason, english(883)); /* �(a^2)=a if a�0 */
return 0;
}
if(FUNCTOR(u) != '^')
return 1;
n = ARG(1,u);
if(! (OBJECT(n) && TYPE(n) == INTEGER && INTDATA(n)==2) )
return 1;
err = check(nonnegative(ARG(0,u)));
if(err)
return 1;
*next = ARG(0,u);
HIGHLIGHT(*next);
strcpy(reason, english(883)); /* �(a^2)=a if a�0 */
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int sqrtofpower2(term t, term arg, term *next, char *reason)
/* sqrt(a^(2n+1)) = a^n sqrt(a) if a^n >= 0 */
/* This shows on the term selection menu only if the exponent
under the sqrt is odd. */
{ return sqrtofpower(t,arg,next,reason);
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int sqrtofpower(term t, term arg, term *next, char *reason)
/* sqrt(a^2n) = a^n if a^n >= 0 */
{ term u,n,m,cancelled,x;
int err;
if(FUNCTOR(t) != SQRT)
return 1;
u = ARG(0,t);
if(ONE(u))
{ *next = one;
HIGHLIGHT(*next);
strcpy(reason,"$�1 = 1$");
return 0;
}
if(FUNCTOR(u) != '^')
return 1;
n = ARG(1,u);
x = ARG(0,u);
if(FUNCTOR(u) != '^')
return 1;
n = ARG(1,u);
x = ARG(0,u);
if(ISINTEGER(n) && EVEN(n))
{ value(make_fraction(n,two),&m);
err = 0;
}
else
err = cancel(n,two,&cancelled,&m); /* n = 2m */
if(!err) /* �(x^2�) = x� */
{ *next = make_power(x,m);
check(nonnegative(*next));
HIGHLIGHT(*next);
strcpy(reason, english(2158));
/* $�(a^2�)=a�$ if $a��0$ */
return 0;
}
else /* exponent isn't divisible by 2 */
{ if(ISINTEGER(n) && ODD(n)) /* �(x^(2n+1) = x��x */
{ value(make_fraction(sum(n,tnegate(one)),two),&m);
*next = product(make_power(x,m),make_sqrt(x));
HIGHLIGHT(*next);
strcpy(reason, english(887)); /* �(a^(2n+1)) = a��a */
SetShowStepOperation(sqrtofpower2);
return 0;
}
}
return 1;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int sqrttoabs(term t, term arg, term *next, char *reason)
/* sqrt (a^2)= |a|
or = a if a >=0 can be inferred. Note that
sqrtofpower calls 'check' on a >= 0, so THIS operator is
called first in automode, so that sqrt(x^2) => |x| rather than
=> x (generating an assumption x >= 0). But then
sqrt(2^100) => |2|^50 instead of 2^50; therefore this operator
must try to infer a >= 0. */
/* Should not be called either in automode or from term selection
when get_complex(), unless argument is seminumerical */
{ term a,u,n,q,cancelled,absa;
int err,flag;
if(FUNCTOR(t) != SQRT)
return 1;
if(get_complex() && !seminumerical(t))
return 1; /* should never be called this way anyway */
u = ARG(0,t);
if(FUNCTOR(u) != '^')
return 1;
a = ARG(0,u);
n = ARG(1,u);
flag = infer(le(zero,a));
absa = flag ? absolute(a) : a;
if( OBJECT(n) && INTDATA(n) == 2)
{ *next = absa;
HIGHLIGHT(*next);
strcpy(reason,flag ? english(888) : english(889));
/* sqrt(a^2)= |a| or sqrt(a)= a if a>=0 */
return 0;
}
else if (ISINTEGER(n) && EVEN(n))
{ err = 0;
value(make_fraction(n,two),&q);
}
else
err = cancel(n,two,&cancelled,&q);
if(!err)
{ *next = make_power(absa,q);
HIGHLIGHT(*next);
strcpy(reason,flag ? english(889) : english(890));
/* �(a^2�)= |a|� or �(a^2�)= a� if a�0 */
return 0;
}
return 1;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int sqrtofquotient(term t, term arg, term *next, char *reason)
/* sqrt(a/b) = sqrt(a)/ sqrt(b)
It's always applied in menu or command modes,
but in automatic mode we don't apply it to the whole Context,
thus e.g. �(2/3) is left alone but �(2/3) + 5 is
rewritten �2/�3 + 5 = (�2 + 5�3)/�3 = (�6 + 15) /3
*/
{ term a,b,sqrta,sqrtb,minusa,minusb;
int err;
short savenextassumption;
int savenvariables,saveeigen,savenextdefn;
int nextassumption;
if(FUNCTOR(t) != SQRT)
return 1;
if(FUNCTOR(ARG(0,t)) != '/')
return 1;
a = ARG(0,ARG(0,t));
b = ARG(1,ARG(0,t));
savenextassumption = get_nextassumption();
savenvariables = get_nvariables();
saveeigen = get_eigenindex();
savenextdefn = get_nextdefn();
if(NEGATIVE(a) && NEGATIVE(b))
{ a = ARG(0,a);
b = ARG(0,b);
}
minusa = strongnegate(a);
minusb = strongnegate(b);
if(obviously_nonnegative(a) || obviously_nonnegative(b))
err = 0;
else if(obviously_nonnegative(minusa) || obviously_nonnegative(minusb))
{ a = minusa;
b = minusb;
err = 0;
}
else
{ err = check(nonnegative(a));
if(err)
err = check(le(b,zero));
}
if(!err)
{ sqrta = make_sqrt(a);
sqrtb = make_sqrt(b);
*next = make_fraction(sqrta,sqrtb);
}
else
{ errbuf(0, english(1806));
errbuf(1, english(1807));
errbuf(2, english(1808));
/* To ensure that the result is defined, you would have to make assumptions involving the variable.
That might cause you to lose solutions, and hence is not allowed. */
set_nextdefn(savenextdefn);
set_eigenvariable(saveeigen);
set_nextassumption(savenextassumption);
set_nvariables(savenvariables);
return 1;
}
nextassumption = get_nextassumption();
if(nextassumption > savenextassumption)
{ commentbuf(0,english(1853));
commentbuf(1,english(1854));
commentbuf(2,english(1855));
/* Assuming the new square roots are defined.
The resulting expression is equal to the previous one only subject
to those assumptions. For example, its graph may be different.
*/
}
HIGHLIGHT(*next);
strcpy(reason, english(891)); /* �(a/b) = �a/�b */
set_nextdefn(savenextdefn);
set_eigenvariable(saveeigen);
set_nextassumption(savenextassumption);
set_nvariables(savenvariables);
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int sqrtofquotient2(term t, term arg, term *next, char *reason)
/* sqrt(a/b) = sqrt(abs(a))/ sqrt(abs(b))
*/
{ term a,b,sqrta,sqrtb;
int erra,errb;
if(FUNCTOR(t) != SQRT)
return 1;
if(FUNCTOR(ARG(0,t)) != '/')
return 1;
a = ARG(0,ARG(0,t));
b = ARG(1,ARG(0,t));
if(NEGATIVE(a) && NEGATIVE(b))
{ a = ARG(0,a);
b = ARG(0,b);
}
if(obviously_nonnegative(b))
errb = 0;
else
errb = infer(nonnegative(b));
/* It's enough if one of a,b is nonnegative, then the new domain
is the same as the old domain */
if(!errb)
{ *next = make_fraction(make_sqrt(a),make_sqrt(b));
HIGHLIGHT(*next);
strcpy(reason, english(891)); /* �(a/b) = �a/�b */
SetShowStepOperation(sqrtofquotient);
return 0;
}
if(obviously_nonnegative(a))
erra = 0;
else
erra = infer(nonnegative(a));
if(!erra)
{ *next = make_fraction(make_sqrt(a),make_sqrt(b));
HIGHLIGHT(*next);
strcpy(reason, english(891)); /* �(a/b) = �a/�b */
SetShowStepOperation(sqrtofquotient);
return 0;
}
sqrta = make_sqrt(abs1(a));
sqrtb = make_sqrt(abs1(b));
*next = make_fraction(sqrta,sqrtb);
HIGHLIGHT(*next);
strcpy(reason, "$�(a/b) = �|a|/�|b|$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int quotientofsqrts(term t, term arg, term *next, char *reason)
{ int err;
term temp;
if(FUNCTOR(t) == '*' && ARITY(t) == 2)
{ if(INTEGERP(ARG(0,t)) || RATIONALP(ARG(0,t)))
/* (1/2) (�2/�3) for example */
{ err = quotientofsqrts(ARG(1,t),arg,&temp,reason);
if(err)
return 1;
*next = product(ARG(0,t),temp);
return 0;
}
}
if(FUNCTOR(t) != '/')
return 1;
if(FUNCTOR(ARG(0,t)) != SQRT)
return 1;
if(FUNCTOR(ARG(1,t)) != SQRT)
return 1;
if(equals(ARG(0,ARG(0,t)),ARG(1,ARG(1,t))) && get_mathmode() == AUTOMODE)
return 1; /* wait till cancel is used on sqrt(2)/sqrt(2) for example. */
*next = make_sqrt(make_fraction(ARG(0,ARG(0,t)),ARG(0,ARG(1,t))));
HIGHLIGHT(*next);
strcpy(reason, english(892)); /* �a/�b = �(a/b) */
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int sqrtexp(term t, term arg, term *next, char *reason)
/* �x = x^(1/2) */
/* works on products or powers because in automode in calculus we want to use
it only on sqrts that occur in products or powers */
{ unsigned short n;
int err,i,flag=0,count=0;
unsigned short path[32];
unsigned short path2[4];
term u,power,c,v;
if(FUNCTOR(t) == SQRT)
{ *next = make_power(ARG(0,t),make_fraction(one,two));
HIGHLIGHT(*next);
strcpy(reason, english(893)); /* �x = x^(1/2) */
return 0;
}
if(FUNCTOR(t) == '^')
{ err = sqrtexp(ARG(0,t),arg,&u,reason);
if(err)
return 1;
path[0] = '^';
path[1] = 1;
path[2] = 0;
set_pathtail(path);
if(FUNCTOR(u) == '^' &&
status(sqrtexp) >= KNOWN && status(powertopower) >= KNOWN
)
{ polyval(signedproduct(ARG(1,u),ARG(1,t)),&power);
*next = make_power(ARG(0,u),power);
}
else
*next = make_power(u,ARG(1,t));
/* don't HIGHLIGHT(*next); u is already highlighted */
return 0;
}
if(FUNCTOR(t) == '*')
{ n = ARITY(t);
*next = make_term('*',n);
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u) == SQRT && !INTEGERP(ARG(0,u)))
/* don't rewrite �2 in a product */
{ sqrtexp(u,arg,ARGPTR(*next)+i,reason);
++count;
if(flag == 0)
flag = i+1;
if(count == 1)
ratpart2(ARG(0,u),&c,&v);
}
else
ARGREP(*next,i,u);
}
if(count==0)
{ RELEASE(*next);
return 1;
}
/* This is used on products only in calculus. It should work
only if there's a power of x in the product too, or more
than one square root. */
if(count==1)
{ for(i=0;i<n;i++)
{ u = ARG(i,t);
if(equals(u,v))
goto out;
if(FUNCTOR(u) == '^' && equals(ARG(0,u),v))
goto out;
}
return 1; /* fail */
}
}
else
return 1; /* functors other than SQRT and '*' */
out:
HIGHLIGHT(*next);
pathncopy(path,12,get_pathtail()); /* example, x (sqrt(x))^3 y,
pathtail is already set to ^,1 */
path2[0] = '*';
path2[1] = (unsigned short) flag;
path2[2] = 0;
pathcat(path,path2);
set_pathtail(path);
strcpy(reason, english(893)); /* �x = x^(1/2) */
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int sqrtexpdenom(term t, term arg, term *next, char *reason)
/* 1/�x = x^(-1/2) */
/* Works on quotients, calling sqrtexp on denominator */
{ int err;
term temp,num,denom,newnum;
unsigned short f;
if(FUNCTOR(t) != '/')
return 1;
num = ARG(0,t);
denom = ARG(1,t);
f = FUNCTOR(denom);
if(f != SQRT && f != '^')
return 1; /* this one doesn't work on products */
err = sqrtexp(denom,arg,&temp,reason);
if(err)
return 1;
if(FUNCTOR(temp) != '^')
return 1;
newnum = make_power(ARG(0,temp),tnegate(ARG(1,temp)));
HIGHLIGHT(newnum);
*next = product(num,newnum);
if(FUNCTOR(*next) == '*')
sortargs(*next);
strcpy(reason, "$1/�x = x^(-1/2)$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int ratdenomandsimp(term t, term arg, term *next, char *reason)
/* rationalize the denominator and simplify */
{ int err;
term u,v;
int fractexpflag;
term denom,newdenom;
err = rationalizedenom(t,arg,&u,reason);
if(err)
return 1;
if(FUNCTOR(u) == '*' && ARITY(u) == 2) /* as it must */
mfracts(ARG(0,u),ARG(1,u),&v);
else
return 1;
/* Before calling polyval we need to simplify factors of the
form (sqrt u)^2 in the denom, because otherwise they may
just cancel out with sqrt(u) in the num and produce the original
fraction again. But mfracts just leaves sqrt(u) sqrt(u),
so the easiest thing is to polyval the denom separately. */
fractexpflag = get_polyvalfractexpflag();
set_polyvalfractexpflag(0); /* don't convert to fractional exponents */
if(FRACTION(v))
{ denom = ARG(1,v);
polyval(denom,&newdenom);
v = make_fraction(ARG(0,v),newdenom);
}
polyval(v,next);
set_polyvalfractexpflag(fractexpflag);
if(equals(t,*next))
return 1; /* assert(0) */
strcpy(reason, english(1880));
/* rationalize denom and simplify */
release(polyvalop); /* possibly inhibited by rationalizedenom */
release(cancelop); /* possibly inhibited by rationalizedenom */
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int rationalizedenom(term t, term arg, term *next, char *reason)
/* rationalizedenom and rationalizenum will loop, of course, so they are
called only in menu mode in limits. Auto mode calls rationalizefraction.
In integrals, auto mode can call rationalizedenom, but not rationalizenum.
*/
{ term b,c,d1,d2,u;
int err;
int ringflag;
unsigned short g;
unsigned short path[5];
if(FUNCTOR(t) != '/' && FUNCTOR(t) != LIMIT)
return 1;
if(FUNCTOR(t) == '/')
{ b = ARG(1,t);
err = get_rationalizing_factor(b,&c);
if(err)
return 1;
g = FUNCTOR(c);
if(g==ROOT || g == SQRT || g == '^')
err = 0;
else if(g == '+' && !NEGATIVE(ARG(1,b)) && !NEGATIVE(ARG(0,b)) &&
obviously_nonnegative(b)
)
err = 0;
else
err = check(nonzero(c));
if(err)
return 1;
copy(c,&d1);
copy(c,&d2); /* avoid creating a DAG; terms must be trees */
if(FUNCTOR(c) == '+' && ARITY(c) == 3)
{ PROTECT(d1);
PROTECT(d2); /* prevent re-ordering terms */
}
u = make_fraction(d1,d2);
PROTECT(u);
HIGHLIGHT(u);
*next = product(t,u);
strcpy(reason,english(1369)); /* rationalize denom */
inhibit(cancelop); /* will be released by difofsquares */
inhibit(polyvalop);
ringflag = get_ringflag();
if(ringflag & ALGINT) /* algebraic factors allowed */
{ ringflag &= ~ALGINT; /* now algebraic factors won't be allowed,
otherwise we create a loop e.g. with (x-�a)/(x^2+a) */
set_ringflag(ringflag);
}
return 0;
}
/* now FUNCTOR(t) == LIMIT */
err = rationalizedenom((ARITY(t)==2 ? ARG(1,t) : ARG(2,t)),arg, &u, reason);
if(err)
return err;
if(ARITY(t)==2)
{ *next = limit(ARG(0,t),u);
path[0] = LIMIT;
path[1] = 2;
path[2] = 0;
}
else
{ *next = limit3(ARG(0,t),ARG(1,t),u);
path[0] = LIMIT;
path[1] = 3;
path[2] = 0;
}
set_pathtail(path);
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int rationalizenum(term t, term arg, term *next, char *reason)
{ term b,c,d1,d2,u;
int err,ringflag;
unsigned short path[5];
if(FUNCTOR(t) == '+' && get_mathmode() == SELECTIONMODE)
/* when rationalizesum works on a limit of a sum, it calls set_pathtail
so that the sum is highlighted, and SetShowStepOperation is set
to rationalizenum. So, this operation must work on a sum in a limit.
But, we don't want 'execute' to apply it to just any sum.
Therefore the restriction to SELECTIONMODE */
{ b = make_term('/',2);
ARGREP(b,0,t);
ARGREP(b,1,one);
t = b; /* and go on to the code below. */
}
if(FUNCTOR(t) != '/' && FUNCTOR(t) != LIMIT)
return 1;
if(FUNCTOR(t) == '/')
{ b = ARG(0,t);
err = get_rationalizing_factor(b,&c);
if(err)
return 1;
err = check(nonzero(c));
if(err)
return 1;
copy(c,&d1); /* avoid creating a DAG; terms must be trees */
copy(c,&d2);
if(FUNCTOR(c) == '+' && ARITY(c) == 3)
{ PROTECT(d1);
PROTECT(d2); /* prevent re-ordering terms */
}
u = make_fraction(d1,d2);
HIGHLIGHT(u);
PROTECT(u);
*next = product(t,u);
strcpy(reason,english(1368)); /* rationalize numerator */
inhibit(cancelop); /* will be released by difofsquares */
inhibit(polyvalop);
ringflag = get_ringflag();
if(ringflag & ALGINT) /* algebraic factors allowed */
{ ringflag &= ~ALGINT; /* now algebraic factors won't be allowed,
otherwise we create a loop e.g. with (x-�a)/(x^2+a) */
set_ringflag(ringflag);
/* obsolete: ringflag_visible = 1; */
}
return 0;
}
/* now FUNCTOR(t) == LIMIT */
err = rationalizenum((ARITY(t)==2 ? ARG(1,t) : ARG(2,t)),arg, &u, reason);
if(err)
return err;
if(ARITY(t)==2)
{ *next = limit(ARG(0,t),u);
path[0] = LIMIT;
path[1] = 2;
path[2] = 0;
}
else
{ *next = limit3(ARG(0,t),ARG(1,t),u);
path[0] = LIMIT;
path[1] = 3;
path[2] = 0;
}
set_pathtail(path);
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int evaltorational(term t, term arg, term *next, char *reason)
/* evaluate a term to a rational number if its value is
rational. */
{ aflag arithflag = get_arithflag();
aflag saveit = arithflag;
int err;
arithflag.roots = 1;
arithflag.functions = 1;
set_arithflag(arithflag);
err = value(t,next);
if(err)
{ set_arithflag(saveit);
return 1;
}
HIGHLIGHT(*next);
strcpy(reason, english(1736)); /* evaluate to rational */
set_arithflag(saveit);
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int computesqrt(term t, term arg, term *next, char *reason)
{ if(FUNCTOR(t) != SQRT)
return 1;
return computeroot(t,arg,next,reason);
}
/*_____________________________________________________________________*/
static term make_power2(term x, term a)
/* return x^a using laws of exponents in case x is already a power */
{ term u;
if(FUNCTOR(x) != '^')
return make_power(x,a);
polyval(product(ARG(1,x),a),&u);
return make_power(ARG(0,x),u);
}
/*_____________________________________________________________________*/
static int get_rationalizing_factor(term s,term *factor)
/* given s = a-�b return *factor = a+�b;
given s = �a return *factor = �a; etc.
given s = |a|-|b| return |a|+|b| etc.
given x = a - b^(1/2) return a + b^(1/2)
given x = a - b^(n/2) return a + b^(n/2)
for ��a - ��b it's more complicated
Also handle a-b^(1/n)
given s = c root(n,a-sqrt(b)), return *factor = root(n,a+sqrt(b))
(This is needed in simplifying solutions of cubic equations.)
*/
{ term b,c,u,v,w;
long kb,kc,n;
int i,err,rootflag;
unsigned short k,m;
term temp;
if(FUNCTOR(s) == SQRT)
{ *factor = s;
return 0;
}
if(FUNCTOR(s) == ROOT && FUNCTOR(ARG(1,s)) == '+' &&
ARITY(ARG(1,s)) == 2 && contains_sqrt(ARG(1,ARG(1,s)))
)
{ err = get_rationalizing_factor(ARG(1,s),&v);
if(err)
return 1;
*factor = make_root(ARG(0,s),v);
return 0;
}
if(FUNCTOR(s) == '*' && contains_at_toplevel(s,ROOT))
{ /* It works only if there's just one ROOT term */
m = ARITY(s);
rootflag = -1;
for(i=0;i<m;i++)
{ if(FUNCTOR(ARG(i,s)) == ROOT)
{ if(rootflag > 0)
return 1; /* more than one ROOT */
rootflag = i;
}
}
return get_rationalizing_factor(ARG(rootflag,s),factor);
}
if(FUNCTOR(s) == '*') /* pull out all factors of SQRT */
{ temp = make_term('*',ARITY(s));
k=0; /* mark place in temp */
for(i=0;i<ARITY(s);i++)
if(FUNCTOR(ARG(i,s))==SQRT)
{ ARGREP(temp,k,ARG(i,s));
++k;
}
if(k==0)
{ RELEASE(temp);
return 1;
}
if(k==1)
{ *factor = ARG(0,temp);
RELEASE(temp);
return 0;
}
/* so now k >= 2 */
*factor= make_term('*',k);
for(i=0;i<k;i++)
ARGREP(*factor,i,ARG(i,temp));
RELEASE(temp);
return 0;
}
if(FUNCTOR(s) != '+' || ARITY(s) > 2)
return 1; /* not applicable */
b = ARG(0,s);
c = ARG(1,s);
kb = grf_aux(b);
kc = grf_aux(c);
if(!kb && !kc)
return 1;
if(kb && kc && kb != kc) /* e.g. �a + ��b */
return 1;
/* Now kb==kc or one of them is zero */
if(kb==1 || kc==1 || /* dealing with square roots */
kb== -1 || kc == -1 /* dealing with ABS */
)
{ if(FUNCTOR(b) == '-')
*factor = sum(ARG(0,b),c);
else
*factor = sum(b,tnegate(c));
return 0;
}
/* Now dealing with non-square roots */
n = kb ? kb : kc; /* index of the root = arity of rationalizing factor */
if(n > 50)
{ errbuf(0, english(894));
/* More than 50 terms in rationalizing factor--*/
errbuf(1, english(895));
/* Too long to be useful. */
return 1;
}
if(FUNCTOR(b) == '-')
b = ARG(0,b);
else if (FUNCTOR(c) == '-')
c = ARG(0,c);
else
return 1;
*factor = make_term('+',(unsigned short ) n);
ARGREP(*factor,0,make_power2(b,make_int(n-1)));
if(FUNCTOR(b) == ROOT)
PROTECT(ARG(0,*factor)); /* else e.g. root(3,2)^2 goes to root(3,2^2) */
ARGREP(*factor,(unsigned short ) (n-1),make_power2(c,make_int(n-1)));
PROTECT(ARG((unsigned short )(n-1), *factor));
for(i=1;i<n-1;i++)
{ u = make_power2(c,make_int(i));
v = make_power2(b,make_int(n-i-1));
w = product(v,u);
PROTECT(w); /* prevent reordering xa as ax in middle terms
before the product can be multiplied out by
makedifofcubes */
if(FUNCTOR(c) == ROOT)
PROTECT(u); /* else e.g. root(3,2)^2 goes to root(3,2^2) */
if(FUNCTOR(b) == ROOT)
PROTECT(v);
ARGREP(*factor,i,w);
}
SETORDERED(*factor);
/* Not additive_order, because e.g. root(3, 1+x) - root(3,x)
generates a rationalizing factor that won't get ordered the
way we want. We definitely want to retain the specified
order, which is inherited from the correct order on a
two-variable pattern u^2 + uv + v^2, and won't be gotten
right after a one-variable double substitution. */
return 0;
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA long grf_aux(term u)
/* is u a product of which one term is a square root or power 1/2,
or a negation of such?
return 1 if u is such a term, 0 if not.
if instead of square root we have n-th root or power 1/n, return n
and return -1 if we have an absolute value instead of a square root.
*/
{ int i;
unsigned short f;
if(FUNCTOR(u) == SQRT)
return 1;
if(FUNCTOR(u) == '^' && FRACTION(ARG(1,u)) &&
ONE(ARG(0,ARG(1,u))) && equals(ARG(1,ARG(1,u)),two)
)
return 1;
if(FUNCTOR(u) == ABS)
return -1;
if(FUNCTOR(u) == ROOT && ISINTEGER(ARG(0,u)))
return INTDATA(ARG(0,u));
if(FUNCTOR(u) == '^' && FRACTION(ARG(1,u)) &&
ISINTEGER(ARG(1,ARG(1,u)))
)
return INTDATA(ARG(1,ARG(1,u)));
if(FUNCTOR(u) == '-')
return grf_aux(ARG(0,u));
if(FUNCTOR(u) == '*')
{ for(i=0;i<ARITY(u);i++)
{ f = FUNCTOR(ARG(i,u));
if(f == SQRT || f == ABS || (f == ROOT && ISINTEGER(ARG(0,u))))
return grf_aux(ARG(i,u));
}
}
return 0;
}
/*_____________________________________________________________________*/
static int fs_aux(long index, term t, term *u)
/* factor t or one of the factors of a product t */
/* but in automode, only if there is an exponent >= index
in the factorization, or if the factorization has the
form t = p^n and gcd(n,index) is non-trivial.
Example: root(4,4) = root(4,2^2) so it can go to root(2,2) next time.
/* return 0 for success, putting the factorization in *u. */
{ int err,mathmode;
unsigned short i,k,n;
unsigned nfactors;
char buffer[DIMREASONBUFFER];
term temp,v,s;
if( !ATOMIC(t) && FUNCTOR(t) == '*')
{ n = ARITY(t);
for(i=0;i<n;i++)
{ v = ARG(i,t);
if (INTEGERP(v))
{ if(index == 2)
s = sqrt1(v);
else
s = make_root(make_int(index),v);
err = knownroot(s,zero,&temp,buffer);
if(!err)
{ nfactors = 1;
temp = make_power(temp,make_int(index));
break; /* out of the i-loop */
}
err = factor_integer(v,&nfactors,&temp);
if(!err && nfactors == 1 && FUNCTOR(temp) == '^' &&
(INTDATA(ARG(1,temp)) >= index || get_mathmode() != AUTOMODE)
)
break; /* out of the i-loop */
if(!err && FUNCTOR(temp) == '*')
{ if(get_mathmode() != AUTOMODE)
break; /* out of the i-loop */
/* did any factor have a power >= index ? */
for(k=0;k<nfactors;k++)
{if(FUNCTOR(ARG(k,temp)) == '^' &&
INTDATA(ARG(1,ARG(k,temp))) >= index
)
break;
}
if(k<nfactors)
break; /* out of the i-loop */
/* else keep going, maybe another integer does factor successfully */
}
}
}
if(i<n) /* an integer was found and factored */
{ *u = make_term('*',(unsigned short)(n+nfactors-1));
for(k=0;k<i;k++)
ARGREP(*u,k,ARG(k,t));
if(nfactors == 1)
ARGREP(*u,i,temp);
else
{ assert(FUNCTOR(temp) == '*');
for(k=i;k<i+nfactors;k++)
ARGREP(*u,k,ARG(k-i,temp));
}
for(k=i+1;k<n;k++)
ARGREP(*u,k+nfactors-1,ARG(k,t));
return 0;
}
return 1; /* none of the factors of t could be factored */
}
/* If we get here, t is not a product any more */
if( TYPE(t) != BIGNUM && TYPE(t) != INTEGER)
return 1;
factor_integer(t,&nfactors,u);
if(nfactors == 1 && FUNCTOR(*u) != '^')
{ errbuf(0,english(256)); /* That integer is prime */
return 1;
}
mathmode = get_mathmode();
if(nfactors == 1)
{ if( mathmode == AUTOMODE &&
INTDATA(ARG(1,*u)) < index &&
intgcd(INTDATA(ARG(1,*u)),index) == 1L
)
/* not a high enough power, and no common factor with the index */
return 1;
return 0;
}
if(nfactors > 1)
{ assert(FUNCTOR(*u) == '*');
for(i=0;i< ARITY(*u);i++)
{ if(FUNCTOR(ARG(i,*u))=='^' && INTDATA(ARG(1,ARG(i,*u))) >= index)
break;
}
if (i== ARITY(*u))
return mathmode == AUTOMODE ? 1 : 0; /* t contained no prime to power at least index */
}
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int factorundersqrt(term s, term arg, term *next, char *reason)
/* works on s = sqrt(t), where t is an integer or a product containing
at least one integer; factors the integer t (or the factor of t which is an
integer) ; but fails if t turns out to be square-free.
Also works on a power with exponent 1/2.
Note, it does not produce the same effect as factorinteger on
the number under the sqrt, for example in sqrt(16) the 16 will become
4^2 rather than 2^4. Hence we do not call set_pathtail and
SetShowStepOperation.
*/
{ term t,u,v;
int i,err;
unsigned short f = FUNCTOR(s);
if(f == '^' && FRACTION(ARG(1,s)))
{ if(!ONE(ARG(0,ARG(1,s))))
return 1;
if(!equals(ARG(1,ARG(1,s)),two))
return 1;
}
else if(f != SQRT)
return 1;
t = ARG(0,s); /* whether s is a SQRT or a fractional power */
if(ONE(t) || ZERO(t))
return 1; /* don't change sqrt(1) to 1 with reason "factor 1" */
if(!OBJECT(t) && FUNCTOR(t) != '*')
return 1;
if(ISINTEGER(t) && f == SQRT && !knownroot(s,arg,&v,reason))
{ err = 0;
u = make_power(v,two);
}
else if(ISINTEGER(t) && f == '^' && equals(ARG(1,ARG(1,s)),two) &&
!knownroot(sqrt1(t),arg,&v,reason)
)
{ err = 0;
u = make_power(v,two);
}
else
err = fs_aux(2,t,&u);
if(err)
return 1;
PROTECT(u);
if(FUNCTOR(u) == '*')
{ for(i=0;i<ARITY(u);i++)
{ if(FUNCTOR(ARG(i,u)) == '^')
PROTECT(ARG(i,u));
}
}
HIGHLIGHT(u);
*next = f == SQRT ? make_sqrt(u) : make_power(u, reciprocal(two));
strcpy(reason, english(1542)); /* factor integer x in �x */
if(f == '^')
SetShowStepOperation(factorbase);
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int factorunderroot(term s, term arg, term *next, char *reason)
/* works on s = root(n,t), where t is an integer or a product containing
at least one integer; factors the integer t (or the factor of t which is an
integer) ; but fails if t turns out to be nth-power-free.
Also works on a power with exponent 1/n.
Note, it does not produce the same effect as factorinteger on
the number under the root, for example in root(3,64) the 64 will become
4^3 rather than 2^6. Hence we do not call set_pathtail and
SetShowStepOperation.
*/
{ term u,v,t;
int i,err;
long index;
unsigned short f = FUNCTOR(s);
if(f == '^' && FRACTION(ARG(1,s)))
{ if(!ONE(ARG(0,ARG(1,s))))
return 1;
if(!INTEGERP(ARG(1,ARG(1,s))))
return 1;
t = ARG(0,s);
index = INTDATA(ARG(1,ARG(1,s)));
}
else if(FUNCTOR(s) == ROOT)
{ t = ARG(1,s);
if(!ISINTEGER(ARG(0,s)))
return 1;
index = INTDATA(ARG(0,s));
}
else
return 1;
if(index == 1 || index == 0)
return 1;
if(ISINTEGER(t) && f == ROOT && !knownroot(s,arg,&v,reason))
{ err = 0;
u = make_power(v,make_int(index));
}
else if(ISINTEGER(t) && f == '^' &&
!knownroot(make_root(ARG(1,ARG(1,s)),t),arg,&v,reason)
)
{ err = 0;
u = make_power(v,ARG(1,ARG(1,s)));
}
else
err = fs_aux(index,t,&u);
if(err)
return 1;
PROTECT(u);
if(FUNCTOR(u) == '*')
{ for(i=0;i<ARITY(u);i++)
{ if(FUNCTOR(ARG(i,u)) == '^')
PROTECT(ARG(i,u));
}
}
HIGHLIGHT(u);
*next = f == ROOT ? make_root(ARG(0,s),u) : make_power(u,ARG(1,s));
strcpy(reason,english(1543)); /* factor integer x in ��x */
if(f == '^')
SetShowStepOperation(factorbase);
return 0;
}
/*___________________________________________________________*/
int factorbase_extender(term t, term arg, term *next, char *reason)
/* Works on a fraction, in order to handle 10^(1/2)/ (5^(1/2) 2^(1/2))
for example. To handle such examples, it's convenient to have it also
work on a product. On a power, it factors the base and distributes the
power over the product.
*/
{ unsigned short n;
int i,err;
unsigned short flag;
term u,v,w,cancelled,base,power;
char buffer[DIMREASONBUFFER];
unsigned short path[5];
int count = 0;
unsigned short f = FUNCTOR(t);
if(f == '^')
{ base = ARG(0,t);
power = ARG(1,t);
if(!ISINTEGER(base))
return 1;
w= make_term('^',2);
err = factorinteger(base,arg,ARGPTR(w),buffer);
if(err)
return 1;
ARGREP(w,1,power);
err = producttopower(w,arg,next,reason);
if(err)
return 1; /* assert(0) */
return 0;
}
if(f == '*')
{ n = ARITY(t);
u = make_term(f,n);
flag = 0;
for(i=0;i<n;i++)
{ err = factorbase_extender(ARG(i,t),arg,&v,reason);
if(!err)
{ flag = 1;
ARGREP(u,i,v);
++count;
}
else
ARGREP(u,i,ARG(i,t));
}
if(!flag)
return 1;
if(FUNCTOR(ARG(flag-1,t)) == '^' && count == 1)
{ path[0] = '*';
path[1] = flag;
path[2] = 0;
set_pathtail(path);
SetShowStepOperation(producttopower);
}
*next = topflatten(u);
return 0;
}
if(f == '/')
{ u = make_term('/',2);
for(i=0;i<2;i++)
{ err = factorbase_extender(ARG(i,t),arg,&v,reason);
if(!err)
{ flag = (unsigned short)(i+1);
ARGREP(u,i,v);
++count;
}
else
ARGREP(u,i,ARG(i,t));
}
err = cancel(ARG(0,u),ARG(1,u),&cancelled,&v);
if(err)
return 1;
if(FUNCTOR(ARG(flag-1,t)) == '^' && count == 1)
{ path[0] = '/';
path[1] = flag;
path[2] = 0;
set_pathtail(path);
SetShowStepOperation(producttopower);
}
*next = u;
return 0;
}
return 1;
}
/*___________________________________________________________*/
MEXPORT_ALGEBRA int factorbase(term t, term arg, term *next, char *reason)
/* factor integer in base of term with non-integer exponent */
/* examples:
16^(1/10) 2^(3/5) => (2^4)^(1/10) 2^(3/5) => 2^(2/5)2^(3/5) => 2^1 => 2
16^(1/10) = 2^(2/5) so we need it for standalone powers too, not
just for products of powers;
35^(1/3) = 5^(1/3)7^(1/3) looks silly standing alone however, but
it's very difficult to prevent it and still get the previous example right.
10^(log x - log y) should NOT use this operator to produce
2^(log x - log y) 5^(log x - log y); this is prevented in autoexp.
Also works on a fraction, to handle examples like 10^(1/2)/(2^(1/2)5^(1/2))
*/
{ term base, power;
int err;
unsigned short f = FUNCTOR(t);
if(f == '/' && numerical(t))
{ err = factorbase_extender(t,arg,next,reason);
if(err)
return 1;
SetShowStepOperation(producttopower);
/* Yes, producttopower will work on a numerical fraction */
return 0;
}
if(FUNCTOR(t) != '^')
return 1;
base = ARG(0,t);
power = ARG(1,t);
if(!ISINTEGER(base))
return 1;
*next = make_term('^',2);
if(get_mathmode() == AUTOMODE)
{ if(!FRACTION(power) || !ISINTEGER(ARG(1,power)))
return 1;
err = fs_aux(INTDATA(ARG(1,power)),base, ARGPTR(*next));
if(err)
return 1;
strcpy(reason, english(255)); /* factor integer */
}
else
{ err = factorinteger(base,arg,ARGPTR(*next),reason);
if(err)
return 1;
}
ARGREP(*next,1,power);
inhibit(arithmetic); /* to be released by powertopower */
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int knownroot(term t, term arg, term *next, char *reason)
/* evaluate square roots or roots student should know by memory */
{ long n,ans,index;
if(FUNCTOR(t) == SQRT && ISINTEGER(ARG(0,t)))
{ n = INTDATA(ARG(0,t));
switch(n)
{ case 0: ans = 0; goto out;
case 1: ans = 1; goto out;
case 4: ans = 2; goto out;
case 9: ans = 3; goto out;
case 16: ans = 4; goto out;
case 25: ans = 5; goto out;
case 36: ans = 6; goto out;
case 49: ans = 7; goto out;
case 64: ans = 8; goto out;
case 81: ans = 9; goto out;
case 100: ans = 10; goto out;
case 121: ans = 11; goto out;
case 144: ans = 12; goto out;
case 169: ans = 13; goto out;
default: return 1;
}
}
else if(FUNCTOR(t) == ROOT && ISINTEGER(ARG(1,t)) && ISINTEGER(ARG(0,t)))
{ index = INTDATA(ARG(0,t));
n = INTDATA(ARG(1,t));
switch(index)
{ case 2: return 1;
case 3: switch(n)
{ case 0: ans = 0; goto out;
case 1: ans = 1; goto out;
case 8 : ans = 2; goto out;
case 27: ans = 3; goto out;
case 64: ans = 4; goto out;
case 125: ans = 5; goto out;
default: return 1;
}
case 4: switch(n)
{ case 0: ans = 0; goto out;
case 1: ans = 1; goto out;
case 16: ans = 2; goto out;
case 81: ans = 3; goto out;
default: return 1;
}
default: return 1;
}
}
else /* for example a square root of a bignum comes here */
return 1;
out:
*next = make_int(ans);
HIGHLIGHT(*next);
if(FUNCTOR(t) == SQRT)
{ ltoa(ans,reason,10);
strcat(reason,"$^2 = $");
ltoa(n, reason + strlen(reason),10);
}
else
strcpy(reason, english(898)); /* known root */
return 0;
}
/*____________________________________________________________*/
MEXPORT_ALGEBRA int lauringson(term t, term arg, term *next, char *reason)
/* a^2-b = (a-�b)(a+�b) */
/* This operator was much desired by A. Lauringson */
/* It isn't used in auto mode; rationalizenum and rationalizedenom
do the work instead. */
{ int err;
term a,asq,bsq,b;
term c,s,csq,ssq;
if(FUNCTOR(t) != '+' || ARITY(t) != 2 || !NEGATIVE(ARG(1,t)))
return 1;
asq = ARG(0,t);
bsq = ARG(0,ARG(1,t)); /* t = asq-bsq */
if(ISATOM(asq))
a = make_sqrt(asq);
else if(FUNCTOR(asq) == '*')
{ ratpart2(asq,&csq,&ssq);
err = sqrt_aux(csq,&c);
if(err)
return 1;
err = sqrt_aux(ssq,&s);
if(err)
s = make_sqrt(ssq);
a = product(c,s);
}
else
{ err = sqrt_aux(asq,&a);
if(err)
return 1;
}
if(ISATOM(bsq))
b = make_sqrt(bsq);
else if(FUNCTOR(bsq) == '*')
{ ratpart2(bsq,&csq,&ssq);
err = sqrt_aux(csq,&c);
if(err)
return 1;
err = sqrt_aux(ssq,&s);
if(err)
s = make_sqrt(ssq);
b = product(c,s);
}
else
{ err = sqrt_aux(bsq,&b);
if(err)
return 1;
}
*next = product(sum(a,tnegate(b)),sum(a,b));
strcpy(reason,"$a^2-b = (a-�b)(a+�b)$");
return 0;
}
/*____________________________________________________________*/
MEXPORT_ALGEBRA int multiplyoutundersqrt(term t, term arg, term *next, char *reason)
{ int err;
term temp;
unsigned short path[128];
if(FUNCTOR(t) != SQRT)
return 1;
err = multiplyoutandsimp(ARG(0,t),arg,&temp,reason);
if(err)
return 1;
*next = sqrt1(temp);
path[0] = SQRT;
path[1] = 1;
path[2] = 0;
if(GetShowStepOperation() == NULL)
{ set_pathtail(path);
SetShowStepOperation(multiplyoutandsimp);
}
else
{ pathncopy(path+2,126,get_pathtail());
set_pathtail(path);
}
return 0;
}
/*____________________________________________________________*/
MEXPORT_ALGEBRA int multiplyoutunderroot(term t, term arg, term *next, char *reason)
{ int err;
term temp;
unsigned short path[128];
if(FUNCTOR(t) != ROOT)
return 1;
err = multiplyoutandsimp(ARG(0,t),arg,&temp,reason);
if(err)
return 1;
*next = make_root(ARG(0,t),temp);
path[0] = SQRT;
path[1] = 2;
path[0] = 0;
if(GetShowStepOperation() == NULL)
{ set_pathtail(path);
SetShowStepOperation(multiplyoutandsimp);
}
else
{ pathncopy(path+2,126,get_pathtail());
set_pathtail(path);
}
return 0;
}
/*________________________________________________________________*/
static int bs_check(term t)
/* an auxiliary for backtosqrts below */
/* return 0 if t contains no fractional exponents */
/* return 1 if t contains only fractional exponent 1/2 */
/* return 2 if t contains only fractional exponents with denom 2 */
/* return 3 otherwise */
{ unsigned short n;
int i, err, flag;
if(ATOMIC(t))
return 0;
if(FUNCTOR(t) == '^' && FRACTION(ARG(1,t)))
{ term num = ARG(0,ARG(1,t));
term denom = ARG(1,ARG(1,t));
if(ONE(num) && equals(denom,two))
return 1;
if(equals(denom,two))
return 2;
return 3;
}
n = ARITY(t);
flag = 0;
for(i=0;i<n;i++)
{ err = bs_check(ARG(i,t));
if(err > 2)
return 3;
if(err > flag)
flag = err;
}
return flag;
}
/*________________________________________________________________*/
static term bs_aux(term t)
/* return result of substituting �x for x^(1/2) throughout t, for all x,
and root(n,x) for x^1/n.
*/
{ unsigned short n;
int i;
term ans;
if(ATOMIC(t))
return t;
if(FUNCTOR(t) == '^' && ONEHALF(ARG(1,t)))
{ ans=sqrt1(ARG(0,t));
HIGHLIGHT(ans);
return ans;
}
if(FUNCTOR(t) == '^' &&
RATIONALP(ARG(1,t)) &&
ONE(ARG(0,ARG(1,t)))
)
{ ans = make_root(ARG(1,ARG(1,t)),ARG(0,t));
HIGHLIGHT(ans);
return ans;
}
n = ARITY(t);
ans = make_term(FUNCTOR(t),n);
for(i=0;i<n;i++)
ARGREP(ans,i,bs_aux(ARG(i,t)));
return ans;
}
/*_______________________________________________________________________*/
static int path_to_color(term t, unsigned short *path, int k)
/* find the path to the leftmost colored subterm of t. This kind
of path alternates functor, arity+1, and terminates in 0;
using +,2,SUBRANGE,3 for a subrange. Return 0 for success.
Return 1 if there is no colored subterm, and -1 if the depth
k has been exceeded in the search. It is assumed that path
points to at least k valid unsigned shorts. After the
terminating zero, put the functor of the colored term.
*/
{ unsigned short n;
int i,err;
if(k <= 2)
return 1;
if(COLOR(t))
{ path[0] = 0;
path[1] = FUNCTOR(t);
return 0;
}
if(ATOMIC(t))
return 1;
path[0] = FUNCTOR(t);
n = ARITY(t);
for(i=0;i<n;i++)
{ path[1] =(unsigned short)(i+1);
err = path_to_color(ARG(i,t),path+2,k-2);
if(err <= 0)
return err; /* found, or space exceeded */
}
return 1; /* Not found, and space not exceeded */
}
/*________________________________________________________________*/
static term es_aux(term t)
/* return result of substituting x^(1/2) for �x throughout t, for all x,
and x^(1/n) for ��x */
{ unsigned short n;
int i;
term ans;
if(ATOMIC(t))
return t;
if(FUNCTOR(t) == SQRT)
{ ans = make_power(ARG(0,t),make_fraction(one,two));
HIGHLIGHT(ans);
return ans;
}
if(FUNCTOR(t) == ROOT)
{ ans = make_power(ARG(1,t),make_fraction(one,ARG(0,t)));
HIGHLIGHT(ans);
return ans;
}
n = ARITY(t);
ans = make_term(FUNCTOR(t),n);
for(i=0;i<n;i++)
ARGREP(ans,i,es_aux(ARG(i,t)));
return ans;
}
/*________________________________________________________________*/
MEXPORT_ALGEBRA int backtosqrts(term t, term arg, term *next, char *reason)
/* provided t contains no fractional powers except 1/2, convert
all fractional powers to SQRTs */
{ if(bs_check(t) != 1)
return 1; /* either no fractional powers or one not equal to 1/2 */
*next = bs_aux(t);
strcpy(reason,"$x ^ � = �x$");
inhibit(sqrtexp);
if(FUNCTOR(*next) == SQRT)
SetShowStepOperation(exponenttosqrt);
return 0;
}
/*________________________________________________________________*/
MEXPORT_ALGEBRA int restore_sqrts(term t, term *next)
/* Convert all fractional powers of (1/2) to SQRTS and ROOTs.
Similar to the above operator, but is not an operator and does
not affect ShowStep or make an inhibition. */
{ if(bs_check(t) != 1)
return 1; /* either no fractional powers or one not equal to 1/2 */
*next = bs_aux(t);
return 0;
}
/*________________________________________________________________*/
MEXPORT_ALGEBRA int backtoroots(term t, term arg, term *next, char *reason)
/* Convert all fractional powers to SQRTS and ROOTs.
Fails if t contains any negative
fractional exponents or non-numerical fractional exponents.
*/
{ term fractexp[3];
int nfractexps = fractexps(t,fractexp);
int i,count;
term u;
if(nfractexps == 0)
return 1; /* no fractional exponents */
count = 0;
for(i=0;i<nfractexps;i++)
{ u = fractexp[i];
if(NEGATIVE(u))
return 1;
if(!FRACTION(u))
assert(0);
if(!ONE(ARG(0,u)))
return 1;
if(!ISINTEGER(ARG(1,u)))
return 1; /* bignum denoms rejected */
if(!equals(ARG(1,u),two))
++count;
}
*next = bs_aux(t);
if(count == 0)
strcpy(reason, "$x ^ � = �x$");
else
strcpy(reason,"$x^(1/n) = ��x$");
inhibit(sqrtexp);
inhibit(rootexp);
if(FUNCTOR(*next) == ROOT)
SetShowStepOperation(exponenttoroot);
return 0;
}
/*________________________________________________________________*/
MEXPORT_ALGEBRA int eliminatesqrts(term t, term arg, term *next, char *reason)
/* convert all roots and sqrts to fractional powers.
*/
{ unsigned short path[256];
term focus;
int err;
int sqrtflag = contains(t,SQRT);
int rootflag = contains(t,ROOT);
if(!sqrtflag && !rootflag)
return 1; /* no roots to eliminate */
*next = es_aux(t);
strcpy(reason, sqrtflag ? "$�x = x ^ �$" : "$��x = x^(1/n)$");
err = path_to_color(*next,path,256);
if(!err)
{ set_pathtail(path);
/* is the colored term a ROOT or a SQRT? */
focus = part(t,path);
if(FUNCTOR(focus) == SQRT)
SetShowStepOperation(sqrtexp);
else if(FUNCTOR(focus) == ROOT)
SetShowStepOperation(rootexp);
}
return 0;
}
/*_____________________________________________________________*/
MEXPORT_ALGEBRA int cancelsqrt3(term t, term arg, term *next, char *reason)
/* or 'cancel under �', for �(xy)/�(xz) = �y/�z */
/* Must also work on any fraction containing powers of x as factors
of the numerator and �x as a factor in the denominator */
{ int err = cancel_sqrts(t,next);
if(err)
return 1;
if(FRACTION(*next))
strcpy(reason, english(1339)); /* cancel under � */
else
strcpy(reason,"$�(xy)/�y = �x$");
HIGHLIGHT(*next);
return 0;
}
/*______________________________________________________________*/
MEXPORT_ALGEBRA int sqrttoroot(term t, term arg, term *next, char *reason)
/* sqrt x = root(2n,x^n) */
/* arg comes in as n */
{ if(FUNCTOR(t) != SQRT)
return 1;
if(get_complex() && !seminumerical(t))
return 1; /* shouldn't be called under these circumstances anyway */
/* false for complex numbers, e.g. sqrt(-1) is not the 4th root of (-1)^2 */
assert(isinteger(arg) && obviously_positive(arg));
*next = make_root(product(two,arg),make_power(ARG(0,t),arg));
HIGHLIGHT(*next);
strcpy(reason, "$�x = ^2��x�$");
return 0;
}
/*______________________________________________________________*/
int sqrttoroot2(term t, term arg, term *next, char *reason)
/* sqrt x = root(2n,x)^n */
/* This one is OK for complex numbers */
/* arg comes in as n */
{ term index;
if(FUNCTOR(t) != SQRT)
return 1;
assert(isinteger(arg) && obviously_positive(arg));
polyval(product(two,arg),&index);
*next = make_power(make_root(index,ARG(0,t)),arg);
HIGHLIGHT(*next);
strcpy(reason, "$�x = (^2��x)�$");
return 0;
}
/*______________________________________________________________*/
int pushundersqrt(term t, term arg, term *next, char *reason)
/* a sqrt b = sqrt(a^2 b) if a >= 0 */
{ unsigned short n;
int i, err, sqrtflag;
term a,u,v;
if(FUNCTOR(t) != '*')
return 1;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,t)) == SQRT)
{ sqrtflag = i;
break;
}
}
if(i==n)
return 1; /* no SQRT factor */
/* First test the side condition */
if(n == 2)
a = ARG(sqrtflag ? 0 : 1,t);
else
{ a = make_term('*',(unsigned short)(n-1));
for(i=0;i<n-1;i++)
ARGREP(a,i,i<sqrtflag ? ARG(i,t) : ARG(i+1,t));
}
if(obviously_nonnegative(a))
err = 0;
else
err = infer(le(zero,a));
if(err)
{ errbuf(0, english(1860));
/* The factor outside the square root must be nonnegative. */
return 1;
}
v = ARG(0,ARG(sqrtflag,t));
/* Now square the other factors and put them under the sqrt */
u = make_term('*',n);
for(i=0;i<n;i++)
ARGREP(u,i, i == sqrtflag ? v : square(ARG(i,t)));
if(FUNCTOR(v) == '*')
u = topflatten(u);
*next = make_sqrt(u);
strcpy(reason, english(1859)); /* a�b = �(a^2b) if a�0 */
return 0;
}
/*_________________________________________________________________*/
MEXPORT_ALGEBRA int fractexps(term t, term *ans)
/* ans points to an array of 3 terms. If t contains fractional
exponents, fill this array, or an initial segment of it,
with the (first n) distinct fractional exponents contained in t.
Example: if t = x^(1/2) + x^1/3 + x^(-1/2), then
*ans will be returned containing [1/2,1/3,-1/2].
The return value is the dimension of *ans at exit, i.e. the
number of distinct fractional exponents in t or 3, whichever
*/
{ int count;
int i,j,k;
unsigned short n,f;
term base,power;
term temp[3];
term temp2[3];
f = FUNCTOR(t);
n = ARITY(t);
if(ATOMIC(t))
return 0;
if(f == '^' && SIGNEDFRACTION(ARG(1,t)))
{ base = ARG(0,t);
power = ARG(1,t);
ans[0] = power;
k = fractexps(base,temp);
for(j=0;j<k;j++)
{ if(equals(temp[j],power))
break;
}
if(j<k)
{ /* duplicate power */
for(j=0;j<k;j++)
ans[j] = temp[j];
return k;
}
/* not a duplicate power */
ans[0] = power;
for(j=1;j<=k && j < 3;j++)
{ ans[j] = temp[j-1];
}
return k == 3 ? 3 : k+1;
}
count = 0;
for(i=0;i<n;i++)
{ k = fractexps(ARG(i,t),temp);
if(k == 0)
continue;
if(count == 0)
{ for(j=0;j<k;j++)
ans[j] = temp[j];
count = k;
continue;
}
/* see if there are duplicates in ans[0]...ans[count]
and temp[0]...temp[k] */
for(j=0;j<3;j++)
temp2[j] = ans[j];
count = merge(temp2,count,temp,k,ans,3);
}
return count;
}
/*___________________________________________________________________*/
static int merge(term *a, int na, term *b, int nb, term *ans, int nans)
/* a and b are arrays of terms of dimension na and nb respectively.
ans is an array of dimension nans. Fill ans with the union
of a and b, making sure not to put duplicate entries in *ans.
or as many of the elements of the union as will fit in dimension nans;
return the final dimension of *ans, i.e. how many elements have
been placed in *ans. It is presumed that a and b have no duplicate
entries.
*/
{ int i,j,count=0;
for(i=0;i<na && i < nans;i++)
{ ans[i] = a[i];
++count;
}
if(count == nans)
return nans; /* array is already full. */
for(i=0;i<nb && count < nans;i++)
{ for(j=0;j<count;j++)
{ if(equals(b[i],ans[j]))
break;
}
if(j < count)
continue; /* a duplicate */
ans[count] = b[i];
++count;
if(count == nans)
return nans;
}
return count;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists