Sindbad~EG File Manager
/* M. Beeson, for Mathpert
Code to simplify numerical expressions involving roots and square roots
Original date 5.29.96
Last modified 3.26.99 before version 1.624
6.17.04 removed conditional 16-bit compilation.
3.20.06 removed definition of macro SIGNEDRATIONAL since it's already in terms.h
1.15.11 modified surdsimp2 to deal with sqrt(x^{2n})
5.5.13 made duplicates static
added include surdsimp.h
9.26.14 changed return err to return r at line 338, 753, 937
*/
#include <assert.h>
#include <math.h> /* fabs */
#include "globals.h"
#include "radsimp.h" /* radsimpaux */
#include "order.h" /* additive_sortargs */
#include "simpsums.h" /* collect */
#include "pvalaux.h" /* strongnegate */
#include "nfactor.h" /* factor_long */
#include "cancel.h"
#include "lcm.h" /* productofsqrts, productofroots */
#include "deval.h"
#include "surdsimp.h"
static int surdsimp2(int flag, term t, term *ans);
static int collect_roots(term t, term *ans);
static int duplicates(long *data1, long *data2, int n);
/*________________________________________________________________*/
static int duplicates(long *data1, long *data2, int n)
/* return 1 if the arrays data1 and data2, of dimension n, contains duplicate
entries, i.e. for some i,j we have data1[i] = data1[j] and data2[i] = data2[j].
Return 0 if this doesn't happen.
We need this only for small n so there's no point writing an O(n log n)
algorithm based on sorting.
*/
{ int i,j;
for(i=0;i<n;i++)
{ for(j=i+1;j<n;j++)
{ if(data1[j] == data1[i] && data2[i] == data2[j])
return 1;
}
}
return 0;
}
/*________________________________________________________________*/
int surdsimp(term t, term *ans)
/* t should be a numerical term built up from integers using +, *, /, -,
ROOT, SQRT, and integer powers, and containing no compound fractions.
Simplify as much as possible and return the result in *ans. If the form
reached is canonical, then return 0, and set the ALREADY bit of *ans.
A canonical root is sqrt(c) where c is a square free integer or root(m,c)
where c is mth-root free. A linear combination of distinct canonical roots
(with rational coefficients) is canonical, e.g. 1 + sqrt 2 + (1/2) sqrt 3.
A rational number counts as canonical too.
A root or sqrt of a positive canonical form, or an even root of any
canonical expression if get_complex() is false, also counts as canonical.
Example: sqrt(1/2 + (1/2)sqrt 5) can't be simplified any more, and Mathpert
otherwise does a lot of thrashing around with fractional exponents and common
denoms on such expressions.
For the time being nothing else is canonical.
Canonical forms are those for which no further simplification
could possibly be successful; they will be PROTECTED by polyval.
If the result *ans is not canonical, return 1. At present
this function is rather weak. It can't handle, for example,
1/(1+sqrt 2 + sqrt 3). It does, however, handle all rational
functions of one square root.
sqrt(3)/2 is canonical when standing alone, but 1 + (1/2) sqrt 3 is
canonical. Hence surdsimp cannot be called recursively on arguments
without an additional parameter. See the next function.
*/
{ if(contains(t,'+'))
return surdsimp2(1,t,ans);
else
return surdsimp2(0,t,ans);
/* surdsimp2(contains(t,'+'), t, ans), but this is awkward for tracing */
}
/*_________________________________________________________________________*/
int canonical(int flag, term t)
/* return 1 if t is a canonical form for an algebraic number. If flag is
nonzero, treat (1/2) sqrt 3 as canonical, else treat sqrt(3)/2 as canonical.
Similarly for (2/3) sqrt 5 and (2 sqrt 5)/3
*/
{ term u,index,num,denom,p,q;
unsigned short f,g,n,k;
long *indices;
long *r;
double z;
long m;
int i,ratflag;
if(INTEGERP(t) || RATIONALP(t))
return 1;
f = FUNCTOR(t);
n = ARITY(t);
if(f == '-')
{ if(!contains(t,'+'))
return canonical(flag,ARG(0,t));
return 0;
}
if(f == SQRT)
{ u = ARG(0,t);
if(nsquarefree(u))
return 1;
return 0;
}
if(f == ROOT)
{ u = ARG(1,t);
index = ARG(0,t);
if(!INTEGERP(index))
return 0;
if(TYPE(index) == BIGNUM)
return 1; /* assert(0) */
if(FUNCTOR(u) == '+' && !contains(u,ROOT))
return canonical(1,u);
m = INTDATA(index);
if(!rootfree(u,(unsigned)m))
return 0;
deval(u,&z);
if(z != BADVAL && z > 0.0)
return 1;
return 0;
}
if(f == '/')
{ if(flag == 1)
return 0;
num = ARG(0,t);
denom = ARG(1,t);
if(!INTEGERP(denom))
return 0;
if(FUNCTOR(num) == SQRT || FUNCTOR(num) == ROOT)
return canonical(0,num);
if(FUNCTOR(num) == '*')
{ if(ARITY(num) > 2)
return 0;
if(!cancel(num,denom,&p,&q))
return 0;
return canonical(0,num);
}
return 0;
}
if(f == '*')
{ if(n > 2)
return 0;
if(!INTEGERP(ARG(0,t)) && !RATIONALP(ARG(0,t)))
return 0;
if(flag == 0 && RATIONALP(ARG(0,t)))
return 0; /* reject (3/5) sqrt 2 when flag is zero */
if(FUNCTOR(ARG(1,t)) == SQRT)
return canonical(flag,ARG(1,t));
if(FUNCTOR(ARG(1,t)) == ROOT)
{ /* (1/3) root(3, 98 + 18 sqrt 17) is not canonical; it must become
root(3, 98/27 + (2/3) sqrt 17)
*/
if(FUNCTOR(ARG(1,ARG(1,t))) == '+')
return 0;
if(RATIONALP(ARG(1,ARG(1,t))))
return canonical(flag,ARG(1,t));
}
return 0;
}
if(f == '+')
{ /* A sum of canonical roots, sqrts, or products, in which the
roots of the same index are all different, is canonical. */
indices = (long *) callocate(n, sizeof(long));
if(!indices)
{ nospace();
return 0;
}
r = (long *) callocate(n,sizeof(long));
if(!r)
{ nospace();
return 0;
}
k = 0;
ratflag = 0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(NEGATIVE(u))
u = ARG(0,u);
if(RATIONALP(u) || INTEGERP(u))
{ ++ ratflag;
if(ratflag > 1)
return 0;
continue;
}
if(FUNCTOR(u) == '+')
return 0; /* flatten the sum first */
g = FUNCTOR(u);
if(g == '*')
{ if(ARITY(u) > 2)
{ free2(indices);
free2(r);
return 0;
}
if(!INTEGERP(ARG(0,u)) && !RATIONALP(ARG(0,u)))
{ free2(indices);
free2(r);
return 0;
}
u = ARG(1,u);
g = FUNCTOR(u);
}
if(g != SQRT && g != ROOT)
{ free2(indices);
free2(r);
return 0;
}
if(!canonical(flag,u))
{ free2(indices);
free2(r);
return 0;
}
if(g == SQRT)
{ indices[k] = 2;
r[k] = INTDATA(ARG(0,u));
++k;
}
else /* g == ROOT */
{ if(!ISINTEGER(ARG(0,u)))
{ free2(indices);
free2(r);
return 0;
}
indices[k] = INTDATA(ARG(0,u));
r[k] = INTDATA(ARG(1,u));
++k;
}
}
if(duplicates(indices,r,k))
{ free2(indices);
free2(r);
return 0;
}
free2(indices);
free2(r);
return 1;
}
return 0;
}
/*_________________________________________________________________________*/
static int surdsimp2(int flag, term t, term *ans)
/* Do the work of surdsimp as documented above. If flag is nonzero,
treat (1/2) sqrt 3 as canonical, else treat sqrt(3)/2 as canonical.
Return value is 0 if *ans is canonical, 1 if not canonical.
*/
{ unsigned short f = FUNCTOR(t);
unsigned short n = ARITY(t);
unsigned short h,k;
term p,q,u,v,num,denom,a,b,in,out,cancelled,temp,cp;
int i,err,err2,err3,r,s,countsigns,countsqrts,countroots;
unsigned short countfracts;
unsigned nfactors;
double z;
long m;
if(ALREADY(t) || canonical(flag,t))
{ *ans = t;
return 0;
}
if(ISATOM(t) || OBJECT(t)) /* atoms aren't supposed to come here but
programming defensively, don't cause a GPF
if one does by looking for the args of an atom. */
{ *ans = t;
return 0;
}
if(!contains(t,ROOT) && !contains(t,SQRT))
{ value(t,ans);
if(INTEGERP(*ans) || RATIONALP(*ans))
{ SET_ALREADY(*ans);
return 0;
}
if(NEGATIVE(*ans) &&
(INTEGERP(ARG(0,*ans)) || RATIONALP(ARG(0,*ans)))
)
{ SET_ALREADY(*ans);
return 0;
}
return 1;
}
if(f == '/' && !cancel(ARG(0,t),ARG(1,t),&cancelled,&p))
{ if(SOME_INFINITESIMAL(t))
copy_infinitesimal_markers(t,&p);
return surdsimp2(flag,p,ans);
}
if(f == '+' || f == '*')
{ /* perhaps flattening is necessary */
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,t)) == f)
break;
}
if(i<n)
{ /* yes, flattening is necessary */
t = topflatten(t);
n = ARITY(t);
}
}
u = make_term(f,n);
r = 0;
for(i=0;i<n;i++)
{ err = surdsimp2(flag || (f=='+'),ARG(i,t),ARGPTR(u) + i);
/* In case of a sum, simplify the summands so (1/2) sqrt 5 is canonical,
not sqrt(5)/2. If the rational parts all cancel out however, we
may wind up with (1/2) sqrt 5 standing alone, but below under '+'
we trap that case and try again. */
if(f == '*' && ZERO(ARG(i,u)) && !deval(t,&z) && z != BADVAL)
/* use deval in case the term contains an infinite factor too */
{ *ans = zero;
RELEASE(u);
return 0;
}
if(f == '/' && i==0 && ZERO(ARG(i,u)) &&
!deval(ARG(1,t),&z) && z != BADVAL && !(nearint(z,&m) && m == 0)
)
{ *ans = zero;
RELEASE(u);
return 0;
}
if(err)
r = 1;
}
t = u;
/* From now on, we can assume all the args are simplified. If r
is zero it means all of the args are now in canonical form.
*/
if(!contains(t,ROOT) && !contains(t,SQRT))
{ value(t,ans);
if(INTEGERP(*ans) || RATIONALP(*ans))
{ SET_ALREADY(*ans);
return 0;
}
if(NEGATIVE(*ans) &&
(INTEGERP(ARG(0,*ans)) || RATIONALP(ARG(0,*ans)))
)
{ SET_ALREADY(*ans);
return 0;
}
return r;
}
switch(f)
{ case '-':
h = FUNCTOR(ARG(0,t));
switch(h)
{ case '-':
*ans = ARG(0,ARG(0,t));
if(r == 0)
SET_ALREADY(*ans);
return r;
case '+':
*ans = strongnegate(ARG(0,t));
if(r == 0)
SET_ALREADY(*ans);
return r;
}
*ans = t;
if(r == 0)
SET_ALREADY(*ans);
return r;
case '+':
/* first replace summands of the form sqrt(n)/m by (1/m) sqrt n so
collect will work on them */
/* perhaps flattening is necessary */
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,t)) == f)
break;
}
if(i<n)
{ /* yes, flattening is necessary */
t = topflatten(t);
n = ARITY(t);
}
p = make_term('+',n);
for(i=0;i<n;i++)
{ q = ARG(i,t);
if(NEGATIVE(q))
q = ARG(0,q);
if(!contains(q,SQRT))
ARGREP(p,i,ARG(i,t));
else if(!FRACTION(q) && FUNCTOR(q) != '*')
ARGREP(p,i,ARG(i,t));
else
{ term cp,sp;
ratpart2(q,&cp,&sp);
if(FRACTION(sp))
{ ARGREP(p,i,ARG(i,t));
continue; /* example, 6/root(3,...) */
}
if(NEGATIVE(ARG(i,t)))
ARGREP(p,i,tnegate(product(cp,sp)));
else if(FRACTION(sp) && !FRACTION(cp))
ARGREP(p,i,make_fraction(product(cp,ARG(0,sp)),ARG(1,sp)));
else if(FRACTION(cp) && FRACTION(sp))
ARGREP(p,i,make_fraction(product(ARG(0,cp),ARG(0,sp)),
product(ARG(1,cp),ARG(1,sp))
)
);
else
ARGREP(p,i,product(cp,sp));
}
}
s = collect(p,&u);
if(s)
/* some collection or cancellation */
{ if(ZERO(u))
{ *ans = zero;
return 0;
}
p = u;
}
if(!collect_roots(p,&u))
p = u; /* example, (1/2) sqrt 5 + sqrt 5 becomes (3/2) sqrt 5 */
if(!content_factor(p,&cp,&u) && contains_sqrt(cp) &&!contains_sqrt(p))
{ err = value(u,&v); /* u can be 1+1 */
if(!err)
u = v;
return surdsimp(product(cp,u),ans);
}
if(!s)
{ *ans = p;
additive_sortargs(*ans);
if(r == 0)
SET_ALREADY(*ans);
return r;
}
return surdsimp(p,ans); /* Not surdsimp2; '+' may have been eliminated */
case SQRT:
if(ZERO(ARG(0,t)))
{ *ans = zero;
return 0;
}
if(ONE(ARG(0,t)))
{ *ans = one;
return 0;
}
if(INTEGERP(ARG(0,t)) && nsquarefree(ARG(0,t)))
{ *ans = t;
SET_ALREADY(*ans);
return 0;
}
if(INTEGERP(ARG(0,t))) /* and it's not squarefree */
{ /* sqrt(12) = 2 sqrt 3 */
factor_integer(ARG(0,t),&nfactors,&p);
if(nfactors == 1 && FUNCTOR(p) != '^')
{ *ans = t;
SET_ALREADY(*ans);
return 0;
}
err2 = radsimpaux(two,p,&out,&in);
if(err2)
{ *ans = t;
SET_ALREADY(*ans);
return 0;
}
if(!INTEGERP(out))
{ value(out,&u);
out = u;
}
if(!INTEGERP(in))
{ value(in,&u);
in = u;
}
*ans = ONE(in) ? out : product(out,make_sqrt(in));
SET_ALREADY(*ans);
return 0;
}
h = FUNCTOR(ARG(0,t));
switch(h)
{ case '/':
/* sqrt(3/2) => sqrt(3)/sqrt(2) and then simplify further */
u = make_fraction(make_sqrt(ARG(0,ARG(0,t))), make_sqrt(ARG(1,ARG(0,t))));
return surdsimp(u,ans);
case SQRT:
*ans = make_root(four,ARG(0,ARG(0,t)));
if(r == 0)
SET_ALREADY(*ans);
return r;
case ROOT:
polyval(product(two,ARG(0,ARG(0,t))),&temp);
*ans = make_root(temp,ARG(1,ARG(0,t)));
if(r == 0)
SET_ALREADY(*ans);
return r;
case '+':
*ans = t;
if(r == 0)
SET_ALREADY(*ans);
return r; /* sqrt( a + sqrt b) is canonical if a + sqrt b is */
case '^': /* sqrt(x^2) = abs(x) */
{ term a,b;
if(!cancel(ARG(1,ARG(0,t)),two,&a,&b) && isinteger(b))
{ if(obviously_nonnegative(a))
*ans = a;
else
*ans = abs1(a);
return r;
}
}
}
*ans = t;
return 1;
case ROOT:
if(ZERO(ARG(1,t)))
{ *ans = zero;
return 0;
}
if(ONE(ARG(1,t)))
{ *ans = one;
return 0;
}
if(!ISINTEGER(ARG(0,t)))
{ *ans = t;
return 1;
}
m = INTDATA(ARG(0,t));
if(INTEGERP(ARG(1,t)) && rootfree(ARG(1,t),(unsigned)m))
{ *ans = t;
SET_ALREADY(*ans);
return 0;
}
if(INTEGERP(ARG(1,t))) /* and it's not rootfree */
{ /* root(3,24) = 2 root(3,3) */
err = factor_integer(ARG(0,t),&nfactors,&p);
if(err || nfactors == 1)
{ *ans = t;
SET_ALREADY(*ans);
return 0;
}
err = radsimpaux(ARG(0,t),p,&out,&in);
if(err)
{ *ans = t;
SET_ALREADY(*ans);
return 0;
}
if(!INTEGERP(out))
{ value(out,&u);
out = u;
}
if(!INTEGERP(in))
{ value(in,&u);
in = u;
}
*ans = ONE(in) ? out : product(out,make_root(ARG(0,t),in));
SET_ALREADY(*ans);
return 0;
}
h = FUNCTOR(ARG(1,t));
switch(h)
{ case '-':
deval(ARG(0,ARG(1,t)),&z);
if(z != BADVAL && z > 0.0)
{ u = tnegate(make_root(ARG(0,t),ARG(0,ARG(1,t))));
return surdsimp(u,ans);
}
break;
case '/':
/* root(m,3/2) => root(m,3)/root(m,2) and then simplify further */
u = make_fraction(make_root(ARG(0,t),ARG(0,ARG(1,t))), make_root(ARG(0,t),ARG(1,ARG(1,t))));
return surdsimp(u,ans);
case SQRT:
value(product(two,ARG(0,t)),&p);
*ans = make_root(p,ARG(0,ARG(1,t)));
if(r == 0)
SET_ALREADY(*ans);
return r;
case ROOT:
*ans = make_root(product(ARG(0,t),ARG(0,ARG(1,t))), ARG(1,ARG(1,t)));
if(r == 0)
SET_ALREADY(*ans);
return r;
#if 0
case '+':
if(equals(ARG(0,t),three) && ARITY(ARG(1,t)) == 2)
{ term c,s,d;
a = ARG(0,ARG(1,t));
b = ARG(1,ARG(1,t));
if(NEGATIVE(a))
a = ARG(0,a);
if(NEGATIVE(b))
b = ARG(0,b);
ratpart2(b,&c,&s);
if(FUNCTOR(s) == SQRT && INTEGERP(ARG(0,s)))
d = ARG(0,s);
/* When is root(3, a + c sqrt(d)) canonical? */
/* I wish I knew. Some such expressions can be
simplified. But not by Mathpert's auto mode;
and accordingly the code below returns 0
on any root of a canonical expression which
isn't itself a root or sqrt. */
}
#endif
}
*ans = t;
if(r == 0)
SET_ALREADY(*ans);
return r;
case '/':
num = ARG(0,t);
denom = ARG(1,t);
if(ZERO(num))
{ *ans = zero;
return 0;
}
if(ONE(denom))
{ *ans = num;
SET_ALREADY(*ans);
return 0;
}
if(ZERO(denom))
{ *ans = t;
/* Maybe this can happen during limit calculations */
return 1;
}
if(NEGATIVE(denom))
{ if(ONE(ARG(0,denom)))
{ tneg(num,ans);
SET_ALREADY(*ans);
return 0;
}
surdsimp2(flag,make_fraction(num,ARG(0,denom)),&u);
*ans = strongnegate(u);
SET_ALREADY(*ans);
return 0;
}
if(NEGATIVE(num))
{ surdsimp2(flag,make_fraction(ARG(0,num),denom),&u);
*ans = strongnegate(u);
SET_ALREADY(*ans);
return 0;
}
if(FUNCTOR(num) == '+' && INTEGERP(denom))
{ apart3(t,&u);
return surdsimp2(flag,u,ans);
}
err2 = cancel_by_contentfactor(num,denom,&cancelled,&u);
if(!err2)
{ if(SOME_INFINITESIMAL(t))
copy_infinitesimal_markers(t,&u);
return surdsimp2(flag,u,ans);
}
err2 = cancel(num,denom,&cancelled,&u);
if(!err2) /* there was a cancellation */
{ if(SOME_INFINITESIMAL(t))
copy_infinitesimal_markers(t,&u);
return surdsimp2(flag,u,ans); /* put it through again, it may need more work */
}
/* one of num or denom must contain a SQRT or ROOT */
if(INTEGERP(denom) && FUNCTOR(num) == SQRT && INTEGERP(ARG(0,num)))
{ *ans = t; /* sqrt(3)/2 is canonical, not (1/2) sqrt 3 */
/* For a while I checked flag and when !flag I returned
*ans = product(reciprocal(denom), num);
*/
SET_ALREADY(*ans);
return 0;
}
if(INTEGERP(denom) && FUNCTOR(num) == ROOT && INTEGERP(ARG(1,num)))
{ if(!flag)
*ans = t;
else
*ans = product(reciprocal(denom),num);
SET_ALREADY(*ans);
return 0; /* root(3,2)/5 */
}
if(flag && INTEGERP(denom) && FUNCTOR(num) == '*' &&
INTEGERP(ARG(0,num)) && ARITY(num) == 2 &&
(
(FUNCTOR(ARG(1,num)) == SQRT && INTEGERP(ARG(0,ARG(1,num)))) ||
(FUNCTOR(ARG(1,num)) == ROOT && INTEGERP(ARG(1,ARG(1,num))))
)
)
{ /* 2 sqrt 5 / 3 = (2/3) sqrt 5 */
err = cancel(ARG(0,num),denom,&u,&v);
if(!err)
*ans = product(v,ARG(1,num));
else
*ans = product(make_fraction(ARG(0,num),denom),ARG(1,num));
return 0;
}
if(FRACTION(denom))
return surdsimp2(flag,make_fraction(product(ARG(1,denom),num),ARG(0,denom)),ans);
if(FRACTION(num))
{ err3 = mvpolymult2(ARG(1,num),denom,&v);
if(err3)
v = product(ARG(1,num),denom);
return surdsimp2(flag,make_fraction(ARG(0,num),v),ans);
}
if(FUNCTOR(num) == '*' && RATIONALP(ARG(0,num)))
{ copy(num,&u);
ARGREP(u,0,ARG(0,ARG(0,num)));
err3 = mvpolymult2(ARG(1,ARG(0,num)),denom,&v);
if(err3)
v = product(ARG(1,ARG(0,num)),denom);
return surdsimp2(flag,make_fraction(u,v),ans);
}
if(FUNCTOR(denom) == '*' &&
(INTEGERP(ARG(0,denom)) || RATIONALP(ARG(0,denom))) &&
ARITY(denom) == 2
)
{ r = surdsimp2(flag,make_fraction(num,ARG(1,denom)),&u);
if(FRACTION(u) && INTEGERP(ARG(1,u)))
{ value(product(ARG(0,denom),ARG(1,u)),&v);
*ans = make_fraction(ARG(0,u),v);
}
else
{ err3 = mvpolymult2(reciprocal(ARG(0,denom)),u,ans);
if(err3)
{ /* assert(0) */
*ans = make_fraction(u,ARG(0,denom));
}
}
if(r == 0)
SET_ALREADY(*ans);
return r;
}
if(FUNCTOR(denom) == SQRT)
/* a/sqrt 3 = (a sqrt 3)/3 and simplify further */
{ v = product(denom,num);
if(FUNCTOR(v) == '*')
sortargs(v);
u = make_fraction(v,ARG(0,denom));
return surdsimp2(flag,u,ans);
}
if(INTEGERP(denom) && FUNCTOR(num) == '+')
{ u = reciprocal(denom);
err3 = mvpolymult2(u,num,&v);
if(err3)
v = make_fraction(num,denom);
return surdsimp2(flag,v,ans);
}
if(FUNCTOR(denom) == '+' && ARITY(denom) == 2 && r == 0 &&
contains_sqrt(denom) == SQRT &&
!contains(ARG(0,denom),'+') &&
!contains(ARG(1,denom),'+')
)
{ /* rationalize the denominator */
if(NEGATIVE(ARG(1,denom)))
{ v = sum(square2(ARG(0,denom)), strongnegate(square2(ARG(1,denom))));
u = product(num,sum(ARG(0,denom),ARG(0,ARG(1,denom))));
}
else if(NEGATIVE(ARG(0,denom)))
{ v = sum(square2(ARG(1,denom)), strongnegate(square2(ARG(0,denom))));
u = product(num,sum(ARG(0,ARG(0,denom)),ARG(1,denom)));
}
else
{ v = sum(square2(ARG(0,denom)), strongnegate(square2(ARG(1,denom))));
u = product(num,sum(ARG(0,denom), strongnegate(ARG(1,denom))));
}
return surdsimp2(flag,make_fraction(u,v),ans);
}
*ans = t;
return r;
case '*':
if(n == 2 && RATIONALP(ARG(0,t)) &&
FUNCTOR(ARG(1,t)) == ROOT &&
equals(ARG(0,ARG(1,t)),three) &&
FUNCTOR(ARG(1,ARG(1,t))) == '+' &&
ARITY(ARG(1,ARG(1,t))) == 2 &&
canonical(flag,ARG(1,t))
)
{ /* distribute the rational inside the root */
p = make_power(ARG(0,t),three);
q = ARG(1,ARG(1,t));
u = product(p,ARG(0,q));
v = product(p,ARG(1,q));
err = surdsimp2(1,sum(u,v),&temp);
*ans = make_root(three,temp);
return 0;
}
/* perhaps flattening is necessary */
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,t)) == f)
break;
}
if(i<n)
{ /* yes, flattening is necessary */
t = topflatten(t);
n = ARITY(t);
}
countsigns = 0;
countfracts = 0;
countsqrts = 0;
countroots = 0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(ZERO(u))
{ *ans = zero;
return 0;
}
if(NEGATIVE(u))
{ ++countsigns;
u = ARG(0,u);
}
if(FRACTION(u))
++countfracts;
if(FUNCTOR(u) == SQRT)
++countsqrts;
if(FUNCTOR(u) == ROOT)
++countroots;
}
if(countsigns || countfracts)
{ num = make_term('*',n);
if(countfracts)
denom = make_term('*',countfracts);
k = 0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(NEGATIVE(u))
u = ARG(0,u);
if(FRACTION(u))
{ ARGREP(num,i,ARG(0,u));
ARGREP(denom,k,ARG(1,u));
++k;
}
else
ARGREP(num,i,u);
}
if(k != countfracts)
assert(0);
if(k==0)
{ if(countsigns & 1)
num = tnegate(num);
return surdsimp2(flag,num,ans);
}
if(k==1)
{ u = ARG(0,denom);
RELEASE(denom);
denom = u;
surdsimp2(flag,num,&p);
err = cancel(p,denom,&cancelled,&u);
if(!err)
{ if(countsigns & 1)
u = tnegate(u);
return surdsimp2(flag,u,ans);
}
}
else /* k > 1 */
{ surdsimp2(flag,num,&p);
surdsimp2(flag,denom,&q);
err = cancel(p,q,&cancelled,&u);
if(err)
u = make_fraction(num,denom);
if(countsigns & 1)
u = tnegate(u);
return surdsimp2(flag,u,ans);
}
/* the case k == 1 when nothing cancelled falls through */
}
if(n==2)
{ a = ARG(0,t);
b = ARG(1,t);
if(flag && RATIONALP(a) &&
((FUNCTOR(b)== SQRT && INTEGERP(ARG(0,b))) |(FUNCTOR(b) == ROOT && INTEGERP(ARG(1,b))))
)
{ *ans = t;
if(r == 0)
SET_ALREADY(*ans);
return 0; /* (1/2) sqrt 3 is canonical */
}
if(FUNCTOR(a) == SQRT && FUNCTOR(b) == SQRT)
{ p = product(ARG(0,a),ARG(0,b));
value(p,&q);
return surdsimp2(flag,make_sqrt(q),ans);
}
if(FUNCTOR(a) == ROOT && FUNCTOR(b) == ROOT &&
equals(ARG(0,a),ARG(0,b))
)
return surdsimp2(flag,make_root(ARG(0,a),product(ARG(1,a),ARG(1,b))),ans);
err3 = mvpolymult2(a,b,&u);
if(err3)
u = product(a,b);
if(!equals(u,t))
return surdsimp2(flag,u,ans);
*ans = t;
if(INTEGERP(a) && FUNCTOR(b) == SQRT && INTEGERP(ARG(0,b)))
return 0;
if(INTEGERP(a) && FUNCTOR(b) == ROOT && INTEGERP(ARG(1,b)))
return 0;
return 1;
}
/* now n > 2 */
/* Example: sqrt 2 3 sqrt 14 should become 3 sqrt 28 and then
be passed recursively; roots with the same index should be
similarly combined. */
if(countsqrts > 1 && !productofsqrts2(t,&u))
return surdsimp2(flag,u,ans);
if(countroots > 1 && !productofroots2(t,&u))
return surdsimp2(flag,u,ans);
if(equals(ARG(n-2,t),ARG(n-1,t)))
v = make_power(ARG(n-2,t),two);
else if(ONE(ARG(n-2,t)))
v = ARG(n-1,t);
else if(ONE(ARG(n-1,t)))
v = ARG(n-2,t);
else
mfracts(ARG(n-2,t),ARG(n-1,t),&v);
surdsimp2(flag,v,&u);
if(FUNCTOR(u) == '*')
{ *ans = t;
return r;
}
if(n == 3)
return surdsimp2(flag,product(ARG(0,t),u),ans);
p = make_term('*',(unsigned short)(n-1));
for(i=0;i<n-1;i++)
ARGREP(p,i,i<n-2 ? ARG(i,t) : u);
return surdsimp2(flag,p,ans);
case '^':
a = ARG(0,t);
b = ARG(1,t);
if(!INTEGERP(b))
{ /* assert(0), illegal input */
*ans = t;
return 1;
}
if(FUNCTOR(a) == '*')
{ k = ARITY(a);
u = make_term('*',k);
for(i=0;i<k;i++)
{ v = ARG(i,a);
if(FUNCTOR(v) == SQRT && equals(b,two))
ARGREP(u,i,ARG(0,v));
else if(FUNCTOR(v) == ROOT && equals(b,ARG(0,v)))
ARGREP(u,i,ARG(1,v));
else
ARGREP(u,i,make_power(v,b));
}
return surdsimp2(flag,u,ans);
}
if(equals(b,two))
{ if(FUNCTOR(a) == SQRT)
{ *ans = ARG(0,a);
return r;
}
copy(a,&u);
return surdsimp2(flag,product(a,u),ans);
}
if(FUNCTOR(a) == SQRT)
{ if(ISEVEN(b))
{ cancel(b,two,&cancelled,&v);
value(make_power(ARG(0,a),v),ans);
return r;
}
value(make_fraction(sum(b,minusone),two),&p);
u = product(make_power(ARG(0,a),p),a);
return surdsimp2(flag,u,ans);
}
if(FRACTION(a))
{ u = make_fraction(make_power(ARG(0,a),b),make_power(ARG(1,a),b));
return surdsimp2(flag,u,ans);
}
if(NEGATIVE(a) && ISEVEN(b))
{ u = make_power(ARG(0,a),b);
return surdsimp2(flag,u,ans);
}
if(NEGATIVE(a) && ISODD(b))
{ u = make_power(ARG(0,a),b);
err = surdsimp2(flag,u,&v);
*ans = tnegate(v);
return err;
}
if(FUNCTOR(a) == '*' || FRACTION(a))
{ copy(t,&v);
/* since polyvalexp destroys its input you have to be
extremely careful with it. It was designed to be a
static helper function in polyval.c only, but it's
useful here, but you have to remember it destroys
its input! */
err = polyvalexp(v,&u);
err2 = surdsimp2(flag,u,ans);
if(!err || !err2)
return 0;
else
return 1;
}
*ans = t;
return 1;
}
/* illegal input, but no point using assert(0) */
*ans = t;
return 1;
}
/*______________________________________________________________________*/
static int collect_roots(term t, term *ans)
/* t is a sum. Collect terms in the same root or sqrt. Return 0
for success. Return 1 for failure, in which case *ans is garbage.
Example: (1/2) sqrt 5 + sqrt 5, *ans is returned as (3/2) sqrt 5.
*/
{ unsigned short n,m,i,j;
term u,v,temp,newvar;
int savenvariables;
if(FUNCTOR(t) != '+')
return 1;
n = ARITY(t);
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(NEGATIVE(u))
u = ARG(0,u);
if(FUNCTOR(u) == SQRT)
break;
if(FUNCTOR(u) == ROOT)
break;
if(FUNCTOR(u) == '*')
{ m = ARITY(u);
for(j=0;j<m;j++)
{ v = ARG(j,u);
if(FUNCTOR(v) == SQRT || FUNCTOR(v) == ROOT)
break;
}
if(j < m)
{ u = v;
break;
}
}
}
if(i == n)
return 1;
/* Now we've found a ROOT or SQRT */
savenvariables = get_nvariables();
newvar = getnewvar(t,"abc");
if(FUNCTOR(newvar) == ILLEGAL)
return 1;
/* substitute a new variable temporarily for the root */
subst(newvar,u,t,&v);
if(!collect(v,&temp))
{ set_nvariables(savenvariables);
return 1;
}
subst(u,newvar,temp,ans);
set_nvariables(savenvariables); /* get rid of newvar */
return 0;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists