Sindbad~EG File Manager
/* Root operators for MathXpert
M. Beeson
original date 12.24.90
Last modified 2.28.98
Modified 6.23.04, corrected rootofpower5, rootofpower, rootofpower3 for complex arguments
5.29.13 eliminated all OEM characters from this file (reasons and comments)
10.29.23 there were still some! and also, used \\supn\\sqrt a for root(n,a)
4.24.24 put root(n,a) back inside $$
4.25.24 put x^(1/n) and x^m/n in display math
11.9.24 put roottosqrt in display math
*/
#include <string.h>
#include <assert.h>
#include "globals.h"
#include "ops.h"
#include "probtype.h"
#include "order.h"
#include "cancel.h"
#include "prover.h"
#include "radsimp.h"
#include "symbols.h"
#include "sqrtfrac.h"
#include "pvalaux.h" /* isodd, isinteger */
#include "mathmode.h" /* get_mathmode */
#include "errbuf.h"
#include "advfact.h" /* nthroot_aux */
#include "autosimp.h" /* SetShowStepOperation */
#include "deval.h"
#include "simpprod.h" /* square */
#include "dcomplex.h" /* ceval needs this */
#include "ceval.h" /* complexnumerical */
#include "nfactor.h"
/*_____________________*/
int rootsimp(term t, term arg, term *next, char *reason)
/* root(n,a^n b) = a root(n,b) if a \ge 0 or n odd */
/* also root(n,a^(nm)) = a^m */
/* also root(n,a^(nm) b) = a^m root(n,b) */
/* if wellknown, will handle an integer under the root as well */
{ int err;
term out,in,temp,mid,u,index;
unsigned nfactors;
if(FUNCTOR(t) != ROOT)
return 1;
u = ARG(1,t);
index = ARG(0,t);
if( (ISINTEGER(u) && get_mathmode() == MENUMODE) ||
status(rootsimp) == WELLKNOWN
)
{ err = factor_integer(u,&nfactors,&mid);
if(!err)
return rootsimp(make_root(index,mid),arg,next,reason);
}
err = radsimpaux(index,u,&out,&in);
if(err)
return 1;
if(ONE(in) && ISINTEGER(index))
{ temp = out;
if(INTDATA(index) & 1)
strcpy(reason, english(453)); /* "$$root(n,b^n)=b$$ (n odd)", */
else
strcpy(reason, "$$root(n,b^n)=b$$ ($b\\ge 0$)" );
}
else if(ONE(in))
{ temp = out;
strcpy(reason, english(455));
/* root(n,a^n) = a if a \ge 0 or n odd */
}
/* Now there will be something under the root sign */
else
{ temp = product(out, make_root(index,in));
if(ISINTEGER(index))
{ if(INTDATA(index) & 1)
strcpy(reason, english(456));
/* root(n,a^nb)=a root(n,b) (n odd) */
else
strcpy(reason, "$$root(n,c^nb)=c root(n,b)$$ ($c\\ge 0$)");
}
else
strcpy(reason, english(458));
/* root(n,a^nb)= a root(n,b) if a\ge 0 or n odd */
}
if(status(rootsimp)==WELLKNOWN)
err = value(temp,next);
else
err = 1;
if(err)
*next = temp;
HIGHLIGHT(*next);
return 0;
}
/*_____________________________________________________________________*/
int computeroot(term t, term arg, term *next, char *reason)
{ int err;
if(FUNCTOR(t) != ROOT && FUNCTOR(t) != SQRT) /* works on sqrt too */
return 1;
infer(domain(t)); /* domain errors such as sqrt(-1) won't result in
nonzero return by deval(); */
if(get_complex())
{ if(!complexnumerical(t))
{ errbuf(0,english(1366));
/* Root to be computed must not contain variables. */
return 1;
}
err = cevalop(t,arg,next,reason);
if(err)
return 1;
strcpy(reason, english(459)); /* compute complex root */
return 0;
}
if(!seminumerical(t))
{ errbuf(0,english(1366));
/* Root to be computed must not contain variables. */
return 1;
}
err = devalop(t,arg,next,reason);
if(err)
return 1; /* non-evaluable functor encountered */
if(FUNCTOR(t)==SQRT)
strcpy(reason, english(460)); /* compute square root */
else
strcpy(reason, english(461)); /* compute root */
return 0;
}
/*_____________________________________________________________________*/
int productofroots(term t, term arg, term *next, char *reason)
/* root(n,x) root(n,y) = root(n,xy) */
/* This law is only valid when x>0 and y>0, or n is odd */
/* If you change this, change productofroots2 in lcm.c also */
{ int i,j;
term temp,rest,x,y;
unsigned short mark,n,k;
int err;
term index;
int oddflag = 0;
if(FUNCTOR(t) != '*')
return 1;
n = ARITY(t);
mark = 0;
/* find the first ROOT among the factors of t */
while( mark < n && FUNCTOR(ARG(mark,t)) != ROOT)
++mark;
if(mark == n)
return 1; /* no roots, operator inapplicable */
if(mark == n-1)
return 1; /* only last arg is a root, operator inapplicable */
if(mark == n-2 &&
(FUNCTOR(ARG(n-1,t)) != ROOT || !equals(ARG(0,ARG(n-1,t)),ARG(0,ARG(mark,t))))
)
return 1; /* for example root(3,x) root(5,x) */
/* Now go through the rest of the args of t,
collect all the roots with this index, and make one root out of it */
index = ARG(0,ARG(mark,t));
/* Is the index even or odd? */
if(OBJECT(index) && TYPE(index) == INTEGER) /* it must be an integer */
{ oddflag = (int) (INTDATA(index) & 1);
}
/* else it's a symbolic index, but it might be 2n+1, for example */
else
{ err = infer(odd(index));
if(!err)
oddflag = 1;
}
x = ARG(1,ARG(mark,t));
if(!oddflag)
{ err = check1(le(zero,x));
if(err)
{ condition_fails:
errbuf(0, "$$root(n,x)root(n,y) = root(n,xy)$$");
errbuf(1, english(462)); /* requires x \ge 0 for even n */
return 1;
}
}
if(mark == n-2 && n>2) /* and last arg IS a root with this index*/
{ *next = make_term('*',(unsigned short)(n-1));
for(i=0;i<n-2;i++)
ARGREP(*next,i,ARG(i,t));
y = ARG(1,ARG(n-1,t));
if(!oddflag)
{ err = check1(le(zero,y));
if(err)
goto condition_fails;
}
ARGREP(*next,n-2,make_root(index,product(ARG(1,ARG(n-2,t)),y )));
HIGHLIGHT(ARG(n-2,*next));
strcpy(reason, "$$root(n,x)root(n,y) = root(n,xy)$$");
return 0;
}
if(n==2)
{ y = ARG(1,ARG(1,t));
*next = make_root(index,product(ARG(1,ARG(0,t)),y));
if(!oddflag)
{ err = check1(le(zero,y));
if(err)
goto condition_fails;
}
HIGHLIGHT(*next);
strcpy(reason,"$$root(n,x)root(n,y) = root(n,xy)$$");
return 0;
}
/* Now n > 2 and there are at least two more args after the first root */
temp = make_term('*',(unsigned short)(n-mark)); /* the product to go under \sqrt */
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)) == ROOT && equals(ARG(0,ARG(i,t)),index))
{ y = ARG(1,ARG(i,t));
if(!oddflag)
{ err = check1(le(zero,y));
if(err)
{ RELEASE(temp);
RELEASE(rest);
goto condition_fails;
}
}
ARGREP(temp,k,y);
++k;
}
else
{ ARGREP(rest,j,ARG(i,t));
++j;
}
}
if(k==1) /* only one root with this index */
{ RELEASE(temp);
RELEASE(rest);
return 1;
}
if(k==n) /* all factors were roots with correct index */
{ *next = make_root(index,temp);
RELEASE(rest);
strcpy(reason, "$$root(n,x)root(n,y) = root(n,xy)$$");
HIGHLIGHT(*next);
return 0;
}
*next = make_term('*',(unsigned short)(n-k+1));
SETFUNCTOR(temp,'*',k);
for(i=0;i<mark;i++)
ARGREP(*next,i,ARG(i,t));
ARGREP(*next,mark,make_root(index,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 free temp.args, temp has been used! */
strcpy(reason, "$$root(n,x)root(n,y) = root(n,xy)$$");
return 0;
}
/*_____________________________________________________________________*/
int rootofproduct(term t, term arg, term *next, char *reason)
/* If you change this, change rootofproduct2 in lcm.c also */
{ int i,err;
unsigned short n;
term u,index,x;
int oddflag = 0;
if (FUNCTOR(t) != ROOT)
return 1;
if (FUNCTOR(ARG(1,t)) != '*')
return 1;
u = ARG(1,t);
index = ARG(0,t);
if(OBJECT(index) && TYPE(index) == INTEGER)
{ oddflag = (int) (INTDATA(index) & 1);
}
n = ARITY(u);
*next = make_term('*',n);
for(i=0;i<n;i++)
{ x = ARG(i,u);
if(!oddflag)
{ err = check1(le(zero,x));
if(err)
{ errbuf(0,"$$root(n,ab) = root(n, a) root(n,b)$$");
errbuf(1, english(465)); /* requires a \ge 0 and b \ge 0 */
RELEASE(*next);
return 1;
}
}
ARGREP(*next,i,make_root(index,x));
}
HIGHLIGHT(*next);
strcpy(reason,"$$root(n,ab) = root(n, a) root(n,b)$$");
release(rootofquotient); /* possibly inhibited by powereqn */
return 0;
}
/*_____________________________________________________________________*/
static const char *root_reason(term index)
/* reason strings for powerofroot etc */
{ if(get_complex())
return "$(\\supn\\sqrt a)^n=a$";
else if (ISINTEGER(index) && ISODD(index))
return english(756); /*"$(^n\\root c)^n=c$ if n is odd" */
else
return english(757); /* "$(^n\\root c)^n=c$ (if defined)" */
}
/*_____________________________________________________________________*/
int powerofroot(term t, term arg, term *next, char *reason)
/* (root(n,a))^(nm) = a^m if root(n,a) defined*/
{ term u,n,index;
int err;
if(FUNCTOR(t) != '^')
return 1;
if(FUNCTOR(ARG(0,t)) != ROOT)
return 1;
u = ARG(1,ARG(0,t));
index = ARG(0,ARG(0,t));
n = ARG(1,t);
if(equals(index,n))
/* so t = root(n,u)^n */
{ *next = u;
HIGHLIGHT(*next);
strcpy(reason, root_reason(index));
if(get_polyvaldomainflag())
{ err = check1(domain(t));
if(err)
return 1;
}
return 0;
}
strcpy(reason,"$$(root(n,a))^(mn) = a^m$$");
if(INTEGERP(n) && INTEGERP(index))
{ term q,r;
intdivide(n,index,&q,&r);
if(!ZERO(r))
return 1;
*next = make_power(u,q);
HIGHLIGHT(*next);
strcpy(reason,root_reason(index));
return 0;
}
else if (FUNCTOR(n) == '*' && status(powerofroot) > LEARNING)
/* check if the 'index' will cancel */
{ term temp,cancelled;
err = cancel(n,index,&cancelled,&temp);
if(!err && equals(cancelled,index))
{ *next = make_power(u,temp);
HIGHLIGHT(*next);
if(get_polyvaldomainflag())
{ err = check1(domain(t));
if(err)
return 1;
}
strcpy(reason,root_reason(index));
return 0;
}
}
return 1;
}
/*_____________________________________________________________________*/
int powerofroot2(term t, term arg, term *next, char *reason)
/* root(n,a)^m = root(n,a^m) if root(n,a) defined*/
/* If n divides m, it does what powerofroot does */
/* Works in automode only when m < n */
{ term u,n,index,temp,under;
int err;
if(FUNCTOR(t) != '^')
return 1;
if(FUNCTOR(ARG(0,t)) != ROOT)
return 1;
u = ARG(1,ARG(0,t));
index = ARG(0,ARG(0,t));
n = ARG(1,t);
if(equals(index,n))
/* so t = (root(n,u)^n */
{ *next = u;
HIGHLIGHT(*next);
strcpy(reason,root_reason(index));
if(get_polyvaldomainflag())
{ err = check1(domain(t));
if(err)
return 1;
}
return 0;
}
if(INTEGERP(n) && INTEGERP(index))
{ term q,r;
intdivide(n,index,&q,&r);
if(ZERO(r))
{ *next = make_power(u,q);
HIGHLIGHT(*next);
strcpy(reason,root_reason(index));
SetShowStepOperation(powerofroot);
return 0;
}
if(!ZERO(q) && get_mathmode() == AUTOMODE)
return 1;
}
else if (FUNCTOR(n) == '*')
{ term temp,cancelled;
err = cancel(n,index,&cancelled,&temp);
if(err || !equals(cancelled,index))
return 1;
*next = make_power(u,temp);
HIGHLIGHT(*next);
if(get_polyvaldomainflag())
{ err = check1(domain(t));
if(err)
return 1;
}
strcpy(reason,root_reason(index));
SetShowStepOperation(powerofroot);
return 0;
}
temp = make_power(u,n);
if(status(powerofroot)==WELLKNOWN) /*then do arithmetic */
{ err = value(temp,&under);
if(err)
under = temp;
}
else
under = temp;
*next = make_root(index,under);
strcpy(reason,"$$(root(n,a))^m = root(n, a^m)$$");
HIGHLIGHT(*next);
return 0;
}
/*_____________________________________________________________________*/
int powerofroot3(term t, term arg, term *next, char *reason)
/* root(n,a)^(qn+r) = a^q root(n,a^r) */
{ term u,n,index;
int err;
if(FUNCTOR(t) != '^')
return 1;
if(FUNCTOR(ARG(0,t)) != ROOT)
return 1;
u = ARG(1,ARG(0,t));
index = ARG(0,ARG(0,t));
n = ARG(1,t);
if(equals(index,n))
/* so t = root(n,u)^n */
{ *next = u;
HIGHLIGHT(*next);
strcpy(reason,root_reason(index));
if(get_polyvaldomainflag())
{ err = check1(domain(t));
if(err)
return 1;
}
SetShowStepOperation(powerofroot);
return 0;
}
if(INTEGERP(n) && INTEGERP(index))
{ term q,r,under,temp;
intdivide(n,index,&q,&r);
if(ZERO(r))
{ *next = make_power(u,q);
HIGHLIGHT(*next);
strcpy(reason, root_reason(index));
return 0;
}
if(ZERO(q))
{ temp = make_power(u,r);
if(status(powerofroot)==WELLKNOWN) /*then do arithmetic */
{ err = value(temp,&under);
if(err)
under = temp;
}
else
under = temp;
*next = make_root(index,under);
strcpy(reason,"$(\\supn\\sqrt a)^m = \\supn\\sqrt(a^m)$"); /* same as rootpower2 */
SetShowStepOperation(powerofroot2);
HIGHLIGHT(*next);
return 0;
}
else
*next = product(make_power(u,q),make_root(index,make_power(u,r)));
/* in this case don't do arithmetic even if the op is wellknown */
HIGHLIGHT(*next);
strcpy(reason,"$$(root(n,a))^(qn+r) = a^q root(n,a^r)$$");
return 0;
}
/* Now index or n is not an integer */
if (FUNCTOR(n) == '*')
/* check if the 'index' will cancel */
{ term temp,cancelled;
err = cancel(n,index,&cancelled,&temp);
if(!err && equals(cancelled,index))
{ *next = make_power(u,temp);
HIGHLIGHT(*next);
if(get_polyvaldomainflag())
{ err = check1(domain(t));
if(err)
return 1;
}
strcpy(reason, root_reason(index));
return 0;
}
else
return 1;
}
if (FUNCTOR(n) == '+' && ARITY(n) == 2)
/* check for n = q index + r */
{ term temp,cancelled;
err = cancel(ARG(0,n),index,&cancelled,&temp);
if(err || !equals(cancelled,index))
return 1;
*next = product(make_power(u,temp),make_root(index,make_power(u,ARG(1,n))));
HIGHLIGHT(*next);
if(get_polyvaldomainflag())
{ err = check1(domain(t));
if(err)
return 1;
}
strcpy(reason,"$$((root(n,a))^(qn+r)=a^q root(n,a^r)$$");
return 0;
}
return 1;
}
/*_____________________________________________________________________*/
int rootofpower(term t, term arg, term *next, char *reason)
/* root(n,a^n) = a if n is odd or a>= 0 */
/* doesn't work if get_complex unless a >= 0, e.g. root(3,-1) is not -1 then */
{ term u,index;
int err;
if(FUNCTOR(t) != ROOT)
return 1;
u = ARG(1,t);
if(FUNCTOR(u) != '^')
return 1;
if(get_complex())
{ err = infer(le(zero,u));
if(err)
return 1;
}
index = ARG(0,t);
assert(!ZERO(index));
if(!equals(index,ARG(1,u)))
return 1;
*next = ARG(0,u);
strcpy(reason,"$^n\\root (a^n) = a$");
if(isodd(index))
return 0;
err = check1(le(zero,ARG(0,u)));
if(err)
{ errbuf(0, english(339));
/* In root(n,a^n) = a, a must be nonnegative. */
return 1;
}
return 0;
}
/*_____________________________________________________________________*/
int rootofpower5(term t, term arg, term *next, char *reason)
/* root(n,a^m) = root(n,a)^m if n is odd or a>= 0 (for a real and m real) */
/* If a is real it needs -pi < Im(m) <= pi_term */
/* If a is not real, it fails. */
{ term u,index;
int err;
term m;
if(FUNCTOR(t) != ROOT)
return 1;
u = ARG(1,t);
if(FUNCTOR(u) != '^')
return 1;
index = ARG(0,t);
assert(!ZERO(index));
m = ARG(1,u);
if(get_complex())
{ term p,q;
term a = ARG(0,u);
if(is_complex(a))
return 1;
err = infer(type(a,R));
if(err)
return 1;
err = complexparts(m,&p,&q);
if(err)
return 1;
err = infer(and(lessthan(tnegate(pi_term),q),le(q,pi_term)));
if(err)
return 1;
}
*next = make_power(make_root(index,ARG(0,u)),m);
strcpy(reason,"$$(root(n,a^m)) = (root(n,a))^m$$");
if(isodd(index))
return 0;
err = check1(le(zero,ARG(0,u)));
if(err)
{ errbuf(0, english(1514));
/* In root(n,a)^m, a must be nonnegative. */
return 1;
}
return 0;
}
/*_____________________________________________________________________*/
int rootofpower3(term t, term arg, term *next, char *reason)
/* root(n,a^(mn)) = a^m if a >= 0*/
/* there's an extra condition if mn is complex */
{ term u,index,cancelled,m;
int err;
if(FUNCTOR(t) != ROOT)
return 1;
u = ARG(1,t);
if(FUNCTOR(u) != '^')
return 1;
index = ARG(0,t);
assert(!ZERO(index));
if(!INTEGERP(index) && !isinteger(index))
return 1;
if(get_complex() && is_complex(ARG(1,u)))
{ term p,q;
term mm = ARG(1,u);
term a = ARG(0,u);
if(is_complex(a))
return 1;
err = infer(type(a,R));
if(err)
return 1;
err = complexparts(mm,&p,&q);
if(err)
return 1;
err = infer(and(lessthan(tnegate(pi_term),q),le(q,pi_term)));
if(err)
return 1;
}
err = cancel(ARG(1,u),index,&cancelled,&m);
if(err || !equals(cancelled,index))
return 1;
*next = make_power(ARG(0,u),m);
strcpy(reason,"$\\supn \\sqrt(a^(mn)) = a^m$");
if(isodd(index) || iseven(m))
return 0;
err = check1(le(zero,ARG(0,u)));
if(err)
return 1; /* An error message would be long and confusing */
return 0;
}
/*_____________________________________________________________________*/
int rootofpower2(term t, term arg, term *next, char *reason)
/* root(2n,a^n) = sqrt(a) if sqrt(a) is defined */
/* also root(mn,a^n) = root(m,a) if the right side is defined */
{ term u,index,n,cancelled,x,p,newindex,temp;
int err;
unsigned short i,j,k;
unsigned nfactors;
if(FUNCTOR(t) != ROOT)
return 1;
u = ARG(1,t);
index = ARG(0,t);
if(!isinteger(index))
return 1;
if(ONE(u))
{ *next = one;
HIGHLIGHT(*next);
strcpy(reason,"$\\supn\\sqrt 1 = 1$");
return 0;
}
if(FUNCTOR(u) == '^')
{ n = ARG(1,u);
x = ARG(0,u);
err = cancel(index,n,&cancelled,&newindex);
if(err || !equals(newindex,two))
return 1;
}
else if (INTEGERP(u))
{ err = factor_integer(u,&nfactors,&p);
if(err)
return 1;
return rootofpower2(make_root(index,p),arg,next,reason);
}
else if(FUNCTOR(u) == '*')
{ unsigned short nn = ARITY(u);
term exponents[50];
term bases[50];
/* count the number of exponents required; one for each
symbolic factor and an unknown number for each numerical factor;
if more than 50 give up. */
k=0;
for(i=0;i<nn;i++)
{ if(INTEGERP(ARG(i,u)))
{ err = factor_integer(ARG(i,u),&nfactors,&p);
if(err)
return 1;
if(k + nfactors >= 50)
{ k += nfactors;
break;
}
if(FUNCTOR(p)== '*')
{ for(j=0;j<nfactors;j++)
{ if(FUNCTOR(ARG(j,p)) != '^')
return 1;
exponents[k+j] = ARG(1,ARG(j,p));
bases[k+j] = ARG(0,ARG(j,p));
}
k += nfactors;
}
else
{ assert(nfactors==1);
if(FUNCTOR(p) != '^')
return 1; /* a prime */
exponents[k] = ARG(1,p);
bases[k] = ARG(0,p);
++k;
}
}
else
{ if(FUNCTOR(ARG(i,u)) != '^')
return 1;
exponents[k] = ARG(1,ARG(i,u));
bases[k] = ARG(0,ARG(i,u));
k++;
if(k>=50)
break;
}
}
if(k >= 50)
{ errbuf(0, english(1183));
/* Too many factors, I can't handle it. */
return 1;
}
naive_listgcd(exponents,k,&p);
if(ONE(p))
return 0;
cancel(index,p,&cancelled,&newindex);
if(!equals(newindex,two))
return 1;
cancel(exponents[i],p,&cancelled,&temp);
bases[i] = (ZERO(temp) ? one : make_power(bases[i],temp));
x = make_term('*',(unsigned short) k);
for(i=0;i<k;i++)
{ cancel(exponents[i],p,&cancelled,&temp);
ARGREP(x,i,(ZERO(temp) ? one : make_power(bases[i],temp)));
}
if(k>nn && value(x,&temp) != 1) /* some arithmetic has been done if
value returns 0 or 2 */
{ for(i=0;i<k;i++)
{ if(FUNCTOR(ARG(i,x))=='^')
RELEASE(ARG(i,x));
}
RELEASE(x);
x = temp;
}
}
else
return 1; /* only numbers, ^, and * acceptable functors for u */
assert(equals(newindex,two));
*next = make_sqrt(x);
HIGHLIGHT(*next);
strcpy(reason, "$$root(2n,a^n) = sqrt(a)$$");
return 0;
}
/*_____________________________________________________________________*/
int rootofpower4(term t, term arg, term *next, char *reason)
/* root(mn,a^n) = root(m,a) if the right side is defined */
{ term u,index,n,cancelled,x,p,newindex,temp;
int err;
unsigned short i,j,k;
unsigned nfactors;
if(FUNCTOR(t) != ROOT)
return 1;
u = ARG(1,t);
index = ARG(0,t);
if(!isinteger(index))
return 1;
if(ONE(u))
{ *next = one;
HIGHLIGHT(*next);
strcpy(reason,"$^n\\root 1 = 1$");
return 0;
}
if(FUNCTOR(u) == '^')
{ n = ARG(1,u);
x = ARG(0,u);
err = cancel(index,n,&cancelled,&newindex);
if(err || ONE(newindex) || NEGATIVE(newindex))
return 1; /* failure */
if(!isinteger(newindex))
return 1;
}
else if (INTEGERP(u))
{ err = factor_integer(u,&nfactors,&p);
if(err)
return 1;
return rootofpower4(make_root(index,p),arg,next,reason);
}
else if(FUNCTOR(u) == '*')
{ unsigned short nn = ARITY(u);
term exponents[50];
term bases[50];
/* count the number of exponents required; one for each
symbolic factor and an unknown number for each numerical factor;
if more than 50 give up. */
k=0;
for(i=0;i<nn;i++)
{ if(INTEGERP(ARG(i,u)))
{ err = factor_integer(ARG(i,u),&nfactors,&p);
if(err)
return 1;
if(k + nfactors >= 50)
{ k += nfactors;
break;
}
if(FUNCTOR(p)== '*')
{ for(j=0;j<nfactors;j++)
{ if(FUNCTOR(ARG(j,p)) != '^')
return 1;
exponents[k+j] = ARG(1,ARG(j,p));
bases[k+j] = ARG(0,ARG(j,p));
}
k += nfactors;
}
else
{ assert(nfactors==1);
if(FUNCTOR(p) != '^')
return 1; /* a prime */
exponents[k] = ARG(1,p);
bases[k] = ARG(0,p);
++k;
}
}
else
{ if(FUNCTOR(ARG(i,u)) != '^')
return 1;
exponents[k] = ARG(1,ARG(i,u));
bases[k] = ARG(0,ARG(i,u));
k++;
if(k>=50)
break;
}
}
if(k >= 50)
{ errbuf(0, english(1183));
/* Too many factors, I can't handle it. */
return 1;
}
naive_listgcd(exponents,k,&p);
if(ONE(p))
return 0;
cancel(index,p,&cancelled,&newindex);
if(ONE(newindex))
return 1;
cancel(exponents[i],p,&cancelled,&temp);
bases[i] = (ZERO(temp) ? one : make_power(bases[i],temp));
x = make_term('*',(unsigned short)k);
for(i=0;i<k;i++)
{ cancel(exponents[i],p,&cancelled,&temp);
ARGREP(x,i,(ZERO(temp) ? one : make_power(bases[i],temp)));
}
if(k>nn && value(x,&temp) != 1) /* some arithmetic has been done if
value returns 0 or 2 */
{ for(i=0;i<k;i++)
{ if(FUNCTOR(ARG(i,x))=='^')
RELEASE(ARG(i,x));
}
RELEASE(x);
x = temp;
}
}
else
return 1; /* only numbers, ^, and * acceptable functors for u */
if(equals(newindex,two))
{ *next = make_sqrt(x);
HIGHLIGHT(*next);
strcpy(reason, "$$ root(2n,a^n) sqrt(a)$$");
return 0;
}
*next = make_root(newindex,x);
HIGHLIGHT(*next);
strcpy(reason,"$$ root(mn,a^n) = root(m,a)$$");
return 0;
}
/*_____________________________________________________________________*/
int roottosqrt(term t, term arg, term *next, char *reason)
/* root(2,x)= \sqrt x */
{ if(FUNCTOR(t) != ROOT)
return 1;
if(!(OBJECT(ARG(0,t)) && TYPE(ARG(0,t)) == INTEGER && INTDATA(ARG(0,t)) == 2))
return 1;
*next = make_sqrt(ARG(1,t));
HIGHLIGHT(*next);
strcpy(reason,"$$root(2,x) = sqrt(x)$$");
return 0;
}
/*_____________________________________________________________________*/
int rootofminus(term t, term arg, term *next, char *reason)
/* root(n,-a) = -root(n,a), n odd */
{ term n,a,u,w;
int err;
unsigned short path[5];
if(FUNCTOR(t) != ROOT)
return 1;
n = ARG(0,t);
err = check1(odd(n));
if(err)
return 1;
u = ARG(1,t);
if(FUNCTOR(u) == '+' && NEGATIVE(ARG(0,u)) &&
!pullminusout(u,zero,&w,reason)
)
{ /* root(3,-a-b) = root(3,-(a+b)) */
*next = make_root(n,w);
SetShowStepOperation(pullminusout);
path[0] = ROOT;
path[1] = 2;
path[2] = 0;
set_pathtail(path);
return 0;
}
if(seminumerical(u) && !NEGATIVE(u))
{ double z;
deval(u,&z);
if(z < 0.0)
{ a = strongnegate(u);
goto out;
}
}
if(!NEGATIVE(u))
return 1;
a = ARG(0,ARG(1,t));
out:
*next = tnegate(make_root(n,a));
HIGHLIGHT(*next);
strcpy(reason, english(2147)); /* \\supn\\sqrt (-a) = -root(n,a), n odd */
return 0;
}
/*_____________________________________________________________________*/
int rootofquotient(term t, term arg, term *next, char *reason)
{ term a,b,roota,rootb,m;
int err;
if(FUNCTOR(t) != ROOT)
return 1;
if(FUNCTOR(ARG(1,t)) != '/')
return 1;
a = ARG(0,ARG(1,t));
b = ARG(1,ARG(1,t));
m = ARG(0,t);
check1(or(odd(m),and(nonnegative(a),nonnegative(b))));
err = nthroot_aux(a,m,&roota);
if(err)
roota = make_root(m,a);
err = nthroot_aux(b,m,&rootb);
if(err)
rootb = make_root(m,b);
err = infer(domain(roota));
if(err)
return 1;
err = infer(domain(rootb));
if(err)
{ errbuf(0,english(1529));
/* Cannot infer that new root(s) would be defined. */
return 1;
}
if(status(rootofquotient)<=LEARNING)
{ roota = ONE(a) ? one : make_root(m,a);
rootb = ONE(b) ? one : make_root(m,b);
}
*next = make_fraction(roota,rootb);
HIGHLIGHT(*next);
strcpy(reason,"$\\supn\\sqrt(a/b)=\\supn\\sqrt a/\\supn\\sqrt b$");
return 0;
}
/*_____________________________________________________________________*/
int quotientofroots(term t, term arg, term *next, char *reason)
{ term index;
int err;
term temp;
if(FUNCTOR(t) == '*' && ARITY(t) == 2)
{ if(RATIONALP(ARG(0,t))) /* (1/2) (sqrt(2)/sqrt(3)) for example */
{ err = quotientofroots(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)) != ROOT)
return 1;
if(FUNCTOR(ARG(1,t)) != ROOT)
return 1;
index = ARG(0,ARG(0,t));
if(!equals(index,ARG(0,ARG(1,t))))
return 1;
*next = make_root(index,make_fraction(ARG(1,ARG(0,t)),ARG(1,ARG(1,t))));
HIGHLIGHT(*next);
strcpy(reason,"$^n\\root a/^n\\sqrt b=^n\\root(a/b)$");
return 0;
}
/*_____________________________________________________________________*/
int rootexp(term t, term arg, term *next, char *reason)
/* root(n,x) = x^(1/n) */
{ term n,x;
if(FUNCTOR(t) != ROOT)
return 1;
n = ARG(0,t);
x = ARG(1,t);
*next = make_power(x,make_fraction(one,n));
HIGHLIGHT(*next);
strcpy(reason,"$$root(n,x) = x^(1/n)$$");
return 0;
}
/*_____________________________________________________________________*/
int rootpowerexp(term t, term arg, term *next, char *reason)
/* root(n,x^m) = x^(m/n) */
{ term n,m,x,u;
if(FUNCTOR(t) != ROOT || FUNCTOR(ARG(1,t)) != '^')
return 1;
n = ARG(0,t);
m = ARG(1,ARG(1,t));
x = ARG(0,ARG(1,t));
if(status(powerrootexp) > LEARNING)
polyval(make_fraction(m,n),&u);
else if(SIGNEDFRACTION(m))
{ mfracts(m,reciprocal(n),&u); /* root(3,2)^(1/2) = 2^((1/2)(1/3))
so we don't create a compound fraction in the exponent */
if(FUNCTOR(u) == '*')
sortargs(u);
if(NEGATIVE(u) && FUNCTOR(ARG(0,u)) == '*')
sortargs(ARG(0,u));
}
else
u = make_fraction(m,n);
*next = make_power(x,u);
HIGHLIGHT(*next);
strcpy(reason,"$$root(n,x^m) = x^(m/n)$$");
return 0;
}
/*_____________________________________________________________________*/
int powerrootexp(term t, term arg, term *next, char *reason)
/* (root(n,x))^m = x^(m/n) */
{ term n,m,x,u;
if(FUNCTOR(t) != '^')
return 1;
if(FUNCTOR(ARG(0,t)) != ROOT)
return 1;
n = ARG(0,ARG(0,t));
m = ARG(1,t);
x = ARG(1,ARG(0,t));
if(status(powerrootexp) > LEARNING)
polyval(make_fraction(m,n),&u);
else if(SIGNEDFRACTION(m))
{ mfracts(m,reciprocal(n),&u); /* root(3,2)^(1/2) = 2^((1/2)(1/3))
so we don't create a compound fraction in the exponent */
if(FUNCTOR(u) == '*')
sortargs(u);
if(NEGATIVE(u) && FUNCTOR(ARG(0,u)) == '*')
sortargs(ARG(0,u));
}
else
u = make_fraction(m,n);
*next = make_power(x,u);
HIGHLIGHT(*next);
strcpy(reason,"$$(root(n,x))^m = x^(m/n)$$");
return 0;
}
/*_____________________________________________________________________*/
int powersqrtexp(term t, term arg, term *next, char *reason)
/* (sqrt x)^m = x^(m/2) */
{ term m,x,u;
if(FUNCTOR(t) != '^')
return 1;
if(FUNCTOR(ARG(0,t)) != SQRT)
return 1;
m = ARG(1,t);
x = ARG(0,ARG(0,t));
if(equals(m,two))
{ *next = x;
HIGHLIGHT(*next);
SetShowStepOperation(powerofsqrt);
strcpy(reason, "$$(sqrt x)^2 = x$$");
return 0;
}
if(status(powersqrtexp) > LEARNING)
polyval(make_fraction(m,two),&u);
else if(SIGNEDFRACTION(m))
{ mfracts(m,reciprocal(two),&u); /* sqrt(3)^(1/2) = 3^((1/2)(1/2))
so we don't create a compound fraction in the exponent */
if(FUNCTOR(u) == '*')
sortargs(u);
if(NEGATIVE(u) && FUNCTOR(ARG(0,u)) == '*')
sortargs(ARG(0,u));
}
else
u = make_fraction(m,two);
*next = make_power(x,u);
HIGHLIGHT(*next);
strcpy(reason,"$$(sqrt(x))^m = x^(m/2)$$");
return 0;
}
/*_____________________________________________________________________*/
int rootexpdenom(term t, term arg, term *next, char *reason)
/* 1/root(n,x) = x^(-1/n) */
/* Works on quotients, calling rootexp on denominator */
{ int err;
term temp;
if(FUNCTOR(t) != '/')
return 1;
err = rootexp(ARG(1,t),arg,&temp,reason);
if(err)
return 1;
*next = make_fraction(ARG(0,t),temp);
strcpy(reason, "$1/^n\\root x = x^(-1/n)$");
return 0;
}
/*_____________________________________________________________*/
int cancelroot3(term t, term arg, term *next, char *reason)
/*root(n,xy)/root(n,y) = root(n,x) */
/* Must also work on any fraction containing powers of x as factors
of the numerator and root(n,x) as a factor in the denominator */
{ int err = cancel_roots(t,next);
if(err)
return 1;
if(FRACTION(*next))
strcpy(reason, english(1338)); /* cancel under ^n\sqrt */
else
strcpy(reason,"$$root(n,xy)/root(n,y) = root(n,x)$$");
HIGHLIGHT(*next);
return 0;
}
/*________________________________________________________________________*/
int sqrtofsqrt(term t, term arg, term *next, char *reason)
/* sqrt(sqrt x) = root(4, x) */
{ if(FUNCTOR(t) != SQRT)
return 1;
if(FUNCTOR(ARG(0,t)) != SQRT)
return 1;
*next = make_root(four,ARG(0,ARG(0,t)));
HIGHLIGHT(*next);
strcpy(reason, "$\\sqrt(\\sqrt x) = ^4\\root x$");
return 0;
}
/*________________________________________________________________________*/
int sqrtofroot(term t, term arg, term *next, char *reason)
/* sqrt(root(n, x)) = root(2n, x) */
{ term index;
if(FUNCTOR(t) != SQRT)
return 1;
if(FUNCTOR(ARG(0,t)) != ROOT)
return 1;
polyval(product(two,ARG(0,ARG(0,t))),&index);
*next = make_root(index,ARG(1,ARG(0,t)));
HIGHLIGHT(*next);
strcpy(reason,"$$ sqrt(root(n,x)) = root(2n,x)$$");
// $\\sqrt^n\\root x = ^2^n\\root x$");
return 0;
}
/*________________________________________________________________________*/
int rootofsqrt(term t, term arg, term *next, char *reason)
/* root(n,sqrt x) = root(2n, x) */
{ term index;
if(FUNCTOR(t) != ROOT)
return 1;
if(FUNCTOR(ARG(1,t)) != SQRT)
return 1;
polyval(product(two,ARG(0,t)),&index);
*next = make_root(index,ARG(0,ARG(1,t)));
HIGHLIGHT(*next);
strcpy(reason,"$$root(n,sqrt x) = root(2n, x)$$");
// "$^n\\root(\\sqrt x) = ^2^n\\root x$");
return 0;
}
/*________________________________________________________________________*/
int rootofroot(term t, term arg, term *next, char *reason)
/* root(m,root(n, x)) = root(mn, x) */
{ term index;
if(FUNCTOR(t) != ROOT)
return 1;
if(FUNCTOR(ARG(1,t)) != ROOT)
return 1;
polyval(product(ARG(0,t),ARG(0,ARG(1,t))),&index);
*next = make_root(index,ARG(1,ARG(1,t)));
HIGHLIGHT(*next);
strcpy(reason, "$$root(m,root(n, x)) = root(mn,x) $$");
// one-line display won't work as there's no superscript m
return 0;
}
/*______________________________________________________________*/
int pushunderoddroot(term t, term arg, term *next, char *reason)
/* a root(n,b) = root(a^n b) if n is odd */
{ unsigned short n;
int i,rootflag;
term u,v,m;
if(FUNCTOR(t) != '*')
return 1;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,t)) == ROOT && isodd(ARG(0,ARG(i,t))))
{ rootflag = i;
break;
}
}
if(i==n)
return 1; /* no odd root factor */
/* Now create the other factors and put them under the sqrt */
v = ARG(1,ARG(rootflag,t));
m = ARG(0,ARG(rootflag,t));
u = make_term('*',n);
for(i=0;i<n;i++)
ARGREP(u,i, i == rootflag ? v : make_power(ARG(i,t),m));
if(FUNCTOR(v) == '*')
u = topflatten(u);
*next = make_root(m,u);
strcpy(reason, english(1862)); /* "$a(^n\\sqrt b)=^n\\sqrt (a^nb)$(n odd)" */
return 0;
}
/*______________________________________________________________*/
int pushunderevenroot(term t, term arg, term *next, char *reason)
/* a root(n,b) = root(a^n b) if a >= 0 */
{ unsigned short n;
int i, err, rootflag;
term a,u,v,m;
if(FUNCTOR(t) != '*')
return 1;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,t)) == ROOT)
{ rootflag = i;
break;
}
}
if(i==n)
return 1; /* no SQRT factor */
/* First test the side condition */
if(n == 2)
a = ARG(rootflag ? 0 : 1,t);
else
{ a = make_term('*',(unsigned short)(n-1));
for(i=0;i<n-1;i++)
ARGREP(a,i,i<rootflag ? ARG(i,t) : ARG(i+1,t));
}
if(obviously_nonnegative(a))
err = 0;
else
err = infer(le(zero,a));
if(err)
{ errbuf(0, english(1861));
/* The factor outside the root must be nonnegative. */
return 0;
}
v = ARG(1,ARG(rootflag,t));
m = ARG(0,ARG(rootflag,t));
/* Now create the other factors and put them under the sqrt */
u = make_term('*',n);
for(i=0;i<n;i++)
ARGREP(u,i, i == rootflag ? v : make_power(ARG(i,t),m));
if(FUNCTOR(v) == '*')
u = topflatten(u);
*next = make_root(m,u);
strcpy(reason, english(1863)); /* "$a(^n\\sqrt b)=^n\\sqrt (a^nb)$ ($a\\ge 0$)" */
return 0;
}
/*__________________________________________________________________*/
int pushminusunderroot(term t, term arg, term *next, char *reason)
/* -root(n,a) = root(n,-a) if n odd */
{ term a,index;
if(!NEGATIVE(t))
return 1;
if(FUNCTOR(ARG(0,t)) != ROOT)
return 1;
index = ARG(0,ARG(0,t));
if(!isodd(index))
return 1;
a = ARG(1,ARG(0,t));
*next = make_root(index,tnegate(a));
HIGHLIGHT(*next);
strcpy(reason, english(1877));
/* "$-^n\\sqrt a = ^n\\sqrt (-a)$ if n odd" */
return 0;
}
/*_____________________________________________________________________*/
int powerofroot4(term t, term arg, term *next, char *reason)
/* root(mn,a^n) = root(m,a) */
{ term u,n,m,index,cancelled;
int err;
if(FUNCTOR(t) != '^')
return 1;
if(FUNCTOR(ARG(0,t)) != ROOT)
return 1;
u = ARG(1,ARG(0,t));
index = ARG(0,ARG(0,t));
n = ARG(1,t);
err = cancel(index,n,&cancelled,&m);
if(err || !isinteger(m))
return 1;
if(equals(m,two))
{ *next = make_sqrt(u);
strcpy(reason, "$$root(2n,a^n) = sqrt(a)$$");
HIGHLIGHT(*next);
SetShowStepOperation(powerofroot5);
return 0;
}
*next = make_root(m,u);
strcpy(reason,"$$ root(mn,a^n) = root(m,a)$$");
HIGHLIGHT(*next);
return 0;
}
/*_____________________________________________________________________*/
int powerofroot5(term t, term arg, term *next, char *reason)
/* root(2n,a)^2= sqrt a */
{ term u,n,m,index,cancelled;
int err;
if(FUNCTOR(t) != '^')
return 1;
if(FUNCTOR(ARG(0,t)) != ROOT)
return 1;
u = ARG(1,ARG(0,t));
index = ARG(0,ARG(0,t));
n = ARG(1,t);
err = cancel(index,n,&cancelled,&m);
if(err || !equals(m,two))
return 1;
*next = make_sqrt(u);
strcpy(reason, "$(^2^n\\root a)^n = \\sqrt a$");
HIGHLIGHT(*next);
return 0;
}
/*_________________________________________________________________*/
int rootdenom(term t, term arg, term *next, char *reason)
/* a/root(n,b) = root(n,a^n/b) (n odd or a >= 0) */
{ term num,denom,index,b;
int err;
if(!FRACTION(t))
return 1;
num = ARG(0,t);
denom = ARG(1,t);
if(FUNCTOR(denom) != ROOT)
return 1;
index = ARG(0,denom);
b = ARG(1,denom);
if(!isodd(index) && !obviously_nonnegative(num))
{ err = infer(le(zero,num));
if(err)
return 1;
}
*next = make_root(index,make_fraction(make_power(num,index),b));
HIGHLIGHT(*next);
strcpy(reason, english(1911));
/* "$a/^n\\root b = ^n\\root (a^n/b)$ (n odd or $a\\ge 0$)", */
return 0;
}
/*_________________________________________________________________*/
int rootnum(term t, term arg, term *next, char *reason)
/* root(n,a)/b = root(n,a/b^n) (n odd or b \ge 0) */
{ term num,denom,index,a;
int err;
if(!FRACTION(t))
return 1;
num = ARG(0,t);
denom = ARG(1,t);
if(FUNCTOR(num) != ROOT)
return 1;
index = ARG(0,num);
a = ARG(1,num);
if(!isodd(index) && !obviously_nonnegative(denom))
{ err = infer(le(zero,denom));
if(err)
return 1;
}
*next = make_root(index,make_fraction(a,make_power(denom,index)));
HIGHLIGHT(*next);
strcpy(reason, english(1912));
/* $^n\\root a/b = ^n\\root (a/b^n)$ (n odd or $b>0$)"*/
return 0;
}
/*_________________________________________________________________*/
int sqrtnum(term t, term arg, term *next, char *reason)
/* (sqrt a)/b = sqrt(a/b^2) if b > 0 */
{ term num,denom,a;
int err;
if(!FRACTION(t))
return 1;
num = ARG(0,t);
denom = ARG(1,t);
if(FUNCTOR(num) != SQRT)
return 1;
a = ARG(0,num);
if(!obviously_nonnegative(denom))
{ err = infer(le(zero,denom));
if(err)
return 1;
}
*next = make_sqrt(make_fraction(a,square(denom)));
HIGHLIGHT(*next);
strcpy(reason, english(1913));
/*$(\\sqrt a)/b = \\sqrt (a/b^2)$ if $b>0$"*/
return 0;
}
/*_________________________________________________________________*/
int sqrtdenom(term t, term arg, term *next, char *reason)
/* a/sqrt b = sqrt(a^2/b) if a \ge 0 */
{ term num,denom,b;
int err;
if(!FRACTION(t))
return 1;
num = ARG(0,t);
denom = ARG(1,t);
if(FUNCTOR(denom) != SQRT)
return 1;
b = ARG(0,denom);
if(!obviously_nonnegative(num))
{ err = infer(le(zero,num));
if(err)
return 1;
}
*next = make_sqrt(make_fraction(square(num),b));
HIGHLIGHT(*next);
strcpy(reason, english(1914));
/* $a/\\sqrt b = \\sqrt (a^2/b)$ if $a\\ge 0$*/
return 0;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists