Sindbad~EG File Manager
/* tests for irreducible polynomials */
/* M. Beeson, for MathXpert
Original date 1.18.93
modified 2.3.98
1.6.00 made factored call irreducible
1.7.00 improved irreducible
3.10.01 improved irreducible using eisen
3.17.06 removed include heap.h as it's already included indirectly from globals.h and terms.h
*/
#define ALGEBRA_DLL
#include <assert.h>
#include <math.h>
#include "globals.h"
#include "polynoms.h"
#include "factor.h"
#include "cancel.h"
#include "order.h"
#include "algaux.h"
#include "deval.h"
#include "pvalaux.h" /* content_factor */
static int eisenstein2(term,term,term);
static int superlinear(term t);
static int primitive(term t);
static int eisen(long);
/*___________________________________________________________________*/
#define NSMALLPRIMES (sizeof(smallprimes)/sizeof(int))
static int smallprimes[] = { 2, 3 , 5 , 7 , 11, 13, 17, 19, 23, 29,
31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79,
83, 89, 97, 101,103,107,109,113,121,127,
131,137,139,149,151,157,163,167,173,179,181};
static int eisen(long n)
/* return 1 if n is a small prime or if for some small prime q,
n is divisible by q but not by q^2 */
{ int i,p;
for(i=0;i<NSMALLPRIMES;i++)
{ p = smallprimes[i];
if(p > n)
return 0;
if((n % p == 0) && (n % (p*p)))
return 1;
}
return 0;
}
/*___________________________________________________________________*/
MEXPORT_ALGEBRA int irreducible(term t)
/* recognize some irreducible (over Z) polynomials quickly */
/* return values:
2 if for certain t is irreducible
1 if we aren't certain t is really irreducible but we are
certain MathXpert can't factor t
0 if we can't decide without trying to factor t
-1 if we know for certain t will factor
This way, a return value <= 0 means we should try to factor t.
Any number is considered irreducible as a polynomial, factoring
numbers is a different game.
*/
{ term u,v,a,b,c,x,y,n,m,p,q,discriminant,cancelled,trash,coef;
unsigned degree;
long deg;
int i,err,nvars,saveit;
int flag, flag2;
term *atomlist;
void *savenode;
if(ATOMIC(t))
return 2; /* can't factor an atom or number */
if(IRREDUCIBLE(t))
return 2; /* already found it to be irreducible */
if(FUNCTOR(t) != '+')
return 1; /* don't try to factor a non-sum */
if(!mvpoly(t))
return 0; /* some non-mvpolys can still be factored after a substitution */
err = primitive(t);
if(err)
return -1;
if(!contains(t,'^')) /* linear */
{ if(ARITY(t) <= 3 &&
content_factor(t,&a,&b) /* non-zero if it DOES NOT content_factor */
)
return 2;
/* The restriction on the arity is necessary:
9p-3pq+2nq-6n and other factor-by-grouping problems
are linear in each variable but can be factored.
However, if each term contains only ONE variable,
as in p + q + r + 1, then it's certainly
irreducible. */
if(superlinear(t))
return 2;
return 0;
}
if(ARITY(t)==2)
{ u = ARG(0,t);
v = ARG(1,t);
err = polygcd(u,v,&q);
if(!err && !ONE(q))
return -1; /* common factor */
if(constant(u))
{ a = u;
x = one;
n= zero;
}
else if(!contains(u,'^')) /* linear in one or both variables */
return 2;
else
getmonomial(u,&a,&x,&n);
if(constant(v))
{ b = v;
m = zero;
}
else if(!contains(v,'^')) /* linear */
return 2;
else
{ getmonomial(v,&b,&y,&m);
if(equals(x,y))
return -1; /* they have a common factor of x */
}
}
nvars = atomsin(t,&atomlist);
if(nvars == 1)
{ x = atomlist[0];
free2(atomlist);
}
else if(nvars == 2)
{ if(equals(get_eigenvariable(),atomlist[1]))
{ x = atomlist[1];
y = atomlist[0];
}
else
{ x = atomlist[0];
y = atomlist[1];
}
}
else if(nvars > 3 || ARITY(t) > 8)
return 0; /* don't run MathXpert out of memory */
if(nvars == 2 || nvars == 3) /* a^2b^2 + 5abc + 25c^2 gets here */
{ /* maybe it's quadratic in some variable */
for(i=0;i<nvars;i++)
{ err = makepoly(t,atomlist[i],&p);
if(!err)
{ if(ARITY(p) == 1)
/* This can happen if the higher powers
occur more than once, and makepoly simplifies
them to zero. */
{ free2(atomlist);
return 1; /* don't try to factor it, simplify it */
}
if(ARITY(p) == 2) /* linear */
{ free2(atomlist);
return 0; /* try factorbygrouping */
}
if (ARITY(p) == 3) /* quadratic in atomlist[i] */
{ a = ARG(2,p);
b = ARG(1,p);
c = ARG(0,p);
saveit = get_polyvalfactorflag();
set_polyvalfactorflag(1);
polyval(sum(make_power(b,two),tnegate(product3(four,a,c))),&discriminant);
set_polyvalfactorflag(saveit);
err = sqrt_aux(discriminant,&trash);
if(!err)
{ free2(atomlist);
return -1; /* it factors */
}
/* but the discriminant might simply be a
polynomial like 4b^2 -4bc^2 + c^4, which
is a perfect square. (This one
arises in the example 2a^2 + 2ab + ac^2 + bc^2).
sqrt_aux can't handle such a discriminant. */
else if(i==nvars-1)
{ /* Just because the discriminant is not a square
does not mean it's irreducible. It only means
that if it factors, only one factor contains
the variable atomlist[i]. Example: a(x^2-x+1)
has discriminant -3a^2.
However, if this is true of all three
variables x,y,z,
then t = f(x)g(y)h(z) with f,g,h all quadratic,
or else t is irreducible. So if there is no
x^2 y^2 z^2 term, then the polynomial is
irreducible.
*/
err = makepoly(a, atomlist[0],&p);
if(err)
{ free2(atomlist);
return 0;
}
if(ARITY(p) < 3)
{ free2(atomlist);
return 2; /* irreducible */
}
if(nvars != 2)
{ err = makepoly(a,atomlist[1],&q);
if(err)
{ free2(atomlist);
return 0;
}
if(ARITY(q) < 3)
{ free2(atomlist);
return 2; /* irreducible */
}
free2(atomlist);
return 0;
}
}
}
}
}
free2(atomlist);
if(nvars == 3)
return 0; /* 3 variables, not quadratic or linear
in any of them, but MathXpert still might be
able to factor it, so go ahead and try */
}
if(nvars == 1)
{ err= makepoly(t,x,&p);
if(err || !intpolynomial(p))
return 0;
}
else if(nvars==2)
/* If f(x,c) is irreducible for any constant c, then
f(x,y) = r(y) u(x,y) where u is irreducible.
If f(0,y) is a power of y, then r(y) = y�,
so if f isn't divisible by y, then r==1 and f is irreducible. */
{ savenode = heapmax();
err = cancel(t,y,&cancelled,&trash);
if(!err)
return -1; /* contains a factor of y */
err = cancel(t,x,&cancelled,&trash);
if(!err)
return -1; /* contains a factor of x */
subst(zero,x,t,&q); /* check whether f(0,y) = cy� for some n */
polyval(q,&p);
err = monomial_form(p,y,°,&coef);
if(!err && !contains(coef,FUNCTOR(y))) /* yes, f(x,0) = cx� */
{ subst(one,y,t,&q); /* try f(x,1), e.g. x^2 + xy^3 + y^6 */
flag = get_polyvalfactorflag();
flag2 = get_polyvalfactorflag2();
set_polyvalfactorflag(0);
set_polyvalfactorflag2(0);
polyval(q,&p);
set_polyvalfactorflag(flag);
set_polyvalfactorflag(flag2);
err = irreducible(p);
if(err > 0)
return err;
}
subst(zero,y,t,&q); /* check whether f(x,0) = cx� for some n */
polyval(q,&p);
err = monomial_form(p,x,°,&coef);
if(!err && !contains(coef,FUNCTOR(x))) /* yes, f(0,y) = cy� */
{ subst(one,x,t,&q); /* try f(1,y) , e.g. x^6 + x^3y + y^2 */
polyval(q,&p);
err = irreducible(p);
if(err > 0)
return err;
}
reset_heap(savenode);
/* If we get here, the attack by substituting values didn't work.
Here are two examples that make it here:
2x + 4y + x^2 + 2xy (which is divisible by x+2)
x^6 + x^3y^3 + y^6 (no longer gets here because x^6 + x^3 + 1
is handled as a special case in POLY form below)
*/
err = homogeneous_poly(t,x,y,&p); /* e.g. x^8 + x^4y^4 + y^8 */
/* gets here because x^8 + x^4 + 1 isn't handled below */
if(err)
{ /* Nonhomogeneous bivariate */
reset_heap(savenode);
err = eisenstein2(t,x,y);
if(!err)
return 2;
err = eisenstein2(t,y,x);
if(!err)
return 2;
return 0; /* give up */
}
}
/* If we arrive here, we have a POLYnomial p to deal with */
degree = ARITY(p)-1;
if( (int) degree < 0)
return 0; /* degree is an unsigned so it could be too large to cast to an int */
if(degree < 2)
return 2;
if(degree == 2)
{ discriminant = sum(make_power(ARG(1,p),two),tnegate(product3(four,ARG(0,p),ARG(2,p))));
if(ONE(discriminant))
return -1; /* it factors */
else
{ err = value(make_power(discriminant,make_fraction(one,two)),&q);
if(err==0)
return -1; /* it factors */
else
return 2; /* irreducible for sure */
}
}
if(degree == 3)
{ err = irreducible_cubic(p);
switch(err)
{ case 0: return -1; /* factors */
case 1: return 2; /* irreducible */
case 2: return 0; /* can't tell, try to factor */
default: assert(0);
}
}
if(degree == 4 && ZERO(ARG(1,p)) && ZERO(ARG(3,p)) )
return irreducible_quartic(p) ? 2 : -1;
/* Here you could test whether the first degree + 2 values are prime */
if(degree == 6) /* x^6 � x^3 + 1 is known to be irreducible */
{ if(ONE(ARG(0,p)) && ZERO(ARG(1,p)) && ZERO(ARG(2,p)) &&
(ONE(ARG(3,p)) || equals(ARG(3,p),minusone))
&& ZERO(ARG(4,p)) && ZERO(ARG(5,p)) && ONE(ARG(6,p))
)
return 2; /* irreducible */
/* Here we purposely omit information about
x^6 + Ax^3 + 1 in general,
which students are not taught. */
}
/* check for x^n + c and x^n - c */
if(ONE(ARG(degree,p)) && !ZERO(ARG(0,p)))
{ for(i=1; i < (int) degree; i++)
{ if(!ZERO(ARG(i,p)))
break;
}
if(i== (int) degree)
{ /* it's of the form x^n + c or x^n -c */
term c = ARG(0,p);
if(degree == 8 && ONE(c))
return 2; /* x^8 + 1 is irreducible */
if(ISINTEGER(c) && eisen(INTDATA(c)))
return 2; /* x^n + prime is irreducible by Eisenstein */
if(NEGATIVE(c) && ISINTEGER(ARG(0,c)) && eisen(INTDATA(ARG(0,c))))
return 2; /* x^n - prime is irreducible by Eisenstein */
}
}
if(ONE(ARG(degree,p)) && eisen(degree+1) &&
ISINTEGER(ARG(degree-1,p)) && eisen(INTDATA(ARG(degree-1,p)))
)
{ /* check for cyclotomic polynomials (x^n - 1)/(x-1).
If we set y = x-1 and expand and then cancel y,
Eisenstein applies if n is prime, or is divisible by some prime q but not q^2.
Substituting y = (x-1)/c the same applies to (x^n-c^n)/ (x-c)
Example: (x^5-32)/(x-2)
*/
term c =ARG(degree-1,p);
term z = c;
term w;
for(i=degree-2;i>=0;i--)
{ value(product(z,c),&w);
if(!equals(w,ARG(i,p)))
break;
z = w;
}
if(i == -1)
{ /* p is a cyclotomic polynomial */
return 2; /* irreducible since we already checked eisen(degree) */
}
}
return 0;
}
/*___________________________________________________________________*/
MEXPORT_ALGEBRA int irreducible_quartic(term p)
/* p is a POLYnomial; return 1 if p is irreducible and 0 if not */
/* assumes the coefficients are numbers */
/* It presumes the cubic and linear terms are zero */
{ term a,b,c,discriminant,pp,q,psq,qsq;
aflag arithflag = get_arithflag();
aflag saveit = arithflag;
int err;
assert(ZERO(ARG(1,p)));
assert(ZERO(ARG(3,p)));
a = ARG(4,p);
b = ARG(2,p);
c = ARG(0,p);
arithflag.ratexp = 1;
arithflag.complex = get_complex();
set_arithflag(arithflag);
discriminant = sum(make_power(b,two),tnegate(product3(four,a,c)));
err = value(make_power(discriminant,make_fraction(one,two)),&q);
if(err==0)
goto factors; /* it factors as (ax^2-b)(cx^2-d)*/
/* else it has no linear factor, since if p is a root, then
p^2 is a root of ax^2 + bx + c, so the discriminant is a square */
/* It might still factor as a product of quadratics */
/* x^4 + (2p-q^2)x^2 + p^2 = (x^2+qx+p)(x^2-qx+p) */
psq = make_fraction(c,a);
if(ONE(psq))
pp = one;
else
{ err = value(make_power(psq,make_fraction(one,two)),&pp);
if(err)
goto irreducible;
}
qsq = sum(product(two,pp),tnegate(make_fraction(b,a)));
if(ONE(qsq))
q = one;
else
{ err = value(make_power(qsq,make_fraction(one,two)),&q);
if(err)
goto irreducible;
}
factors:
set_arithflag(saveit);
return 0;
irreducible:
set_arithflag(saveit);
return 1;
}
/*___________________________________________________________________*/
MEXPORT_ALGEBRA int irreducible_cubic(term p)
/* p is a POLYnomial; return 1 if p is irreducible and 0 if not,
and 2 if it's too hard to tell. */
/* assumes the coefficients are numbers */
/* See Abramowitz and Stegun, page 17. Those formulas tell you
what the real roots are, but it's pretty tricky to find out if
they are rational or not. Consider this example:
x^3 -3x^2 - 16. We have s1 = (9 + sqrt 80)^1/3,
and s1 = (9 - sqrt 80)^1/3, and amazingly s1+s2 = 4, an integer!
*/
{ int i;
double q,r,d,epsilon,a[4],rootd,s1,s2,test;
long actualval;
if(FUNCTOR(p) != POLY || ARITY(p) != 4)
return 0; /* failure */
if(ZERO(ARG(0,p)))
return 0; /* divisible by x */
for(i=0;i<=3;i++)
{ deval(ARG(i,p),&a[i]);
}
assert(a[3] != 0); /* only genuine cubics should get here */
if(!ONE(ARG(3,p)))
{ /* multiply by a[3]^2 and substitute u = a[3] *x. The resulting
cubic has leading coefficient 1 and the following other
coefficients, and is irreducible iff the original one is. */
a[1] *= a[3];
a[0] *= a[3]*a[3];
a[3] = 1.0; /* only AFTER using the old value in the previous lines */
}
q = a[1]/3.0 - a[2]*a[2]/9.0;
r = (a[1] *a[2] - 3 *a[0])/6.0 - a[2]*a[2]*a[2]/27.0;
d = q*q*q + r*r;
if(d==0.0)
{ /* then it factors iff root(3,r) is rational, as can be seen
from Abramowitz and Stegun page 17, where if d == 0 we have
s1 = s2 = r^(1/3), so z1 = 2r^(1/3) - a[2]/3 and
z2 = z3= -z1/2. */
/* denom(r) divides 54 = 2 3^3, so 8 3^3 r = 216 r has an
integral cube root iff r has a rational cube root */
if(r==0.0)
return 0;
epsilon = r/10.0;
/* �(r+1) is about 1/2r away from �r for large r */
if( fmod(pow(fabs(216 * r),1/(double)3) + epsilon,1.0) < epsilon)
return 0;
else
return 1;
}
if(d > 0.0)
{ rootd = sqrt(d);
test = r+rootd;
s1 = test == 0 ? 0.0 : (test > 0) ? pow(test,1/3.0) : -pow(-test,1/3.0);
if(s1==BADVAL)
return 0; /* error in pow, give up */
test = r - rootd;
s2 = test == 0 ? 0.0 : (test > 0) ? pow(test,1/3.0) : -pow(-test,1/3.0);
if(s2 == BADVAL)
return 0; /* give up */
test = s1+s2 - a[2]/3.0; /* the real root */
/* is test a rational number? Because the cubic is monic,
by Gauss' lemma, if it's rational it's an integer. */
if(nearint(test,&actualval))
return 0;
else
return 1;
}
return 2; /* three real unequal roots, but it's
hard to find out if they are rational or not */
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA void mark_irreducibles(term *t)
/* mark all irreducible subterms of *t with SETPRIME,
and with SETCANTFACTOR if 'irreducible' so indicates */
{ unsigned short i,n = ARITY(*t);
int err;
void *savenode;
if(ATOMIC(*t))
return;
if(FUNCTOR(*t) != '+')
{ for(i=0;i<n;i++)
{ if(ATOMIC(ARG(i,*t)))
continue; /* save overhead of last function call */
mark_irreducibles(ARGPTR(*t) + i);
}
return;
}
/* Now it's a sum */
if(IRREDUCIBLE(*t) || CANTFACTOR(*t) )
return; /* no point going further */
savenode = heapmax();
err = irreducible(*t);
reset_heap(savenode); /* irreducible can eat up quite a lot of memory */
/* indeed, four calls can eat up a 64K document heap; that's
why this memory-management code was inserted. */
if(err==2)
{ SETPRIME(*t);
}
else if(err==1)
{ SETCANTFACTOR(*t);
}
}
/*______________________________________________________________________*/
MEXPORT_ALGEBRA int factored(term t)
/* if all sums contained in t are verifiably irreducible, return 1,
else return 0 */
{ unsigned short i,n = ARITY(t);
int err;
if(ATOMIC(t))
return 1;
if(FUNCTOR(t) == '+')
{ if(IRREDUCIBLE(t))
return 1;
err = irreducible(t);
if(err == 2)
return 1;
return 0;
}
for(i=0;i<n;i++)
{ if(ATOMIC(ARG(i,t)))
continue; /* save overhead of last function call */
if(!factored(ARG(i,t)))
return 0;
}
return 1;
}
/*________________________________________________________________________*/
static int eisenstein2(term t,term x,term y)
/* t is an mvpoly in x and y. It is irreducible if
(1) the leading term in x doesn't contain y
(2) the constant term in x is NOT divisible by y^2
(3) all terms except the leading term in x are divisible by y
because, choosing y to be a prime p not dividing the leading coefficient
in x, f(x,p) is then irreducible by Eisenstein's criterion as a
univariate polynomial, so if f(x,y) = u(x,y) v(x,y), then
v(x,p) = 1 identically in x. Therefore v is a function of y only.
But taking many different primes p, this polynomial v(y) takes the
value 1 at more points than its degree + 1, so it is identically 1.
Return 0 for success: t is irreducible.
Return 1 for failure: the test could not be performed, or it failed.
*/
{ int err;
term p,cancelled,trash,ysq;
unsigned short i,n;
term *a;
err = makepoly(t,x,&p);
if(err)
return 1;
n = ARITY(p); /* 1 + deg(p) */
a = ARGPTR(p);
if(contains(a[n-1],FUNCTOR(y))) /* leading term must not contain y */
{ RELEASE(p);
return 1;
}
for(i=0;i<(unsigned short)(n-1);i++)
{ if(ZERO(a[i]))
continue;
err = cancel(a[i],y,&cancelled,&trash);
if(err)
return 1;
}
ysq = make_power(y,two);
err = cancel(a[0],ysq,&cancelled,&trash);
if(err || !equals(cancelled,ysq))
return 0; /* test succeeds, a[0] not divisible by y^2 */
return 1; /* test fails */
}
/*_____________________________________________________________*/
static int primitive(term t)
/* assumes t is an mvpoly with functor + */
/* Return 0 if the coefficients of t have no numerical common factor */
/* Return 1 otherwise */
{ int i;
term a,r,temp;
unsigned short n = ARITY(t);
assert(FUNCTOR(t) == '+');
a = make_term('+',n);
for(i=0;i<n;i++)
{ ratpart(ARG(i,t),&r);
if(ONE(r))
return 0; /* succeed if 1 is encountered */
if(!NUMBER(r)) /* e.g. r = 3^2 */
{ value(r,&temp);
r = temp;
}
ARGREP(a,i,r);
}
listratgcd(ARGPTR(a),n,&temp);
RELEASE(a);
if(ONE(temp))
return 0;
return 1;
}
/*_____________________________________________________________________*/
static int superlinear(term t)
/* Presumes t is a sum.
Return 1 if t is a sum, each term of which contains
only one variable. (The name presumes that the function
is multilinear to begin with.)
*/
{ term u,c,s;
int i;
unsigned short n = ARITY(t);
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(NEGATIVE(u))
u = ARG(0,u);
if(ATOMIC(u))
continue;
if(FUNCTOR(u) != '*')
return 0;
ratpart2(u,&c,&s);
if(!ATOMIC(s))
return 0;
}
return 1;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists