Sindbad~EG File Manager
/* factorquadratic and factorbypolydiv */
/* M. Beeson, for MathXpert
Original date 8.16.91
modified 11.7.98
12.1.14 changed wait to wait1
5.29.24 if 0'd and commented out end_display_progress calls
*/
#include <string.h>
#include <assert.h>
#include <math.h>
#include "globals.h"
#include "ops.h"
#include "mpmem.h"
#include "polynoms.h"
#include "order.h"
#include "simpsums.h"
#include "simpprod.h"
#include "cancel.h"
#include "algaux.h"
#include "factor.h"
#include "factor.h"
#include "nfactor.h" /* for gtest */
#include "prover.h"
#include "deval.h"
#include "pvalaux.h" /* isquadratic */
#include "symbols.h"
#include "progress.h"
#include "mathmode.h" /* display_on() etc. */
#include "errbuf.h"
#include "dcomplex.h"
#include "ceval.h" /* complexnumerical */
#include "exec.h" /* erasecolors */
#include "cflags.h" /* display_on, display_off */
#include "pstring.h" /* log_term */
#define PAUSE 1000 /* milliseconds delay when showing trial factors */
static int polydiv_test(term,term,term,term,term,int,term *,term *,term *,term *);
static int factor_aux(term,term,term,term,term,term *);
static int test(term, term, term, term, term, int sign, term *, term *, term *, term *);
static double testvalue; /* used by factorbypolydiv for numerical checking;
polydiv_test needs to access this value, and it
can't be passed as a parameter since polydiv_test
is called indirectly and hence its argument types
and number must match those of the other functions
called indirectly by finish_factor_aux. */
static int contains_bignum(term t);
/*_______________________________________________________________________*/
int negativediscriminant(term t, term arg, term *next, char *reason)
/* reject a quadratic equation with negative discriminant,
provided complex numbers are off */
{ int err,currentline;
term a,b,c,x,y,dsq;
double bb,bsq,fourac;
if(FUNCTOR(t) != '=')
return 1;
if(!ZERO(ARG(0,t)) && !ZERO(ARG(1,t)))
{ errbuf(0, english(316));
/* You must first make one side zero. */
return 1;
}
t = ZERO(ARG(1,t)) ? ARG(0,t) : ARG(1,t);
if(get_complex())
{ errbuf(0, english(317)); /* Complex numbers are turned on, */
errbuf(1, english(318)); /* and there will be complex roots */
errbuf(2, english(319)); /* even when b^2-4ac < 0. */
return 1;
}
if(!isquadratic(t,&a,&b,&c,&x,&y)) /* write t = ax^2 + bxy + cy^2 */
{ errbuf(0, english(320)); /* Expression is not quadratic. */
return 1; /* fail */
}
/* Now a,b,c,x,y are all instantiated to specific terms */
dsq = sum(make_power(b,two),tnegate(product3(four,a,c)));
if(!numerical(dsq))
{ err = infer(lessthan(dsq,zero));
if(err)
return 1;
goto success;
}
/* Now dsq is numerical */
deval(b,&bb);
if(bb > 1.0e150)
return 1; /* too big; includes the case BADVAL */
bsq = bb * bb;
err = deval(product3(four,a,c),&fourac);
if(err)
return 1;
if(bsq < fourac)
goto success;
return 1;
success:
strcpy(reason, english(321)); /* discriminant < 0 */
*next = falseterm;
HIGHLIGHT(*next);
currentline = get_currentline();
if(currentline >= 0 && FUNCTOR(history(currentline)) == OR)
/* currentline can be negative if this is called from ssolve
during the calculation of the domain of the problem */
{ commentbuf(0, english(322));
/* Negative discriminant implies no solution */
}
return 0;
}
/*_______________________________________________________________________*/
int factorquadraticwithdisplay(term t, term arg, term *next, char *reason)
/* factorquadratic, with display_progress */
{ display_on();
int err = factorquadratic(t,arg,next,reason);
display_off();
return err;
}
/*_______________________________________________________________________*/
int factorquadratic(term t, term arg, term *next, char *reason)
/* factors quadratic trinomials (not binomials) in one or two variables;
also factors expressions which after a substitution reduce to a
quadratic trinomial, such as sin^2 x - 3 sin x + 2. It does not, however,
recognize things like x^4 -3x^2 + 2 which require reversepowertopower first.
Its behaviour is partly controlled by the value of 'ringflag', which
determines what kind of factors are acceptable (real or complex).
However, it doesn't try to find rational-root factors; if any coefficient
is a fraction, or a product containing a fraction, it fails.
( Automode pulls the denominators out and then factors the integer
polynomial.)
Its behavior is also controlled by the user model: if factorquadratic
is known or wellknown, then it will just do it.
If it is learning, it will show the
trial-and-error process in detail. (It no longer prompts to
the user to enter the factors in menu-mode when learning.
There is guessfactor if the user wants to enter a factor.)
If a,b,c are not all integers or rationals, do we have to fail?
How about (x-p)(x-q) = x^2 -(p+q)x + pq? --getmonomial will handle
this example correctly, returning a = 1, y=1, c = pq, b = -(p+q).
Note that getmonomial will even handle x^2 -(p^2+q^2) + p^2q^2 correctly,
but it will get confused on x^2 -(p^2+q^2) + (pq)^2 and return y = pq,
which will not result in a factorization, so factorquadratic will fail,
which is all right.
*/
{ term x,y; /* the expressions for the two variables; one of them may be
'one'; in case of ax^2 + bx + c, y is 'one'; in case of
a + by + cy^2, x is 'one'; either x or y or both could
also be a compound term such as sin(u) */
term a,b,c; /* coefficients; t = ax^2 + bxy + cy^2 */
term u,v; /* the two final factors */
int err,saveit;
if(FUNCTOR(t) != '+' || ARITY(t) != 3)
return 1;
if(!contains(t,'^') || /* reject linear input for example */
(get_mathmode() == AUTOMODE && IRREDUCIBLE(t))
)
return 1; /* don't waste time */
/* if we get here, arg is ILLEGAL,
so we have to factor it ourselves. First find the coefficients
a,b,c and the expressions to match to the variables x,y */
if(!isquadratic(t,&a,&b,&c,&x,&y)) /* write t = ax^2 + bxy + cy^2 */
{ errbuf(0, english(320));
/* Expression is not quadratic. */
return 1; /* fail */
/* catch 3(y+1)^2 +11(y^2-1) -4(y-1)^2 etc
in adhoc_autosub, making an explicit substitution. */
}
/* Now a,b,c,x,y are all instantiated to specific terms */
/* If a number can be factored out, do it */
/* (Now that we know the polynomial is quadratic) */
err = factoroutnumber(t,arg,next,reason);
if(err==0 && get_mathmode() != AUTOMODE)
{ commentbuf(0, english(1809));
commentbuf(1, english(1810));
/* A common numerical factor has been removed first.
Now you can try to factor the remaining quadratic. */
return 0;
}
saveit = get_polyvalzeropowerflag();
set_polyvalzeropowerflag(1); /* so 'test' can get rid of artificial zero exponents */
err = factor_aux(a,b,c,x,y,next);
/* finish_factor_aux (called by factor_aux)
does display if status is LEARNING in automode or UNKNOWN in menu mode */
set_polyvalzeropowerflag(saveit);
if(err==1)
{ errbuf(0, english(326)); /* This quadratic can't be factored */
errbuf(1, english(327)); /* using integer coefficients. */
SETFACTORED(t);
return 1;
}
if(err==2) /* user interruption */
return 2;
strcpy(reason, english(325)); /* factor quadratic */
/* Now, in case orderflag is ASCENDING, we need to get the
terms in each factor in correct ascending order. */
if(get_orderflag() == ASCENDING && FUNCTOR(*next) == '*')
{ additive_sortargs(ARG(0,*next));
additive_sortargs(ARG(1,*next));
}
else if(get_orderflag() == ASCENDING && FUNCTOR(*next) == '-')
{ assert(FUNCTOR(ARG(0,*next)) == '*' && ARITY(ARG(0,*next))==2);
u = ARG(0,ARG(0,*next));
v = ARG(1,ARG(0,*next));
assert(FUNCTOR(u) == '+' && FUNCTOR(v) == '+');
additive_sortargs(u);
additive_sortargs(v);
if(NEGATIVE(ARG(0,u)))
*next = product(strongnegate(u),v);
else if(NEGATIVE(ARG(0,v)))
*next = product(u,strongnegate(v));
}
/* Now, whether the additive order is ascending or descending,
we put the factors in correct multiplicative order,
to prevent immediately having to re-order the factors. */
if(NEGATIVE(*next) && FUNCTOR(ARG(0,*next))== '*')
sortargs(ARG(0,*next));
else if (FUNCTOR(*next) == '*') /* which it must */
sortargs(*next); /* to prevent immediately re-ordering the factors */
HIGHLIGHT(*next);
// let's check it. This will turn a wrong answer into a crash.
term test = sum(t,tnegate(*next));
double checkit;
deval(test,&checkit);
if(fabs(checkit) > 0.001)
{ log_term("factquad 231", test);
assert(0);
}
return 0;
}
/*___________________________________________________________*/
static term dropones(term t)
/* remove unsimplified zero exponents, unit exponents; replace products
of arity 1 by their args. Used as auxiliary in the next function. */
{ term ans,u;
unsigned short n,k;
int i;
if(FUNCTOR(t) == '*' && ARITY(t)==1)
return dropones(ARG(0,t));
if(FUNCTOR(t) == '^' && ZERO(ARG(1,t)))
return one;
if(FUNCTOR(t) == '^' && ONE(ARG(1,t)))
return dropones(ARG(0,t));
if(FUNCTOR(t) == '*')
{ n = ARITY(t);
ans = make_term('*',n);
k=0;
for(i=0;i<n;i++)
{ u = dropones(ARG(i,t));
if(ZERO(u))
{ RELEASE(ans);
return zero;
}
if(!ONE(u))
{ ARGREP(ans,k,u);
++k;
}
}
if(k==0)
{ RELEASE(ans);
return one;
}
SETFUNCTOR(ans,'*',k);
return ans;
}
return t;
}
/*_______________________________________________________________________*/
int finish_factor_aux(
term a1,term c1,
int (*ftest)(term,term,term,term,term,int,term *, term *, term *, term *),
term b, int sign, term *p, term *q, term *r, term *s
)
/* a1 and c1 are factored products (or a prime or prime power, or 'one');
(they can't be negative). We search for a way to
group the factors of a1 and c1 so that pr = a1, qs = c1, and p,q,r,s
pass the 'test' given by function ftest. When this function is
called using polydiv_test, it checks if px \pm q divides POLYnomial b;
when it's called using 'test', it checks whether
ps \pm qr = b, where the sign is specified by the parameter 'sign', which is \pm 1.
Return 0 for success, 1 for wrong input or failure, 2 for user interruption.
*q should initially be the 'display variable' or 'polynomial variable' x,
which is used to display the partial progress of the function and for
access to its value pointer for numerical checking.
*q and *r are used to initialize variables for display.
*p is used to pass the original value of b (needed only for the sign).
*/
{ int err;
int i,j,k,counter = 0;
static int polydivflag; /* factorbypolydiv calls this function twice;
this variable keeps track of which call it is. */
term a,bb,ctr;
unsigned short na1,nc1;
long *exponentsa; /* dynamic array of exponents */
long *exponentsc;
void *marknode;
term u,v,temp,temp2,localp, localq,localr,locals;
term originalb = *p;
term originalc = *s;
long *pp, *qq, *rr, *ss; /* arrays of exponents of factors of p,q,r,s */
na1 = (FUNCTOR(a1) == '*' ? ARITY(a1) : (unsigned short) 1); /* number of factors to consider */
nc1 = (FUNCTOR(c1) == '*' ? ARITY(c1) : (unsigned short) 1);
a = *q;
bb = *r;
exponentsa = (long *) callocate(na1,sizeof(long));
if(exponentsa==NULL)
{ nospace();
return 1;
}
exponentsc = (long *) callocate(nc1,sizeof(long));
if(exponentsc==NULL)
{ nospace();
return 1;
}
/* Now initialize these arrays with the exponents of the factors of a1 and c1 */
if(na1 ==1 )
{ if(FUNCTOR(a1)=='^')
{ u= ARG(1,a1);
if(!ISINTEGER(u))
return 1;
exponentsa[0] = INTDATA(u);
}
else
exponentsa[0] = 1;
}
else
for(i=0;i<na1;i++)
{ u = ARG(i,a1);
if(FUNCTOR(u) != '^')
exponentsa[i] = 1;
else
{ u = ARG(1,u);
if(!ISINTEGER(u))
return 1;
exponentsa[i] = INTDATA(u);
}
}
if(nc1==1)
{ if(FUNCTOR(c1)=='^')
{ u= ARG(1,c1);
if(!ISINTEGER(u))
return 1;
exponentsc[0] = INTDATA(u);
}
else
exponentsc[0] = 1;
}
else
for(i=0;i<nc1;i++)
{ u = ARG(i,c1);
if(FUNCTOR(u) != '^')
exponentsc[i] = 1;
else
{ u = ARG(1,u);
if(!ISINTEGER(u))
return 1;
exponentsc[i] = INTDATA(u);
}
}
pp = (long *) callocate(na1,sizeof(long)); /* arrays of exponents */
if(pp==NULL)
{ nospace();
return 1;
}
rr = (long *) callocate(na1,sizeof(long));
if(rr==NULL)
{ nospace();
return 1;
}
qq = (long *) callocate(nc1,sizeof(long));
if(qq==NULL)
{ nospace();
return 1;
}
ss = (long *) callocate(nc1,sizeof(long));
if(ss==NULL)
{ nospace();
return 1;
}
for(i=0;i<na1;i++)
rr[i] = exponentsa[i];
for(i=0;i<nc1;i++)
ss[i] = exponentsc[i];
/* pp and qq are initialized to all 0 by calloc */
/* in case a is 1, it's wasteful to check a^0 and a^1 both : */
if(na1==1 && ONE(a1))
{ rr[0] = 0; /* instead of 1 */
pp[0] = 1; /* instead of 0 */
}
if(nc1==1 && ONE(c1))
{ ss[0] = 0; /* instead of 1 */
qq[0] = 1; /* instead of 0 */
}
/* Now set up the terms localp, localq, localr, locals to be
products, whose args are powers, whose data pointer fields point
to the array elements of pp, qq, rr, ss */
localp = make_term('*',na1); /* even if na1 == 1 */
localr = make_term('*',na1);
localq = make_term('*',nc1);
locals = make_term('*',nc1);
if(na1==1)
{ u = make_term('^',2);
v = make_term('^',2);
if(FUNCTOR(a1)=='^')
{ ARGREP(u,0,ARG(0,a1));
ARGREP(v,0,ARG(0,a1));
}
else
{ ARGREP(u,0,a1);
ARGREP(v,0,a1);
}
ARGREP(u,1,one); /* so functor, arity, and info are right for an integer */
ARGREP(v,1,one);
ARG(1,u).args = (void *) pp;
ARG(1,v).args = (void *) rr;
ARGREP(localp,0,u);
ARGREP(localr,0,v);
}
else for(i=0;i<na1;i++)
{ u = make_term('^',2);
v = make_term('^',2);
if(FUNCTOR(ARG(i,a1))=='^')
{ ARGREP(u,0,ARG(0,ARG(i,a1)));
ARGREP(v,0,ARG(0,ARG(i,a1)));
}
else
{ ARGREP(u,0,ARG(i,a1));
ARGREP(v,0,ARG(i,a1));
}
ARGREP(u,1,one);
ARGREP(v,1,one);
ARG(1,u).args = (void *)(pp+i);
ARG(1,v).args = (void *)(rr+i);
ARGREP(localp,i,u);
ARGREP(localr,i,v);
}
if(nc1==1)
{ u = make_term('^',2);
v = make_term('^',2);
if(FUNCTOR(c1) == '^')
{ ARGREP(u,0,ARG(0,c1));
ARGREP(v,0,ARG(0,c1));
}
else
{ ARGREP(u,0,c1);
ARGREP(v,0,c1);
}
ARGREP(u,1,one);
ARGREP(v,1,one);
ARG(1,u).args = (void *) qq;
ARG(1,v).args = (void *) ss;
ARGREP(localq,0,u);
ARGREP(locals,0,v);
}
else for(i=0;i<nc1;i++)
{ u = make_term('^',2);
v = make_term('^',2);
if(FUNCTOR(ARG(i,c1))=='^')
{ ARGREP(u,0,ARG(0,ARG(i,c1)));
ARGREP(v,0,ARG(0,ARG(i,c1)));
}
else
{ ARGREP(u,0,ARG(i,c1));
ARGREP(v,0,ARG(i,c1));
}
ARGREP(u,1,one);
ARGREP(v,1,one);
ARG(1,u).args = (void *)(qq+i);
ARG(1,v).args = (void *)(ss+i);
ARGREP(localq,i,u);
ARGREP(locals,i,v);
}
ctr = make_int(100L); /* allocate space at ARGPTR(ctr) */
INTDATA(ctr) = counter; /* put counter in the new space; since
make_int uses static space for small values,
make_int(counter) would be wrong. We are
going to re-use this space. */
marknode = heapmax();
*q = a;
*r = bb;
while(1)
{ /* don't waste time when p and q have a common factor */
/* but localp and localq can be products of arity 1, which
shouldn't be passed to cancel */
err = cancel(dropones(localp), dropones(localq), &temp, &temp2);
if(err) /* no common factor of p and q */
/* It would be mistaken to skip trial factors
with a common factor of r and s, as the second
factor will usually not be linear, so a common
factor of r and s could not be taken out, as
with a common factor of p and q. */
{ *p = originalb;
*s = originalc;
err = (* ftest)(localp,localr,localq,locals,b,sign,p,r,q,s);
}
else
err = 1;
if(err==0 || err ==2) /* 0 is success, 2 is user interruption */
break;
/* Not done yet, so we must now change to next p,q,r,s */
/* in reverse lexicographical order on the exponent arrays */
++counter;
reset_heap(marknode); /* otherwise we run out of memory on
not-too-big seeming problems; formerly
did this only every 16 times through the loop,
but ran out of memory anyway */
/* for this factorization of a1, try various factorizations of c1 */
if(counter >=25 && ftest == gtest)
/* No need to guard this with inq_display_on() as it's
never called in auto mode */
{ INTDATA(ctr) = counter; /* use same space over and over */
display_progress(ctr, 328); /* Number of trials: */
// in WebMathXpert, the return value of display_progress is meaningless,
// the display cannot be stopped by the user as it could in Windows MathXpert.
}
j=0;
while(qq[j]==exponentsc[j] && j < nc1)
++j; /* find the first factor with a non-maximal exponent */
if(j < nc1) /* yep, there is a factor with a non-maximal exponent */
{ ++qq[j]; /* increase that exponent */
--ss[j];
for(k=0;k<j;k++) /* set preceding exponents to zero */
{ qq[k]=0;
ss[k] = exponentsc[k];
}
}
else /* tried all factorizations of c1 for this factorization of a1,
so reset q to 1 and s to c1 */
{ if(nc1==1 && ONE(c1))
{ ss[0] = 0; /* instead of 1 */
qq[0] = 1; /* instead of 0 */
}
else
for(k=0;k<nc1;k++)
{ qq[k]=0;
ss[k] = exponentsc[k];
}
/* and now change the factorization of a1 */
i=0;
while(pp[i]==exponentsa[i] && i < na1)
++i;
if(i < na1)
{ ++pp[i];
--rr[i];
for(k=0;k<i;k++)
{ pp[k]=0;
rr[k]=exponentsa[k];
}
}
else /* failure */
{ err = 1;
break; /* don't return yet, we must free memory first */
}
}
*q = a;
*r = bb;
}
/* if we get here with err ==0, we found a successful factorization */
for(i=0;i<na1;i++)
{ RELEASE(ARG(i,localp));
RELEASE(ARG(i,localr));
}
RELEASE(localp);
RELEASE(localr);
for(i=0;i<nc1;i++)
{ RELEASE(ARG(i,localq));
RELEASE(ARG(i,locals));
}
RELEASE(localq);
RELEASE(locals);
if(HASARGS(ctr))
RELEASE(ctr);
free2(pp);
free2(qq);
free2(rr);
free2(ss);
free2(exponentsa);
free2(exponentsc);
#if 0
if(
( !err /* finished factoring */
||
((void *) ftest != (void *) polydiv_test || polydivflag )
/* don't leave progressww after the FIRST call to this function
from factorbypolydiv, wait for the SECOND one, as kept track of
by polydivflag */
)
)
end_display_progress();
#endif
/* Now in case of failure, we need to reset the heap. In case of
success, we have values on the heap that we want, and the heap
will be reset by gc() in top.c anyway. But without resetting the
heap here in case of failure, you can run out of memory by trying
the operator two or three times. Unlikely, but still you shouldn't
run out of memory by doing it. */
if(err)
{ reset_heap(marknode);
if(ftest == polydiv_test && err == 1)
polydivflag = polydivflag ? 0 : 1; /* toggle it */
}
else
polydivflag = 0; /* next call will be the first */
return err;
}
/*______________________________________________________________________*/
/* r and s are not used */
static int polydiv_test(term p,term r,term q,term s,term t,int sign, term *pp, term *rr, term *qq, term *ss)
/* test whether (px \pm q) divides POLYnomial t, where 'sign' specifies
(by its sign) whether \pm is to be + or -;
if it does divide, return 0, and copy p and q into *pp and *qq;
return 1 if it doesn't divide;
return value 2 means user interruption;
return value 3 means coefficients or degree too big to handle.
The absolute value of 'sign' is the number of variables in t;
thus it is 1 for a univariate, 2 for a bivariate, and so on.
The terms p,r,q,s are passed from finish_factor_aux, and can be
products of arity 1
The initial value of *qq is the 'display variable' x, used in
displaying the progress of the function, and in numerical checks.
*/
/* For speed, we first evaluate the polynomial at x=2,y=3 (or just x=2
for a univariate). The abs of the resulting double value, stored in a term, is
passed as the initial value of *ss. The 'value' of the variables has
also been set to 2 and 3 (as doubles). Hence deval can be called on
each trial factor, the result rounded to an integer, and if it
doesn't divide *ss, we can reject that factor immediately, without doing
polynomial arithmetic ! The values 2 and 3 are chosen by factorbypolydiv
and not assumed here. */
{ term divisor;
term pval,qval,signedqval,showit,x;
int i,err,exponent;
unsigned short n = (unsigned short)(ARITY(t)-1); /* degree of t */
double tryit,pnumval,partialsum,temp;
x = *qq; /* which is not altered unless we succeed to find a factor */
assert(n >= 1); /* this is never given a constant polynomial */
assert(FUNCTOR(p) == '*');
assert(FUNCTOR(q) == '*');
if(ARITY(p)==1 && FUNCTOR(p) == '*')
p = ARG(0,p);
if(ARITY(q)==1 && FUNCTOR(q) == '*')
q = ARG(0,q);
if(ARITY(r)==1 && FUNCTOR(r) == '*')
r = ARG(0,r);
if(ARITY(s)==1 && FUNCTOR(s) == '*')
s = ARG(0,s);
assert(get_polyvalzeropowerflag()); /* set by calling function */
/* this makes polyval eliminate zero exponents */
/* in any case it will eliminate exponents of 1 */
polyval(p,&pval); /* uses fresh space */
polyval(q,&qval);
signedqval = (sign >= 0 ? qval : tnegate(qval));
showit = sum(product(pval,x),signedqval);
erasecolors(&showit);
SETCOLOR(signedqval,30); /* yellow on blue background */
if(inq_display_on() &&
status(factorbypolydiv) <= KNOWN
)
{ display_progress(showit, 329); /* Trying linear factor: */
// In Windows MathExpert, this block of code had a wait programmed in.
// But in Web MathXpert, the Engine needs to respond quickly, we cannot "wait".
// So now, display_progress is just called many times quickly and the temporary
// results are sent to the browser, see sendDocument. In Windows, the user
// could interrupt this trial-and-error; that will now be up to the interface.
}
if(sign==1 || sign == -1) /* a univariate polynomial */
{ /* then just see if x = -signedqval/pval is a root */
err = deval(pval,&pnumval);
assert(!err);
err = deval(signedqval,&tryit);
assert(!err);
tryit = -tryit/pnumval;
if(n * pnumval > 300)
goto usepolydiv;
/* deval can't be given a POLY */
deval(ARG(0,t),&partialsum);
if(partialsum == BADVAL)
return 3;
for(i=1;i<=n;i++)
{ if(ZERO(ARG(i,t)))
continue;
deval(ARG(i,t),&temp);
if(temp == BADVAL)
return 3;
frexp(temp,&exponent);
if(i*exponent > 300)
goto usepolydiv;
else if(i==1)
temp *= tryit;
else
temp *= pow(tryit,i);
partialsum += temp;
}
/* if partialsum is zero it's a root. If it's not zero it's at least
how far from zero? 1/pval^n, where n is the degree of t.
So its log2 would be at worst -n*pval. */
if(partialsum == 0.0)
{ *pp = pval; /* already in fresh space */
*qq = qval;
return 0; /* it's a root */
}
/* but it might still be a root, even if partial sum isn't
exactly zero, due to roundoff error */
frexp(partialsum,&exponent);
if((double) exponent < -(double) n*pnumval - 10.0) /* 10 for roundoff error */
{ *pp = pval; /* already in fresh space */
*qq = qval;
return 0; /* it's a root */
}
else
return 1; /* not a root */
}
/* Now try numerical testing on bivariates: */
err = deval(showit,&tryit);
if(err)
{ errbuf(0, english(330));
/* Coefficients or degrees too large. */
errbuf(1, english(331)); /* Sorry about that. */
return 3;
}
frexp(tryit,&exponent);
if(testvalue != 0.0 && exponent <= 49) /* not too large for accurate representation
as a double, proceed */
{ /* Does tryit divide testvalue ? */
if(tryit < 0.0)
tryit = - tryit;
if(tryit > testvalue)
return 1;
if(testvalue - tryit > 0.5) /* they're not equal; does tryit divide testvalue? */
{ if( fmod(testvalue,tryit) > 0.5)
/* tryit does not divide testvalue */
return 1;
}
}
/* Now we really have to check it using polynomial arithmetic */
usepolydiv:
divisor = make_term(POLY,2);
ARGREP(divisor,0,signedqval);
ARGREP(divisor,1, pval);
pseudodiv(t,divisor,pp,rr,ss);
if(ARITY(*rr)==1 && ZERO(ARG(0,*rr))) /* zero remainder */
{ destroy_term(*pp); /* pseudodiv returns in fresh space */
destroy_term(*rr);
destroy_term(*ss);
*pp = pval; /* already in fresh space */
*qq = qval;
return 0;
}
return 1;
}
/*_______________________________________________________________________*/
static int factor_aux_helper(term a, term *a1, int *signa)
/* Make *a1 the prime-power factorization of a, with any symbolic
factors of a tacked on at the end of *a1. *signa is initially +1 or -1;
toggle it if *a1 has a different sign than a. Return 0 for success,
1 for failure (non-numerical term to be factored for example). */
{ term nn, cc, ss, temp;
unsigned na;
int err;
ncs(a,&nn,&cc,&ss);
if(INTEGERP(nn))
factor_integer(nn,&na,&temp);
/* don't look for complex factors of integers,
it takes too long and would confuse students
*/
else if(!get_complex() || !iscomplex(nn))
{ errbuf(0,english(332));
/* Numerical coefficients must be integers */
return 1;
}
else
{ err = factor_gaussian_integer(nn,&na,&temp);
if(err < 0)
{ errbuf(0,english(333));
/* Numerical coefficients must be complex integers */
return 1;
}
if(FUNCTOR(temp)=='-')
{ temp = ARG(0,temp);
*signa = *signa == -1 ? 1 : -1;
}
}
*a1 = product3(temp,cc,ss);
return 0;
}
/*_______________________________________________________________________*/
static int factor_aux(term a,term b,term c,term x,term y,term *ans)
/* factor ax^2 + bxy + cy^2 and return the factored form in *ans,
if possible; return value 0 indicates success, 1 means it doesn't factor;
2 means user interruption. */
/* a,b, and c can be positive or negative integers,
but not rationals; they can also be
symbolic products, whose factors are integers or other terms, which
are not decomposed further. For example, we have to factor x^2 -(p+q) + pq,
in which case a = 1, b = -(p+q), c = pq, y = 1.
If only one sign is negative in (x-r1)(x+r2), the negative sign is
put in the first factor.
*/
{ unsigned na,nc;
int err;
term a1,c1;
term temp;
int signa=1;
int signc=1;
term p,q,r,s;
if(FUNCTOR(a) == '-') /* this sign will be tacked on again at the end */
{ signa = -1;
a = ARG(0,a);
b = tnegate(b);
c = tnegate(c);
}
if(FUNCTOR(c) == '-')
{ signc = -1;
c = ARG(0,c);
}
if(FUNCTOR(b) == '+') /* as in x^2 + (p+q)x + pq */
{ if(ARITY(b) > 2)
return 1; /* no hope */
}
/* Now we don't have to worry about signs while factoring a and c */
if(numerical(a))
/* don't call factor_gaussian_integer unless a is itself complex */
{ if(INTEGERP(a))
factor_integer(a,&na,&a1);
else
{ errbuf(0,english(332));
/* Numerical coefficients must be integers. */
return 1;
}
}
else if(get_complex() && complexnumerical(a))
{ err = factor_gaussian_integer(a,&na,&a1);
if(err < 0)
{ errbuf(0,english(333));
/* Numerical coefficients must be complex integers */
return 1;
}
if(FUNCTOR(a1)=='-')
{ a1 = ARG(0,a1);
signa = signa == -1 ? 1 : -1;
}
}
else
{ err = factor_aux_helper(a,&a1,&signa);
if(err)
return 1;
}
if(numerical(c))
{ if(INTEGERP(c))
factor_integer(c,&nc,&c1);
else
{ errbuf(0,english(332));
/* Numerical coefficients must be integers */
return 1;
}
}
else if(get_complex() && complexnumerical(c))
{ err = factor_gaussian_integer(c,&nc,&c1);
if(err<0)
{ errbuf(0, english(333));
/* Numerical coefficients must be complex integers */
return 1;
}
if(FUNCTOR(c1)=='-')
{ c1 = ARG(0,c1);
signc = signc == -1 ? 1 : -1;
}
}
else
{ err = factor_aux_helper(c,&c1,&signc);
if(err)
return 1;
}
/* Now a1 and c1 are the prime-power factorizations of a and c,
with any symbolic factors tacked on at the end. We have to find
groupings of these factors that make the sum come out right.
That is,
*ans = (sign a)(px+ sign1*qy)(rx+sign2*sy),
where: pr = a1, qs = c1, sign1*sign2 = signc,
and sign1*qr + sign2*ps = b
*/
r = y;
q = x; /* finish_factor_aux looks here for the variables to use
for display_progress in case this op is LEARNING */
if(FUNCTOR(b) == '-' && signc == 1)
{ p = b;
s = c;
err = finish_factor_aux(a1,c1,test,ARG(0,b),1,&p,&q,&r,&s);
if(err)
return err;
/* now ps + qr = -b = ARG(0,b)*/
/* Let's check that, in case everything is numerical */
if(numerical(p) && numerical(q) && numerical(r) && numerical(s))
{ double pval,qval,rval,sval,bval;
deval(p,&pval); deval(q,&qval); deval(r,&rval); deval(s,&sval);
deval(b,&bval);
double checkit = pval * sval + qval *rval + bval;
assert(fabs(checkit) < 0.001);
}
temp = product( // (rx-sy)(px-qy)
sum(product(r,x),strongnegate(product(s,y))),
sum(product(p,x),strongnegate(product(q,y))) // corrected 1.24.25
);
*ans = (signa==1 ? temp : tnegate(temp));
return 0;
}
if(signc == 1) /* and b is positive, so sign1 and sign2 are both 1 */
{ err = finish_factor_aux(a1,c1,test,b,1,&p,&q,&r,&s);
if(err)
return err;
temp = product(
sum(product(p,x),product(q,y)),
sum(product(r,x),product(s,y))
);
*ans = (signa==1 ? temp : strongnegate(temp));
return 0;
}
/* Now signc = -1 so sign1 = -1 and sign2 = +1 */
err = finish_factor_aux(a1,c1,test,b,-1,&p,&q,&r,&s);
if(!err)
{ temp = product(
sum(product(p,x),strongnegate(product(q,y))),
sum(product(r,x),product(s,y))
);
*ans = (signa==1 ? temp : strongnegate(temp));
return 0;
}
return err; /* failure, or user interruption */
}
/*_______________________________________________________________________*/
int test(term p,term r, term q, term s, term b, int sign, term *ansp, term *ansr, term *ansq, term *anss)
/* test whether ps \pm qr = b, where the sign is specified by the parameter 'sign',
which is \pm 1. If so return 0, else return 1.
In EITHER CASE
instantiate *ansp, *ansr, *ansq, *anss to the values of p,r,q,s, using
NEW SPACE. Does not have to destroy terms it makes as finish_factor_aux
uses reset_heap to control memory.
Return value 2 used to mean user interruption, but as of 2024 the user can no longer interrupt,
as the result is sent to the browser all at once.)
*/
/* The initial values of *ansp, *ansr, *ansq, *anss are also used
to pass information used for display_progress.
*/
/* The terms p,r,q,s may be symbolic or numerical or mixed */
{ term pval,rval,qval,sval,tt,u,testval,fordisplay;
term a,bb;
int err;
a = *ansq;
bb = *ansr;
term originalb = *ansp;
term originalc = *anss;
/* This seems wrong: */
if(ARITY(p)==1)
p = ARG(0,p);
if(ARITY(q)==1)
q = ARG(0,q);
if(ARITY(r)==1)
r = ARG(0,r);
if(ARITY(s)==1)
s = ARG(0,s);
err = polyval(p,&pval); /* uses fresh space */
if(err)
return 1;
err = polyval(q,&qval);
if(err)
return 1;
err = polyval(r,&rval);
if(err)
return 1;
err = polyval(s,&sval);
if(err)
return 1;
if(sign==1)
tt = sum(product(pval,sval),product(qval,rval));
else
tt = sum(product(pval,sval),tnegate(product(qval,rval)));
u = sum(tt, tnegate(b));
polyval(u,&testval);
if(inq_display_on())
{ if(sign==1)
fordisplay = product(
sum(product(rval,a),product(sval,bb)),
sum(product(pval,a),product(qval,bb))
);
else if (NEGATIVE(originalb) && !NEGATIVE(originalc))
fordisplay = product(
sum(product(rval,a),strongnegate(product(sval,bb))),
sum(product(pval,a),product(qval,bb))
);
else
fordisplay = product(
sum(product(pval,a),strongnegate(product(qval,bb))),
sum(product(rval,a),product(sval,bb))
);
erasecolors(&fordisplay);
SETCOLOR(qval,30);
SETCOLOR(sval,30);
SETCOLOR(pval,30);
SETCOLOR(rval,30); /* yellow on blue */
display_progress(fordisplay, 334); /* Trying factors: */
}
*ansp = pval;
*ansq = qval;
*ansr = rval;
*anss = sval;
RELEASE(tt);
return ZERO(testval) ? 0 : 1;
}
/*_______________________________________________________________________*/
int factorbypolydiv(term t, term arg, term *next, char *reason)
/* search for linear factor (and test it by polydiv) */
/* Return 0 for success, 1 for failure, 2 for user interruption */
{ int i,err,saveit,count;
term x; /* the variable in which things will be polynomials */
term a; /* leading term of t */
POLYnomial p; /* POLYnomial form of t in x */
POLYnomial uu;
void *savenode;
term c; /* constant term of t */
term num, con, sym; /* ncs parts of c */
unsigned nfactors; /* number of prime-power factors in c */
unsigned mfactors; /* number of prime-power factors in a */
term factoredc; /* factored form of c */
term factoreda; /* factored form of a */
int inconclusiveflag = 0; /* set if c is not a monomial in y */
unsigned short degree;
long constantdegree;
term r,pp,qq,rr,cc,s,temp,u,v,y,coef,constcoef,ccc;
int natoms,exponent;
int whichtry = 1;
term *atomlist;
if(FUNCTOR(t) != '+')
return 1; /* this only works on sums */
if(contains(t,VAR))
return 1; /* assert(0); this could happen if somehow polyval got
called with polyvalfactorflag2 set to 1, on input
containing var0. In which case, just fail. */
if(contains_bignum(t))
{ errbuf(0, english(330));
/* Coefficients or degrees too large. */
errbuf(1, english(331)); /* Sorry about that. */
return 1;
}
natoms= atomsin(t,&atomlist);
if(natoms == 0)
return 1; /* can't factor constant expressions like 1-sqrt 2 */
if(natoms == 1)
{ x = atomlist[0]; /* that was easy */
if(FUNCTOR(arg) != ILLEGAL /* user has specified the variable */
&& !equals(x,arg)
)
return 1; /* user's variable DOES occur somewhere */
err = makepoly(t,x,&p);
if(err)
{ errbuf(0, english(335));
/* Expression not a polynomial. */
return 1;
}
if(natoms == 1 && !intpolynomial(p))
{ errbuf(0,english(336));
/* Coefficients must be integers */
return 1;
}
}
else if(natoms > 2)
{ errbuf(0, english(337)); /* This operation only works if there */
errbuf(1, english(338)); /* are at most two variables. */
free2(atomlist);
return 1;
}
else /* if natoms == 2, determine the variables */
{ x = atomlist[0];
y = atomlist[1];
free2(atomlist);
if(FUNCTOR(arg) != ILLEGAL && !equals(x,arg))
{ /* swap x and y */
temp = x;
x = y;
y = temp;
}
else
{ err = makepoly(t,x,&p);
if(err)
{ /* swap x and y and try it the other way */
temp = x;
x = y;
y = temp;
err = makepoly(t,x,&p);
if(err)
{ errbuf(0, english(335));
/* Expression not a polynomial. */
return 1;
}
whichtry = 2; /* don't re-swap if it fails */
}
}
}
start:
degree = (unsigned short) (ARITY(p)-1);
if(degree == 1)
return 1;
/* Don't leave anything in error_buffer: if it failed in menu mode
on a nonlinear poly, an error message was already left, and this
will write over it when it's tried on any linear polynomials that
may be to the right of the nonlinear one.
*/
if(get_mathmode() == AUTOMODE && degree == 2 && natoms > 1)
return 1; /* don't work on quadratics in two or more variables */
/* quadratics in one variable will be similarly rejected below */
if(natoms == 2)
{ /* check that it's a polynomial with integer coefficients */
for(i=0;i<=degree;i++)
{ coef = ARG(i,p);
if(NEGATIVE(coef))
coef = ARG(0,coef);
if(INTEGERP(coef))
continue;
if(!contains(coef,FUNCTOR(y)))
{ errbuf(0,english(336));
/* Coefficients must be integers */
return 1;
}
err = makepoly(coef,y,&temp);
if(err)
{ errbuf(0,english(335));
/* Expression not a polynomial. */
return 1;
}
if(!intpolynomial(temp))
{ errbuf(0,english(336));
/* Coefficients must be integers */
return 1;
}
RELEASE(temp); /* made by makepoly */
}
}
if(natoms > 1)
{ SETVALUE(x,3.0); /* for use by polydivtest */
SETVALUE(y,2.0);
err = deval(t,&testvalue);
if(err)
goto toobig;
frexp(testvalue,&exponent);
if(exponent > 49) /* too large to represent an integer accurately
allowing four bits for roundoff error */
testvalue = 0.0; /* signals don't use it */
if(testvalue < 0.0)
testvalue = -testvalue;
if(testvalue < 0.1)
testvalue = 0.0; /* correct any roundoff error */
}
c = ARG(0,p); /* the 'constant' term of p, but it may contain letters */
a = ARG(degree,p); /* leading coefficient of p */
if(ZERO(c))
{ errbuf(0, english(340)); /* First factor out a common term. */
return 1;
}
assert(!ZERO(a));
if(NEGATIVE(c))
c = ARG(0,c);
if(NEGATIVE(a))
a = ARG(0,a);
if(PRIME(c))
{ factoredc = c;
if(FUNCTOR(c) == '*')
nfactors = ARITY(c);
else
nfactors = 1;
}
else /* get the factored form of c */
{ if(INTEGERP(c))
{ num = c;
sym = con = one;
}
else
{ ncs(c,&num,&con,&sym); /* numerical, 'constant', and symbolic parts of c */
assert(INTEGERP(num));
assert(natoms == 2);
if( monomial_form(sym,y,&constantdegree,&constcoef)) /* that is, if it's NOT a monomial in y*/
{ inconclusiveflag = 1; /* can't conclude no linear factor exists
if this operator fails */
}
}
err = factor_integer(num,&nfactors,&temp);
if(err==6)
{ errbuf(0, english(341));
/* Constant term is too big */
errbuf(1, english(342));
/* for MathXpert to factor. */
return 1;
}
factoredc = product3(temp,con,sym);
}
if(PRIME(a))
{ factoreda = a;
if(FUNCTOR(a) == '*')
mfactors = ARITY(a);
else
mfactors = 1;
}
else /* get the factored form of a */
{ ncs(a,&num,&con,&sym);
err = factor_integer(num,&mfactors,&temp);
if(err==6)
{ errbuf(0, english(343));
/* Leading coefficient is too big */
errbuf(1, english(342));
/* for MathXpert to factor */
return 1;
}
factoreda = product3(temp,con,sym);
}
/* Now we have to try all linear factors (ux+v)
where v divides c and u divides a,
making used of factoreda and factoredc to generate u and v */
qq = x; /* this passes x so it can be used to display what's going on,
even though it isn't needed in the computations */
saveit = get_polyvalzeropowerflag();
set_polyvalzeropowerflag(1); /* so 'test' can get rid of artificial zero exponents */
err = finish_factor_aux(factoreda,factoredc,polydiv_test,p,-natoms,&pp,&qq,&r,&s);
set_polyvalzeropowerflag(saveit);
if(err == 3)
goto toobig;
else if(err == 0)
u = sum(product(pp,x),tnegate(qq));
else if(err==2)
return 2; /* user interruption */
else if(err==1)
{ saveit = get_polyvalzeropowerflag();
set_polyvalzeropowerflag(1); /* so 'test' can get rid of artificial zero exponents */
err = finish_factor_aux(factoreda,factoredc,polydiv_test,p,natoms,&pp,&qq,&r,&s);
set_polyvalzeropowerflag(saveit);
if(err == 3)
goto toobig;
if(err==1 && natoms ==2 && whichtry ==1 && FUNCTOR(arg) == ILLEGAL)
{ /* switch x and y and try again */
temp = x;
x = y;
y = temp;
whichtry = 2;
err = makepoly(t,x,&p);
if(!err)
goto start;
/* To get rid of this goto, I could replace the label
'start' by 'while(1)' and the 'goto' by
'continue'. Would that be more readable or
easier to verify? I think not. */
}
if(err == 1) /* failure */
{ errbuf(0, english(344));
/* Exhaustive search failed. */
if(!inconclusiveflag)
errbuf(1, english(345));
/* There is no linear factor. */
else
{ errbuf(1, english(346));
/* But the constant term was not */
errbuf(2, english(347));
/* a monomial. Maybe it factors; if */
errbuf(3, english(348));
/* so, we missed some possibilities. */
}
return 1;
}
else if(err == 2)
return err; /* user interruption */
u = sum(product(pp,x),qq);
}
assert(!err);
strcpy(reason, english(349)); /* linear factor */
r = zero;
/* In finish_factor_aux we've already divided t by u, but the result
is lost, and besides, t may contain a higher power of u than the first.
Now we have to divide out as many powers of u as will come.
*/
err = makepoly(u,x,&uu);
assert(!err);
rr = zero;
ccc = one;
count = 0;
while(1)
{ savenode = heapmax();
pseudodiv(p,uu,&qq,&rr,&cc);
/* rr is a POLYnomial; is it zero? */
if(ARITY(rr) > 1 || !ZERO(ARG(0,rr)))
break; /* nonzero remainder */
polyval(product(cc,ccc),&ccc);
++count;
save_and_reset(and(qq,ccc),savenode,&temp);
p = ARG(0,temp);
ccc = ARG(1,temp);
}
reset_heap(savenode);
assert(count > 0);
y = poly_term(p,x);
if(!ONE(ccc))
{ /* example: factoring 18n^4 + 25n^3 - 3 we get here with
ccc = 81, u = 3n-1, y = 486 n^3 + 162n^2 + 729 n + 243.
The 81 will cancel out of y */
err = cancel(y,ccc,&v,&temp);
if(!err)
{ y = temp;
err = cancel(ccc,v,&r,&temp);
assert(!err);
ccc = temp;
}
}
if(FUNCTOR(y) == '+')
additive_sortargs(y); /* use ascending order if required */
if(NEGATIVE(ccc))
v = tnegate(product(reciprocal(ARG(0,ccc)),y));
else
v = product(reciprocal(ccc),y);
if(count > 1)
*next = product(make_power(u,make_int(count)),v);
else
*next = product(u,v);
if(FUNCTOR(*next) == '*')
sortargs(*next);
HIGHLIGHT(*next);
return 0;
toobig:
errbuf(0, english(330)); /* Coefficients or degrees too large. */
errbuf(1, english(331)); /* Sorry about that. */
return 1;
}
/*______________________________________________________________*/
static int contains_bignum(term t)
/* return 1 if t contains a bignum, 0 if not */
{ unsigned short i,n;
if(OBJECT(t) && TYPE(t) == BIGNUM)
return 1;
if(ATOMIC(t))
return 0;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(contains_bignum(ARG(i,t)))
return 1;
}
return 0;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists