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
*/
#define ALGEBRA_DLL
#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"
/*_____________________*/
MEXPORT_ALGEBRA int rootsimp(term t, term arg, term *next, char *reason)
/* ��(a�b) = a ��b if a�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)); /* ��(a�)=a if n odd */
else
strcpy(reason, english(454)); /* ��(a�)=a if a�0 */
}
else if(ONE(in))
{ temp = out;
strcpy(reason, english(455));
/* ��(a�)=a if a�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));
/* ��(a�b)=a ��b (n odd) */
else
strcpy(reason, english(457));
/* ��(a�b)=a ��b if a�0 */
}
else
strcpy(reason, english(458));
/* ��(a�b)= a ��b if a�0 or n odd */
}
if(status(rootsimp)==WELLKNOWN)
err = value(temp,next);
else
err = 1;
if(err)
*next = temp;
HIGHLIGHT(*next);
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA 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;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int productofroots(term t, term arg, term *next, char *reason)
/* ��x ��y = ��(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 = check(le(zero,x));
if(err)
{ condition_fails:
errbuf(0, english(463)); /* ��x ��y = ��(xy) */
errbuf(1, english(462)); /* requires x�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 = check(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, english(463));
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 = check(le(zero,y));
if(err)
goto condition_fails;
}
HIGHLIGHT(*next);
strcpy(reason,english(463));
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 � */
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 = check(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, english(463));
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, english(463));
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA 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 = check(le(zero,x));
if(err)
{ errbuf(0,english(464)); /* ��(ab) = ��a ��b */
errbuf(1, english(465)); /* requires a�0 and b�0 */
RELEASE(*next);
return 1;
}
}
ARGREP(*next,i,make_root(index,x));
}
HIGHLIGHT(*next);
strcpy(reason,english(464));
release(rootofquotient); /* possibly inhibited by powereqn */
return 0;
}
/*_____________________________________________________________________*/
static const char *root_reason(term index)
/* reason strings for powerofroot etc */
{ if(get_complex())
return "$(��a)�=a$";
else if (ISINTEGER(index) && ISODD(index))
return english(756); /* (��a)�=a if n is odd */
else
return english(757); /* (��a)�=a (if defined) */
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int powerofroot(term t, term arg, term *next, char *reason)
/* (��a)^(nm) = a^m if ��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 = (��u)� */
{ *next = u;
HIGHLIGHT(*next);
strcpy(reason, root_reason(index));
if(get_polyvaldomainflag())
{ err = check(domain(t));
if(err)
return 1;
}
return 0;
}
strcpy(reason,"$(��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 = check(domain(t));
if(err)
return 1;
}
strcpy(reason,root_reason(index));
return 0;
}
}
return 1;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA 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 = (��u)� */
{ *next = u;
HIGHLIGHT(*next);
strcpy(reason,root_reason(index));
if(get_polyvaldomainflag())
{ err = check(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 = check(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,"$(��a)^m = ��(a^m)$");
HIGHLIGHT(*next);
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA 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 = (��u)� */
{ *next = u;
HIGHLIGHT(*next);
strcpy(reason,root_reason(index));
if(get_polyvaldomainflag())
{ err = check(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,"$(��a)^m = ��(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,"$(��a)^(qn+r) = a^q ��(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 = check(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 = check(domain(t));
if(err)
return 1;
}
strcpy(reason,"$(��a)^(qn+r)=a^q��(a^r)$");
return 0;
}
return 1;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA 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,"$��(a�) = a$");
if(isodd(index))
return 0;
err = check(le(zero,ARG(0,u)));
if(err)
{ errbuf(0, english(339));
/* In ��(a�) = a, a must be nonnegative. */
return 1;
}
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA 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 */
/* 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),q),le(q,pi)));
if(err)
return 1;
}
*next = make_power(make_root(index,ARG(0,u)),m);
strcpy(reason,"$��a^m = (��a)^m$");
if(isodd(index))
return 0;
err = check(le(zero,ARG(0,u)));
if(err)
{ errbuf(0, english(1514));
/* In ��a^m, a must be nonnegative. */
return 1;
}
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA 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),q),le(q,pi)));
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,"$��(a^(mn)) = a^m$");
if(isodd(index) || iseven(m))
return 0;
err = check(le(zero,ARG(0,u)));
if(err)
return 1; /* An error message would be long and confusing */
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA 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,"$��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, "$^2��(a�) = �a$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int rootofpower4(term t, term arg, term *next, char *reason)
/* root(mn,a�) = 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,"$��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, "$^2��(a�) = �a$");
return 0;
}
*next = make_root(newindex,x);
HIGHLIGHT(*next);
strcpy(reason,"$^(mn)�x�) = ^m�x)$"); /* SymbolTextOut handles roots written this way */
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int roottosqrt(term t, term arg, term *next, char *reason)
/* ^2�x= �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,"$^2�a = �a$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int rootofminus(term t, term arg, term *next, char *reason)
/* ��(-a) = -��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 = check(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)); /* ��(-a) = -��a, n odd */
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA 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);
check(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,"$��(a/b)=��a/��b$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA 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) (�2/�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,"$��a/��b=��(a/b)$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int rootexp(term t, term arg, term *next, char *reason)
/* ��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,"$��x = x^(1/n)$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int rootpowerexp(term t, term arg, term *next, char *reason)
/* ��(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,"$��(x^m) = x^(m/n)$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int powerrootexp(term t, term arg, term *next, char *reason)
/* (��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,"$(��x)^m = x^(m/n)$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int powersqrtexp(term t, term arg, term *next, char *reason)
/* (�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, "$(�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,"$(�x)^m = x^(m/2)$");
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int rootexpdenom(term t, term arg, term *next, char *reason)
/* 1/��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/��x = x^(-1/n)$");
return 0;
}
/*_____________________________________________________________*/
MEXPORT_ALGEBRA int cancelroot3(term t, term arg, term *next, char *reason)
/* ��(xy)/��y = �x */
/* 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_roots(t,next);
if(err)
return 1;
if(FRACTION(*next))
strcpy(reason, english(1338)); /* cancel under �� */
else
strcpy(reason,"$��(xy)/��y = ��x$");
HIGHLIGHT(*next);
return 0;
}
/*________________________________________________________________________*/
MEXPORT_ALGEBRA 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, "$�(�x) = ^4�x$");
return 0;
}
/*________________________________________________________________________*/
MEXPORT_ALGEBRA 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,"$�(��x) = ^2��x$");
return 0;
}
/*________________________________________________________________________*/
MEXPORT_ALGEBRA 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, "$��(�x) = ^2��x$");
return 0;
}
/*________________________________________________________________________*/
MEXPORT_ALGEBRA 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, "$��(^m�x) = �^m�x$");
return 0;
}
/*______________________________________________________________*/
MEXPORT_ALGEBRA 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(��b)=��(a�b)(n odd) */
return 0;
}
/*______________________________________________________________*/
MEXPORT_ALGEBRA 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(��b)=��(a�b) (a�0) */
return 0;
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int pushminusunderroot(term t, term arg, term *next, char *reason)
/* -��a = ��(-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));
/* -��a = ��(-a) if n odd */
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int powerofroot4(term t, term arg, term *next, char *reason)
/* (^m��a)� = ^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, "$(^2��a)� = �a$");
HIGHLIGHT(*next);
SetShowStepOperation(powerofroot5);
return 0;
}
*next = make_root(m,u);
strcpy(reason,"$^m��a)� = ^m�a$");
HIGHLIGHT(*next);
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int powerofroot5(term t, term arg, term *next, char *reason)
/* (^m��a)� = ^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 || !equals(m,two))
return 1;
*next = make_sqrt(u);
strcpy(reason, "$(^2��a)� = �a$");
HIGHLIGHT(*next);
return 0;
}
/*_________________________________________________________________*/
MEXPORT_ALGEBRA int rootdenom(term t, term arg, term *next, char *reason)
/* a/��b = ��(a�/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/��b = ��(a�/b) (n odd or a�0) */
return 0;
}
/*_________________________________________________________________*/
MEXPORT_ALGEBRA int rootnum(term t, term arg, term *next, char *reason)
/* ��a/b = ��(a/b�) (n odd or b�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));
/* ��a/b = ��(a/b�) (n odd or b�0) */
return 0;
}
/*_________________________________________________________________*/
MEXPORT_ALGEBRA int sqrtnum(term t, term arg, term *next, char *reason)
/* �a/b = �(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));
/* �a/b = �(a/b^2) if b�0 */
return 0;
}
/*_________________________________________________________________*/
MEXPORT_ALGEBRA int sqrtdenom(term t, term arg, term *next, char *reason)
/* a/�b = �(a^2/b) if a�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/�b = �(a^2/b) if a�0 */
return 0;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists