Sindbad~EG File Manager
/*
M. Beeson, some operators for MathXpert's factoring menu
Original date: 12.31.90
modified 3.12.99
1.6.00 removed useless operation 'finishedfactoring'
1.13.00 modified writeaspoly
1.15.00 added complexflag to differenceofsquares, and code that uses it.
1.18.00 improved long_quadratic
8.28.04 corrected at line 1720
1.14.11 modified quadraticformula to not require constant coefficients but only that they not contain the eigenvariable.
5.6.13 added include mpdoc.h, automode.h and calc.h
5.9.13 modified writeaspoly to work right on terms of power series.
5.13.13 added SET_ALREADY(*next) at the end of writeaspoly.
5.31.13 corrected factor_once
6.17.13 removed mention of dead topic alg1_quadratic_formula
8.24.23 eliminated OEM for supn
2.16.25 corrected writeaspoly to check whether denom contains x, and removed unused vars
*/
/* note, makesubstitution, unwinddefinition, and
invisiblesub are in defns.c; advfact.c contains operators for
'advanced factoring' menu. */
/* General Remarks:
(1) Consider the task: factor x^2 -3. Do we want only factors over Z
or do we want the factorization (x-sqrt(3)(x+sqrt(3))? This is
controlled by the global variable 'ringflag', whose possible values are
documented in globals.h. According to the bits of ringflag, we will
seek complex, integral, rational, or involving-roots-of-constants factors.
(2) We must factor both univariate and multivariate polynomials. We
must also factor expressions f(u(x)) where u is an arbitrary function
and f is a polynomial, e.g. sin^2 x -1. These also must be done in
both the multivariate and univariate case. Unlike in answer-only
computation systems, we can't reduce the multivariate case to the univariate
case; that won't maintain cognitive fidelity.
(3) We don't need to offer factoring capabilities beyond the standard
curriculum.
*/
#include <string.h>
#include <assert.h>
#include <stddef.h> /* ptrdiff_t */
#include "globals.h"
#include "tdefn.h"
#include "ops.h"
#include "probtype.h"
#include "factor.h"
#include "simpprod.h"
#include "prover.h"
#include "order.h"
#include "cancel.h"
#include "algaux.h"
#include "complex4.h"
#include "polynoms.h"
#include "mpmem.h"
#include "pvalaux.h"
#include "eqn.h" /* derivative_subterm */
#include "symbols.h"
#include "mathmode.h" /* get_currenttopic */
#include "errbuf.h"
#include "mstring.h"
#include "surdsimp.h"
#include "nfactor.h" /* primality_test */
#include "autosimp.h" /* set_pathtail etc. */
#include "psubst.h"
#include "cflags.h" /* display_on */
#include "dcomplex.h" /* ceval needs this */
#include "ceval.h" /* complexnumerical */
#include "solvelin.h" /* derivative_subterm */
#include "graphstr.h" /* required by cgraph.h */
#include "cgraph.h" /* required by mpdoc.h */
#include "mpdoc.h" /* required by automode.h */
#include "automode.h" /* factorops */
#include "trig.h" /* writeaspoly */
#include "calc.h" /* factorop */
static int difofsquaresinfract(term t, term arg, term *next, char *reason);
static int factor_once(term t, term *ans, char *reason);
/*_______________________________________________________________________*/
/* if you add new factoring ops, put them into preops.c or autosum.c as well */
static actualop factorops1[NFACTOROPS] =
{ factoroutnumber,
cleardenoms,
contentfactor,
differenceofsquares,
sumofsquares,
factorsquareofsum,
factorsquareofdif,
factorquadratic,
quadraticformula,
differenceofcubes,
sumofcubes,
sumoffourthpowers,
factorquartic,
differenceofnthpowers,
sumofnthpowers,
factorbypolydiv, /* automode brother of guesslinearfactor */
factorbygrouping,
squarefreefactors
};
actualop factorops(int i)
/* access the above array from other files */
{ return factorops1[i];
}
unsigned short factor_arities[NFACTOROPS] =
/* arities needed by above operators */
/* 0 means any arity ok */
{ 0,0,0,2,2, /* up to sumofsquares */
3,3,3,3, /* up to quadraticformula */
2,2,2,3,2,2, /* up to sumofnthpowers */
0,0,0
};
/*_______________________________________________________________________*/
void listratgcd(term *a, unsigned short n, term *ans)
/* compute the ratgcd (see file cancel.c) of a list (dynamic array) of
terms; n is the number of terms in array a */
/* ratgcd of 1/2 and 1/3 is 1, not 1/6 */
/* If there is any non-number in the list the ratgcd will be one */
{ int i;
term temp,sofar,u;
if(n==0)
return;
if(n==1)
{ *ans = a[0];
return;
}
sofar = NEGATIVE(a[0]) ? ARG(0,a[0]) : a[0];
for(i=1;i<n;i++)
{ u = NEGATIVE(a[i]) ? ARG(0,a[i]) : a[i];
if(!RATIONALP(u) && !INTEGERP(u))
{ *ans = one;
return;
}
ratgcd(sofar,u,&temp);
if(i>1)
destroy_term(sofar); /* created by ratgcd */
sofar = temp;
}
*ans = sofar;
return;
}
/*_______________________________________________________________________*/
int factoroutnumber(term t, term arg, term *next, char *reason)
/* factors out a numerical term (numerical meaning no atoms) such that
what is left has no common numerical factor. If t had only integer
numerical coefficients, for example, then what is left will be a primitive
polynomial over Z (coefficients have no common divisor).
Numerical terms such as \sqrt 2 will be factored out if (and only if) they are
LITERALLY identical. For example, nothing will be done to \sqrt 17 + \sqrt 34 x.
If t has RATIONAL coefficients, it does NOT clear denominators. Nothing
will be done, for example, to (1/3) + (1/4)x. To convert such terms to
primitive polynomials, you must use the operator cleardenoms.
Will refuse to factor out a rational number, as in 1/(42x) + 3/(14x),
at least in auto mode.
*/
{ term r; /* for the rational part of one summand of t */
term a; /* for the numbers whose gcd has to be taken to get the
number to be factored out */
term temp;
term c; /* for the constant to be factored out */
int sign; /* \pm 1 for the sign of c */
term b; /* what's left */
term trash;
int i,err;
unsigned short n;
if(FUNCTOR(t) != '+')
return 1;
n = ARITY(t);
if(get_mathmode() == AUTOMODE && get_complex() &&
iscomplex(t) && /* this just checks if complexi occurs in t */
complexexpression(t) /* is it of the form a+bi? */
)
return 1; /* don't factor a complex number already in the form a + bi */
a = make_term('+',n);
b = make_term('+',n);
for(i=0;i<n;i++)
{ ratpart(ARG(i,t),&r);
if(ONE(r))
return 1; /* stop as soon as a 1 is encountered */
if(OBJECT(r) && TYPE(r) == DOUBLE)
return 1; /* fail */
if(NEGATIVE(r) && OBJECT(ARG(0,r)) && TYPE(ARG(0,r))==DOUBLE)
return 1; /* fail */
if(!NUMBER(r)) /* ratpart can return e.g. 3^2 */
{ value(r,&temp); /* but it only does so if the value exists */
r = temp;
}
ARGREP(a,i,r);
}
/* Now all the terms in a.r are rationals or integers
as required by ratgcd */
listratgcd(ARGPTR(a),n,&c); /* c always comes back positive */
if(ONE(c) || (RATIONALP(c) && get_mathmode() == AUTOMODE))
{ RELEASE(a);
RELEASE(b);
return 1;
}
if(FUNCTOR(ARG(0,a)) == '-')
{ temp = c;
c = tnegate(temp);
sign = -1;
}
else
sign = 1;
for(i=0;i<n;i++)
{ err = cancel(ARG(i,t),c,&trash,ARGPTR(b)+i);
/* the listratgcd should cancel from each of the items in the list */
/* but possibly it can fail if rational numbers are involved, as
cancelnum will refuse e.g. to cancel 1/2 out of 1/4 getting 2 */
if(err)
return 1;
}
if(sign==1)
*next = product(c,b);
else
*next = tnegate(product(ARG(0,c),b));
strcpy(reason,"$ab+ac = a(b+c)$");
HIGHLIGHT(*next);
return 0;
}
/*_______________________________________________________________________*/
int cleardenoms(term t,term arg, term *next, char *reason)
/* multiply by lcm of all denominators of numerical coefficients of t */
/* In automode, fail if this would still leave fractions behind */
{ term r,s; /* for the rational and symbolic parts of one summand of t */
term a; /* for the numbers whose gcd has to be taken to get the
number to be factored out */
term temp,temp2,sym;
term c; /* for the constant to be factored out */
term crecip; /* reciprocal of c */
term b; /* what's left */
term trash;
int i,j,err;
unsigned short n;
if(FUNCTOR(t) != '+')
return 1;
n = ARITY(t);
a = make_term('+',n);
b = make_term('+',n);
for(i=0;i<n;i++)
{ ratpart2(ARG(i,t),&r,&s);
if(OBJECT(r) && TYPE(r) == DOUBLE)
goto fail;
if(NEGATIVE(r) && OBJECT(ARG(0,r)) && TYPE(ARG(0,r))==DOUBLE)
goto fail;
if(get_mathmode() == AUTOMODE)
{ /* fail if fractions are left behind */
if(FUNCTOR(s) == '/')
goto fail;
if(FUNCTOR(s) == '*')
{ for(j=0;j<ARITY(s);j++)
{ if(FUNCTOR(ARG(j,s)) == '/')
goto fail;
}
}
}
if(!NUMBER(r)) /* ratpart can return e.g. 3^2 */
{ value(r,&temp); /* but it only does so if the value exists */
r = temp;
}
ARGREP(a,i,r);
}
/* change all args of a to be positive */
for(i=0;i<n;i++)
{ if(NEGATIVE(ARG(i,a)))
{ temp = ARG(0,ARG(i,a));
if(HASARGS(ARG(i,a)))
RELEASE(ARG(i,a)); /* allocated by tneg in ratpart, or by value
which uses fresh space. Value might produce
minusone, which better not be RELEASED--
it can be harmlessly destroyed, but RELEASE
doesn't check HASARGS, so we do that here. */
ARGREP(a,i,temp);
}
}
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,a))=='/')
break;
}
if(i==n) /* no fractions in coefficients */
return 1; /* failure */
listratgcd2(ARGPTR(a),n,&c);
if(ONE(c))
return 1;
if(FUNCTOR(c) == '/')
crecip = make_fraction(ARG(1,c),ARG(0,c));
else
crecip = make_fraction(one,c);
for(i=0;i<n;i++)
{ ratpart2(ARG(i,t),&temp2,&sym);
mfracts(crecip,temp2,&temp);
if(FUNCTOR(temp) == '/')
err = cancel(ARG(0,temp),ARG(1,temp),&trash,&temp2);
else
err = value(temp,&temp2);
if(err > 2)
temp2 = temp;
ARGREP(b,i,product(temp2,sym));
}
*next = product(c,b);
strcpy(reason,"$ab+ac = a(b+c)$");
HIGHLIGHT(*next);
return 0;
fail:
RELEASE(a);
RELEASE(b);
return 1;
}
/*_______________________________________________________________________*/
int factorsquareofsum(term t, term arg, term *next, char *reason)
/* a^2 + 2ac + c^2 = (a+c)^2 */
{ term a,b,c,x,y,temp;
term u,v,w,middle;
int complex;
short saveit = get_nextassumption();
int err,sign;
if(FUNCTOR(t) != '+')
return 1;
if(ARITY(t) > 3)
return arity_aux(t,arg,next,reason,factorsquareofsum);
/* Trap the special case (x+y)^2 + 2(x^2-y^2) + (x-y)^2
and factor the middle term */
if(ARITY(t) == 3)
{ unsigned short path[9];
a = ARG(0,t);
b = ARG(1,t);
c = ARG(2,t);
if(FUNCTOR(a) == '^' && equals(ARG(1,a),two) && FUNCTOR(ARG(0,a)) == '+' &&
FUNCTOR(c) == '^' && equals(ARG(1,c),two) && FUNCTOR(ARG(0,c)) == '+' &&
FUNCTOR(b) == '*' && ARITY(b) == 2 && equals(ARG(0,b),two) &&
!differenceofsquares(ARG(1,b),zero,&w,reason) &&
(
(equals(ARG(0,w),ARG(0,a)) && equals(ARG(1,w),ARG(0,c))) ||
(equals(ARG(0,w),ARG(0,c)) && equals(ARG(1,w),ARG(0,a)))
)
)
{ HIGHLIGHT(w);
*next = make_term('+',3);
ARGREP(*next,0,ARG(0,t));
ARGREP(*next,1,product(two,w));
ARGREP(*next,2,ARG(2,t));
path[0] = '+';
path[1] = 2;
path[2] = '*';
path[3] = 2;
path[4] = 0;
set_pathtail(path);
SetShowStepOperation(differenceofsquares);
return 0;
}
}
if(!isquadratic(t,&a,&b,&c,&x,&y))
return 1;
complex = get_complex();
if(FUNCTOR(a)=='-' && FUNCTOR(c)!='-' && !complex)
return 1;
if(FUNCTOR(c)=='-' && FUNCTOR(a)!='-' && !complex)
return 1;
if(FUNCTOR(a)=='-' && FUNCTOR(c)=='-')
{ b = tnegate(b);
a = ARG(0,a);
c = ARG(0,c);
sign = -1;
}
else
sign = 1;
err = sqrt_aux(a,&u); /* u can be complex if complex numbers are on */
/* sqrt_aux can cause assumptions to be made */
if(err)
goto fail;
err = sqrt_aux(c,&v);
if(err)
goto fail;
temp = product3(two,u,v);
if(numerical(temp))
{ err = value(temp,&middle);
if(err > 2)
middle = temp;
}
else
polyval(temp,&middle);
if(! equals(b,middle))
goto fail;
temp = make_power(sum(product(u,x),product(v,y)),two);
*next = (sign == 1 ? temp : tnegate(temp));
HIGHLIGHT(*next);
strcpy(reason,"a^2+2ab+b^2=(a+b)^2");
release(alltoleft);
release(cancelterm);
strip_protections(next);
return 0;
fail:
set_nextassumption(saveit);
return 1;
}
/*_______________________________________________________________________*/
int factorsquareofdif(term t, term arg, term *next, char *reason)
/* a^2 - 2ac + c^2 = (a-c)^2 */
{ term a,b,c,x,y,temp;
term u,v,w,middle;
int err,sign,complex;
short saveit = get_nextassumption();
if(ARITY(t) > 3)
return arity_aux(t,arg,next,reason,factorsquareofdif);
/* Trap the special case (x+y)^2 - 2(x^2-y^2) + (x-y)^2
and factor the middle term */
if(ARITY(t) == 3 && NEGATIVE(ARG(1,t)))
{ unsigned short path[9];
a = ARG(0,t);
b = ARG(0,ARG(1,t));
c = ARG(2,t);
if(FUNCTOR(a) == '^' && equals(ARG(1,a),two) && FUNCTOR(ARG(0,a)) == '+' &&
FUNCTOR(c) == '^' && equals(ARG(1,c),two) && FUNCTOR(ARG(0,c)) == '+' &&
FUNCTOR(b) == '*' && ARITY(b) == 2 && equals(ARG(0,b),two) &&
!differenceofsquares(ARG(1,b),zero,&w,reason) &&
(
(equals(ARG(0,w),ARG(0,a)) && equals(ARG(1,w),ARG(0,c))) ||
(equals(ARG(0,w),ARG(0,c)) && equals(ARG(1,w),ARG(0,a)))
)
)
{ HIGHLIGHT(w);
*next = make_term('+',3);
ARGREP(*next,0,ARG(0,t));
ARGREP(*next,1,tnegate(product(two,w)));
ARGREP(*next,2,ARG(2,t));
path[0] = '+';
path[1] = 2;
path[2] = '-';
path[3] = 1;
path[4] = '*';
path[5] = 2;
path[6] = 0;
set_pathtail(path);
SetShowStepOperation(differenceofsquares);
return 0;
}
}
if(!isquadratic(t,&a,&b,&c,&x,&y))
return 1;
complex = get_complex();
if(FUNCTOR(a)=='-' && FUNCTOR(c)!='-' && !complex)
return 1;
if(FUNCTOR(c)=='-' && FUNCTOR(a)!='-' && !complex)
return 1;
if(FUNCTOR(a)=='-' && FUNCTOR(c)=='-')
{ b = tnegate(b);
a = ARG(0,a);
c = ARG(0,c);
sign = -1;
}
else
sign = 1;
err = sqrt_aux(a,&u);
if(err)
goto fail;
err = sqrt_aux(c,&v);
if(err)
goto fail;
temp = product3(two,u,v);
if(numerical(temp))
{ err = value(temp,&middle);
if(err > 2)
middle = temp;
}
else
polyval(temp,&middle);
if(FUNCTOR(b)=='-' && FUNCTOR(middle) == '-')
goto fail;
if(FUNCTOR(b) != '-' && FUNCTOR(middle) != '-')
goto fail;
if(FUNCTOR(b) == '-' && !equals(ARG(0,b),middle))
goto fail;
if(FUNCTOR(middle) == '-' && !equals(b,ARG(0,middle)))
goto fail;
middle = sum(product(u,x),tnegate(product(v,y)));
additive_sortargs(middle);
temp = make_power(middle,two);
*next = (sign == 1 ? temp : tnegate(temp));
HIGHLIGHT(*next);
strcpy(reason,"a^2-2ab+b^2=(a-b)^2");
release(alltoleft);
release(cancelterm);
strip_protections(next);
return 0;
fail:
set_nextassumption(saveit);
return 1;
}
/*_______________________________________________________________________*/
int differenceofsquares(term t, term arg, term *next, char *reason)
/* a^2-b^2 = (a-b)(a+b) */
/* must work regardless of order of terms */
/* also catches a^2-b^2 for even integers n, and a^2 - b^2, etc. */
/* when doing a^2^2 - b^2 in auto mode, if either this operator or powertopower
is not wellknown, it just uses powertopower in reverse to get (a^2)^2 - b^2 */
/* Must also work on x^2-4 to get (x-2)(x+2), and so on.
What about x^2-3? if ringflag & ALGINT == 0 it will fail, but if
ringflag & ALGINT, it will get (x-\sqrt 3)(x+\sqrt 3); similarly
for x^2+4, if ringflag & GAUSSINT it will get (x-2i)(x+2i);
for x^2+3, if ringflag & ALGINT && ringflag & GAUSSINT
it will get (x-i\sqrt 3)(x+i\sqrt 3) */
/* In menu mode, it should work on r^2 -4s^2 + (r+s)^2 ; but in auto mode
it works only on sums of arity 2. But, in menu mode, given
(y-1)^2 + y^2-1 - 2(y+1)^2, it should work on y^2-1, not on
(y-1)^2 - 2(y+1)^2. Also consider (y-1)^2 + 2(y^2-1) - 8(y+1)^2
in which the (y^2-1) is not a subsum. So we want differenceofsquares
to out-and-out fail on this one, so it will get applied to y^2-1.
This is enforced by arity_aux2.
*/
/* In menu mode, it works on \sqrt a - \sqrt b producing fourth roots; in
auto mode we don't want this: it's never useful and it can even
produce infinite regress. Even in auto mode it can block a desired
operation, e.g. on (9-t)/(3-\sqrt t) it will apply to the denominator
and onwards in infinite regress before ever getting to the numerator.
Therefore, we pre-associate it also to FRACTIONS, and catch the
patterns (a^2-b)/(a \pm \sqrt b) and reciprocals and (a-b^2)/(\sqrt a \pm b) and
(a-b)/(\sqrt a \pm \sqrt b). Also, we catch the case (a-b)/(a^2-b^2), which
pre_ops will otherwise refuse when a and b contain fractions. */
{ term u,v,a,b,temp,w;
int err,complex,complexflag = 0;
short saveit = get_nextassumption();
unsigned short path[11];
if(FUNCTOR(t) == '/')
return difofsquaresinfract(t,arg,next,reason);
if(FUNCTOR(t) != '+')
return 1;
if(ARITY(t) != 2)
return arity_aux2(t,arg,next,reason,differenceofsquares);
complex = get_complex();
u = ARG(0,t);
v = ARG(1,t);
if(FUNCTOR(u) != '-' && FUNCTOR(v) != '-' && !complex)
return 1;
if(FUNCTOR(u) == '-' && FUNCTOR(v)== '-' && !complex)
return 1;
if(FUNCTOR(v) == '-')
v = ARG(0,v);
else if (FUNCTOR(u) == '-')
{ temp = ARG(0,u);
u = v;
v = temp;
}
else /* looking for complex factors of u+v */
{ v = tnegate(v);
complexflag = 1;
}
/* Now t = u - v */
err = sqrt_aux(v,&b);
if(err)
goto fail;
err = sqrt_aux(u,&a);
if(err)
goto fail;
if(ZERO(b) || ZERO(a))
{ /* if this is applied e.g. to 1 - 0 then the
SETORDERED near the end is an error, since
the answer obtained there won't be a product */
if(get_mathmode() == AUTOMODE)
return 1;
u = make_term('+',2);
ARGREP(u,0,a);
temp = make_term('-',1);
ARGREP(temp,0,zero);
ARGREP(u,1,temp);
v = make_term('+',2);
copy(a,ARGPTR(v)); /* avoid DAGs */
ARGREP(v,1,zero);
*next = product(u,v);
if(complexflag)
{ SetShowStepOperation(sumofsquares);
strcpy(reason, "a^2+b^2 = (a-bi)(a+bi)");
return 0;
}
strcpy(reason,"a^2-b^2 = (a-b)(a+b)");
return 0;
}
/* When learning exponents and factoring, sqrt_aux does too much, so
we want to slow it down: */
if(
get_mathmode() == AUTOMODE &&
( (FUNCTOR(u) == '^' && !equals(ARG(1,u),two))
||(FUNCTOR(v) == '^' && !equals(ARG(1,v),two))
|| FUNCTOR(u) == '*' || FUNCTOR(v) == '*'
) &&
(status(powertopower) < WELLKNOWN ||
status(differenceofsquares) < WELLKNOWN ||
status(producttopower) < WELLKNOWN
)
)
{ PROTECT(a);
PROTECT(b);
*next = sum(make_power(a,two),tnegate(make_power(b,two)));
HIGHLIGHT(*next);
if(FUNCTOR(u) == '*' || FUNCTOR(v) == '*')
strcpy(reason,"a^2b^2 = (ab)^2");
else
strcpy(reason,"$a^(2n) = (a^n)^2$");
}
UNPROTECT(a);
UNPROTECT(b); /* in case they were protected until this could happen;
we don't want to protect them from further simplification */
if(FUNCTOR(a) == '^' && FUNCTOR(b) == '^' &&
equals(ARG(0,a),ARG(0,b)) &&
get_mathmode() == AUTOMODE
)
{ /* c^(2n) - c^(2m) = (c^n-c^m)(c^n+c^m),
but it's better to contentfactor, and indeed in an
example like 2^2u - 4^(u+1), it's better to factor the 4 first.
The following code gets these intermediate results and uses
SetShowStepOperation to make it look like other operations were used.
*/
if(equals(ARG(0,a),eulere) &&
(NEGATIVE(ARG(1,a)) || NEGATIVE(ARG(1,b)))
)
return 1; /* don't factor e^x - e^-x */
if(FUNCTOR(v) == '^' && !equals(ARG(0,v),ARG(0,a)))
{ path[0] = '+';
path[1] = 2;
path[2]= '-';
path[3] = 1;
path[4] = '^';
path[5] = 1;
path[6] = 0;
err = writenumberassquare(ARG(0,v),arg,&w,reason);
if(!err)
{ *next = sum(u,tnegate(make_power(w,ARG(1,v))));
SetShowStepOperation(writenumberassquare);
set_pathtail(path);
return 0;
}
}
if(FUNCTOR(u) == '^' && !equals(ARG(0,u),ARG(0,a)))
{ path[0] = '+';
path[1] = 1;
path[2] = '^';
path[3] = 1;
path[4] = 0;
err = writenumberassquare(ARG(0,u),arg,&w,reason);
if(!err)
{ *next = sum(w,tnegate(v));
SetShowStepOperation(writenumberassquare);
set_pathtail(path);
return 0;
}
}
err = contentfactor(sum(make_power(ARG(0,a),product(two,ARG(1,a))),
tnegate(make_power(ARG(0,b),product(two,ARG(1,b))))
), arg,next,reason);
if(!err)
{ SetShowStepOperation(contentfactor);
set_nextassumption(saveit);
return 0;
}
}
*next = product(sum(a,tnegate(b)),sum(a,b));
SETORDERED(ARG(0,*next));
SETORDERED(ARG(1,*next));
/* tell automode not to reorder these terms;
thus x^2-a^2 = (x-a)(x+a) and a^2-x^2 = (a-x)(a+x) and
BOTH answers should be left alone */
HIGHLIGHT(*next);
strcpy(reason,"a^2-b^2 = (a-b)(a+b)");
return 0;
fail:
set_nextassumption(saveit);
if(ISATOM(u) || ISATOM(v))
errbuf(0, english(1098));
/* This operation won't introduce a root of a variable */
return 1;
}
/*_______________________________________________________________________*/
int sumofsquares(term t, term arg, term *next, char *reason)
/* a^2+b^2 = (a-bi)(a+bi) */
/* very similar to differenceofsquares otherwise */
{ term u,v,a,b,temp;
int err;
short saveit = get_nextassumption();
if(FUNCTOR(t) != '+')
return 1;
if(ARITY(t) != 2)
return arity_aux2(t,arg,next,reason,sumofsquares);
u = ARG(0,t);
v = ARG(1,t);
if(FUNCTOR(u) == '-' || FUNCTOR(v)== '-')
return 1;
/* Now t = u + v */
if(!get_complex())
{ errbuf(0, english(252));
/* You have complex numbers turned off. */
return 1;
}
err = sqrt_aux(v,&b);
if(err)
goto fail;
err = sqrt_aux(u,&a);
if(err)
goto fail;
if(ZERO(b))
return 1;
/* When learning exponents and factoring, sqrt_aux does too much, so
we want to slow it down: */
if(
get_mathmode() == AUTOMODE &&
( (FUNCTOR(u) == '^' && !equals(ARG(1,u),two))
||(FUNCTOR(v) == '^' && !equals(ARG(1,v),two))
|| FUNCTOR(u) == '*' || FUNCTOR(v) == '*'
) &&
(status(powertopower) < WELLKNOWN ||
status(differenceofsquares) < WELLKNOWN ||
status(producttopower) < WELLKNOWN
)
)
{ PROTECT(a);
PROTECT(b);
*next = sum(make_power(a,two),tnegate(make_power(b,two)));
HIGHLIGHT(*next);
if(FUNCTOR(u) == '*' || FUNCTOR(v) == '*')
strcpy(reason,"a^2b^2 = (ab)^2");
else
strcpy(reason,"$a^(2n) = (a^n)^2$");
}
UNPROTECT(a);
UNPROTECT(b); /* in case they were protected until this could happen;
we don't want to protect them from further simplification */
temp = product(b,complexi);
*next = product(sum(a,tnegate(temp)),sum(a,temp));
SETORDERED(ARG(0,*next));
SETORDERED(ARG(1,*next));
/* tell automode not to reorder these terms */
HIGHLIGHT(*next);
strcpy(reason,"a^2+b^2 = (a-bi)(a+bi)");
return 0;
fail:
set_nextassumption(saveit);
return 1;
}
/*_______________________________________________________________________*/
#define BASE(x) (FUNCTOR(x)=='^' ? ARG(0,x) : x)
static int multiple_bases(term u)
/* u is a product; return 1 if collectpowers would work on it, that is
there are two factors with the same 'base' */
{ int i,j;
unsigned short n = ARITY(u);
assert(FUNCTOR(u) == '*');
for(i=0;i<n;i++)
{ for(j=i+1;j<n;j++)
{ if(equals(BASE(ARG(i,u)),BASE(ARG(j,u))))
return 1;
}
}
return 0;
}
#undef BASE
/*_______________________________________________________________________*/
int quadraticformula(term t, term arg, term *next, char *reason)
/* t must be a univariate quadratic. If the value of ringflag does not
allow complex roots, it requires a positive discriminant. It won't work
in that case with symbolic coefficients unless the discriminant can be
inferred nonnegative.
Example: x^2 -bx -c^2; the discriminant is b^2+4ac^2 which can be inferred
positive.
Example 2: (ax + 1) (x + b) = ax^2 + (ab+1)x + b = ax^2 + abx + x + b;
Discriminant is (ab+1)^2-4ab = (ab-1)^2; but I doubt whether MathXpert
can infer that this is nonnegative.
In case ringflag permits complex factors, we don't try to bring i out
of the square root; that requires another operator. */
/* When we have a quadratic equation f(x)=0 and the user chooses
"use quadratic formula" from the factoring menu, instead of getting
(x-a)(x-b)=c we want to get or(x=a,x=b) right away.
*/
/* Numerical values of the discriminant will be computed if the operator
is well-known; and of the denominator if it's only known. */
{ term d; /* the discriminant */
int err,st;
term temp,denom;
term a,b,c; /* the coefficients */
term root1,root2;
term x,power1,power2;
int eqnflag=0; /* set if input is an equation */
int currenttopic;
if(FUNCTOR(t) == '=' && ZERO(ARG(1,t)))
{ eqnflag = 1;
t = ARG(0,t);
}
if(FUNCTOR(t) != '+')
return 1;
currenttopic = get_currenttopic();
if(ARITY(t) == 2 && get_mathmode() == AUTOMODE &&
currenttopic != _quadratic_formula
)
return 1; /* don't use quadratic formula to solve x^2 = a */
t = additive_order(t);
/* put the args in order without affecting the original term,
because additive_order makes a copy. */
if(ARITY(t) > 3)
{ x = get_eigenvariable();
err = long_quadratic(t,x,&a,&b,&c);
if(err || ZERO(b))
return 1;
}
else if(ARITY(t)==3 && constant(ARG(0,t)))
{ c = ARG(0,t);
getmonomial(ARG(2,t),&a,&x,&power2);
if(!equals(power2,two)) /* as in 1-x^2 -6x */
{ getmonomial(ARG(1,t),&a,&x,&power2);
if(!equals(power2,two))
return 1;
err = cancel(ARG(2,t),x,&temp,&b);
if(err || contains(b, FUNCTOR(x))) // changed from !constant(b))
return 1;
}
else
{ err = cancel(ARG(1,t),x,&temp,&b);
if(err ||contains(b, FUNCTOR(x))) // changed from !constant(b))
return 1;
}
}
else if(ARITY(t)==3 && constant(ARG(2,t)))
{ c = ARG(2,t);
getmonomial(ARG(0,t),&a,&x,&power2);
if(!equals(power2,two))
{ getmonomial(ARG(1,t),&a,&x,&power2);
if(!equals(power2,two))
return 1;
err = cancel(ARG(0,t),x,&temp,&b);
if(err || contains(b, FUNCTOR(x))) // changed from !constant(b))
return 1;
}
else
{ err = cancel(ARG(1,t),x,&temp,&b);
if(err || contains(b, FUNCTOR(x))) // changed from !constant(b))
return 1;
}
}
else if(ARITY(t)==3 && constant(ARG(1,t)))
{ c = ARG(1,t);
getmonomial(ARG(2,t),&a,&x,&power2);
if(!equals(power2,two)) /* as in 1-x^2 -6x */
{ getmonomial(ARG(0,t),&a,&x,&power2);
if(!equals(power2,two))
return 1;
err = cancel(ARG(2,t),x,&temp,&b);
if(err || contains(b, FUNCTOR(x))) // changed from !constant(b))
return 1;
}
else
{ err = cancel(ARG(0,t),x,&temp,&b);
if(err || contains(b, FUNCTOR(x))) // changed from !constant(b))
return 1;
}
}
else if(ARITY(t)==2)
{ if(constant(ARG(0,t)))
{ getmonomial(ARG(1,t),&a,&x,&power1);
if(!equals(power1,two))
return 1;
b = zero;
c = ARG(0,t);
}
if(constant(ARG(1,t)))
{ getmonomial(ARG(0,t),&a,&x,&power1);
if(!equals(power1,two))
return 1;
b = zero;
c = ARG(1,t);
}
else
return 1; /* don't work on x^2 + ax, it's inappropriate */
}
else
return 1; /* not a univariate quadratic */
/* Now form the discriminant */
st = status(quadraticformula);
if(st > LEARNING)
d = sum(square(b),tnegate(product3(make_int(4L),a,c)));
else
d = sum(make_power(b,two),tnegate(product3(make_int(4L),a,c)));
if(st == WELLKNOWN)
{ if(numerical(d))
{ err = value(d,&temp);
if(err == 1) /* d was a number already */
err = 0;
}
else
err = polyval(d,&temp);
if (!err)
d=temp;
}
else if(st == KNOWN && numerical(d))
{ err = value(d,&temp);
if(err == 0 || err == 1)
d =temp;
}
if(!(get_ringflag() & GAUSSINT)) /* complex solutions disallowed */
{ if(obviously_nonnegative(d))
err = 0;
else if(obviously_negative(d))
{ errbuf(0,english(253)); /* discriminant is negative */
return 1;
}
else
err = infer(nonnegative(d));
if(err)
{ if(!infer(lessthan(d,zero)))
{ errbuf(0, english(253));
/* discriminant is negative */
return 1;
}
else
{ char mbuf[128];
char buffer[256];
term p;
#if 0 /* The following code causes it to fail if the sign of
discriminant can't be determined. Instead, we want to
make an assumption and continue. */
errbuf(0, english(1723));
/* The sign of the discriminant is not determined. */
return 1;
#endif
p = lpt(le(zero,d));
assume(p);
if(INEQUALITY(FUNCTOR(p)))
err = mstring(p,mbuf);
else
err = 1;
if(!err && strlen(buffer) < 20)
{ strcpy(buffer,english(1814)); /* !Assuming */
strcat(buffer,mbuf);
strcat(buffer,english(1815));
/* to ensure that the discrimant is non-negative. */
}
else
strcpy(buffer, english(1813));
/* An assumption has been made to ensure that the
discriminant is non-negative. */
commentbuf(0,buffer);
}
}
}
if(st > LEARNING)
polyval(product(two,a),&denom);
else
denom = product(two,a);
root1 = sum(tnegate(make_fraction(b,denom)), tnegate(make_fraction(sqrt1(d),denom)));
root2 = sum(tnegate(make_fraction(b,denom)), make_fraction(sqrt1(d),denom));
if(st ==WELLKNOWN)
{ surdsimp(root1,&temp);
root1 = temp;
surdsimp(root2,&temp);
copy(temp,&root2); /* ensure no DAG is created */
}
else
{ temp = root2;
copy(temp,&root2); /* ensure no DAG is created */
}
SETORDERED(root1);
SETORDERED(root2); /* don't reorder -1/2+ sqrt(5)/2 for example */
strcpy(reason, english(254)); /* quadratic formula */
if(eqnflag)
*next = or(equation(x,root1),equation(x,root2));
else
*next = product3(a,sum(x, strongnegate(root1)),sum(x,strongnegate(root2)));
HIGHLIGHT(*next);
SETORDERED(*next);
if(st == WELLKNOWN)
PROTECT(*next);
return 0;
}
/*_______________________________________________________________________*/
int writeassquare(term t, term arg, term *next, char *reason)
/* a^(2n) = (a^n)^2 */
{ term a,n; /* t = a^n */
term trash,m,u,v,num,denom;
int err;
if(INTEGERP(t))
return writenumberassquare(t,arg,next,reason);
if(RATIONALP(t))
{ num = ARG(0,t);
denom = ARG(1,t);
err = writenumberassquare(num,arg,&u,reason);
if(err)
return 1;
err = writenumberassquare(denom,arg,&v,reason);
if(err)
return 1;
*next = make_power(make_fraction(ARG(0,u),ARG(0,v)),two);
return 0;
}
if(FUNCTOR(t) != '^')
return 1;
n = ARG(1,t);
if(equals(n,two))
return 1; /* it's already a square */
a = ARG(0,t);
err = cancel(n,two,&trash,&m);
if(err)
return 1;
*next = make_power(make_power(a,m),two);
HIGHLIGHT(*next);
strcpy(reason,"$a^(2n) = (a^n)^2$");
return 0;
}
/*_______________________________________________________________________*/
int writeascube(term t, term arg, term *next, char *reason)
/* a^(3n) = (a^n)^3 */
{ term a,n; /* t = a^n */
term trash,m,num,denom,u,v;
unsigned short N,i;
int err;
if(INTEGERP(t))
return writenumberascube(t,arg,next,reason);
if(RATIONALP(t))
{ num = ARG(0,t);
denom = ARG(1,t);
err = writenumberascube(num,arg,&u,reason);
if(err)
return 1;
err = writenumberascube(denom,arg,&v,reason);
if(err)
return 1;
*next = make_power(make_fraction(ARG(0,u),ARG(0,v)),two);
return 0;
}
if(FUNCTOR(t) == '-' && !writeascube(ARG(0,t),arg,&u,reason))
{ *next = tnegate(u);
return 0;
}
if(FUNCTOR(t) == '*')
{ N = ARITY(t);
v = make_term('*',N);
for(i=0;i<N;i++)
{ if(FUNCTOR(ARG(i,t)) == '^' && equals(ARG(1,ARG(i,t)),three))
{ ARGREP(v,i,ARG(0,ARG(i,t)));
continue;
}
err = writeascube(ARG(i,t),arg,&u,reason);
if(err || FUNCTOR(u) != '^' || !equals(ARG(1,u),three))
{ RELEASE(v);
return 1;
}
ARGREP(v,i,ARG(0,u));
}
*next = make_power(v,three);
return 0;
}
if(FUNCTOR(t) != '^')
return 1;
n = ARG(1,t);
if(equals(n,three) || equals(n,two))
return 1;
a = ARG(0,t);
err = cancel(n,three,&trash,&m);
if(err)
return 1;
*next = make_power(make_power(a,m),three);
HIGHLIGHT(*next);
PROTECT(*next); /* see explanations in writenumberascube in numpower.c */
strcpy(reason,"a^(3n) = (a^n)^3");
return 0;
}
/*_______________________________________________________________________*/
int writeaspower(term t, term arg, term *next, char *reason)
/* a^(n?) = (a^n)^?. The user enters the ? term */
{ term a,n; /* t = a^n */
term trash,m;
int err;
if(INTEGERP(t))
return writenumberaspower(t,arg,next,reason);
if(FUNCTOR(t) != '^')
return 1;
n = ARG(1,t);
if(ZERO(arg) || ONE(arg))
return 1;
a = ARG(0,t);
err = cancel(n,arg,&trash,&m);
if(err)
return 1;
*next = make_power(make_power(a,m),arg);
HIGHLIGHT(*next);
strcpy(reason,"a^(mn) = (a^m)^n");
return 0;
}
/*_______________________________________________________________________*/
int prodofpowers(term t, term arg, term *next, char *reason)
/* use the law a^2b^2 = (ab)^2 */
/* must also work on something like a^2bcd^2ef^2 =(adf)^2bce */
{ int i,j,i2;
term u,v,p,n;
unsigned short k,k1,k2;
unsigned short path[32];
if(FUNCTOR(t) !='*')
return 1;
k = ARITY(t);
i=0;
strcpy(reason,"$a^nb^n = (ab)^n$"); /* just in case it works */
while(1) /* you only exit this loop by returning */
{ while(i<k && FUNCTOR(ARG(i,t))!= '^') ++i;
/* Now ARG(i,t) is a power; but is there another factor which is a
power with the same exponent? */
if(i==k)
return 1; /* no (or no more) powers */
if(i==k-1)
return 1; /* no, that was the last factor */
n = ARG(1,ARG(i,t)); /* this is the exponent in question */
j = i+1; /* start the search for the second factor here */
while(j<k && (FUNCTOR(ARG(j,t))!= '^' || !equals(ARG(1,ARG(j,t)),n))) ++j;
if(j==k) /* then this i won't do the job */
++i; /* and go back to the beginning of the while-loop */
else /* this is the choice of n to use */
{ u = make_term('*',k); /* to hold the bases with exponent n */
v = make_term('*',(unsigned short)(k-1)); /* the final product*/
k1=0;
k2=1; /* args not being combined start in position 1 */
for(i2=0;i2<k;i2++)
{ p = ARG(i2,t);
if(FUNCTOR(p)=='^' && equals(ARG(1,p),n))
{ ARGREP(u,k1,ARG(0,p));
++k1;
}
else
{ ARGREP(v,k2,p);
++k2;
}
}
assert(k1 > 1); /* because we found both i and j */
SETFUNCTOR(u,'*',k1);
if(k2==1)
{ *next = make_power(u,n);
RELEASE(v);
}
else
{ *next = v;
ARGREP(*next,0,make_power(u,n));
SETFUNCTOR(*next,'*',k2);
sortargs(*next); /* put the args in correct multiplicative order */
}
HIGHLIGHT(*next);
if(j == i+1 && !(i==0 && (unsigned short)(j+1) == k))
{ /* have ShowStep select a subrange */
path[0] = '*';
path[1] =(unsigned short)(i+1);
path[2] = SUBRANGE;
path[3] =(unsigned short)(j+1);
path[4] = 0;
if(i >= k || j >= k)
assert(0);
set_pathtail(path);
}
return 0;
}
}
}
/*_______________________________________________________________________*/
int factorinteger(term t, term arg, term *next, char *reason)
{ int i,err;
unsigned nfactors;
int mathmode;
if(!INTEGERP(t))
return 1;
if(ONE(t))
return 1;
if(PRIME(t) && ISINTEGER(t))
{ errbuf(0, english(256)); /* That integer is prime */
return 1; /* it's already been checked */
}
if(PRIME(t) && OBJECT(t) && TYPE(t) == BIGNUM)
{ err = primality_test(BIGNUMDATA(t));
if(!err)
{ errbuf(0, english(256)); /* That integer is prime */
return 1;
}
if(err == 1)
{ errbuf(0, english(1594));
/* That integer has factors, but not small ones, and it would take
a long time to search for them. */
return 1;
}
errbuf(0,english(1595));
/* That integer has no factors less than four billion. */
return 1;
}
err = factor_integer(t,&nfactors,next); /* remove 16-bit factors */
strcpy(reason, english(255)); /* factor integer */
if(err != 8)
{ SETFACTORED(*next);
if(FUNCTOR(*next) == '*')
{ for(i=0;i<ARITY(*next);i++)
SETFACTORED(ARG(i,*next));
}
mathmode = get_mathmode();
if(mathmode == AUTOMODE)
{ /* e.g. in 3^2 \cdot 5, we don't want automode to
make it 9 \cdot 5; this prevents that */
SET_ALREADYARITH(*next);
if(FUNCTOR(*next) == '*')
{ for(i=0;i<ARITY(*next);i++)
SET_ALREADYARITH(ARG(i,*next));
}
}
}
switch(err)
{ case 0: /* successful factorization, and it wasn't prime */
HIGHLIGHT(*next);
return 0;
case 2: /* it was a prime for certain */
if(OBJECT(history(get_currentline())))
errbuf(0, english(256)); /* that integer is prime */
else
errbuf(0, english(257)); /* integer (or integers) are prime */
return 1;
case 6: /* did not factor but definitely composite */
errbuf(0, english(258)); /* No factors less than than 65,536, */
errbuf(1, english(259)); /* but definitely not a prime. */
return 1;
case 7: /* did not factor, probably prime */
errbuf(0, english(258)); /* No factors less than than 65,536, */
errbuf(1, english(260)); /* and probably is prime. */
return 1;
case 4: /* factored, but one large composite factor remains */
commentbuf(0, english(261)); /* Largest factor has no factors less than 65,536, */
commentbuf(1, english(262)); /* but it definitely isn't prime */
return 0;
case 5: /* factored, but one large probably-prime factor remains */
commentbuf(0, english(261)); /* Largest factor has no factors less than 65,536, */
commentbuf(1, english(260)); /* and probably is prime */
return 0;
case 8: /* user interrupted computation */
errbuf(0,english(803)); /* Computation stopped at user's request */
return 1;
default: /* number was too big to factor */
errbuf(0, english(263)); /* No factors less than 65,536 */
}
return 1;
}
/*_______________________________________________________________________*/
int complexfactorsofinteger(term t, term arg, term *next, char *reason)
{ int err;
unsigned nfactors;
if(ONE(t))
return 1;
if(!INTEGERP(t))
{ errbuf(0, english(264)); /* That operator factors only integers. */
return 1;
}
err = factor_gaussian_integer(t,&nfactors,next); /* remove 16-bit factors */
if(get_mathmode() == AUTOMODE)
SET_ALREADYARITH(*next); /* so it won't be multiplied out again in auto mode */
switch(err)
{ case 0: /* successful factorization, and it wasn't prime */
HIGHLIGHT(*next);
strcpy(reason, english(265)); /* complex prime factors */
return 0;
case 2: /* it was a prime for certain */
if(OBJECT(history(get_currentline())))
errbuf(0, english(266)); /* that number has no complex factors */
else
errbuf(0, english(267)); /* complex integer has no complex factors */
return 1;
case 4: /* factored, but one large factor remains */
commentbuf(0, english(268)); /* Large number has no factors with */
commentbuf(1, english(269)); /* real and imag parts than 65,536. */
return 0;
case 8: /* user interrupted */
errbuf(0,english(803)); /* Computation stopped at user's request */
return 1; /* display_progress already filled error_buffer[0] */
default: /* number was too big to factor */
errbuf(0, english(270)); /* No factors with real and imag parts less than 65,536 */
}
return 1;
}
/*_______________________________________________________________________*/
int factorcomplexinteger(term t, term arg, term *next, char *reason)
{ int err;
unsigned nfactors;
term a,b;
if(!complexnumerical(t))
return 1;
err = complexparts(t,&a,&b);
if(err)
return 1;
if(ZERO(a))
{ if(get_error_buffer(0)[0] == '\0')
/* if it failed on a prime a+bi, an error message has been
left there which we don't want to erase now that it's being
tried separately on a and on bi, or on other terms to the
right of there. */
errbuf(0, english(271)); /* That operation requires nonzero real part. */
return 1;
}
if(ZERO(b))
{ if(get_error_buffer(0)[0] == '\0')
errbuf(0, english(272)); /* That operation requires nonzero imaginary part. */
return 1;
}
if(FUNCTOR(a) == '-' && !INTEGERP(ARG(0,a)))
return 1;
if(FUNCTOR(a) != '-' && !INTEGERP(a))
return 1;
if(FUNCTOR(b) == '-' && !INTEGERP(ARG(0,b)))
return 1;
if(FUNCTOR(b) != '-' && !INTEGERP(b))
return 1;
err = factor_gaussian_integer(t,&nfactors,next); /* remove 16-bit factors */
if(get_mathmode() == AUTOMODE)
SET_ALREADYARITH(*next); /* so it won't be multiplied out again in auto mode */
switch(err)
{ case 0: /* successful factorization, and it wasn't prime */
HIGHLIGHT(*next);
strcpy(reason, english(273)); /* factor n+mi */
return 0;
case 2: /* it was a prime for certain */
if(OBJECT(history(get_currentline())))
errbuf(0, english(266)); /* that number has no complex factors */
else
errbuf(0, english(267)); /* complex integer has no complex factors */
return 1;
case 4: /* factored, but one large factor remains */
commentbuf(0, english(268)); /* Large number has no factors with */
commentbuf(1, english(269)); /* real and imaginary parts lsss than 65,536. */
return 0;
case 8: /* user interrupted */
errbuf(0,english(803)); /* Computation stopped at user's request */
return 1;
default: /* number was too big to factor */
errbuf(0, english(270)); /* No factors with real and imag parts less than 65,536 */
}
return 1;
}
/*_______________________________________________________________________*/
int factorcoefficients(term t, term arg, term *next, char *reason)
/* factor all the coefficients of sum t */
{ int err,i;
unsigned nfactors;
int flag=0; /* set when the first actual factorization is done */
unsigned short n;
term r,c,u,trash;
if(FUNCTOR(t) != '+')
return 1;
n = ARITY(t);
*next = make_term('+',n);
for(i=0;i<n;i++)
{ ratpart(ARG(i,t),&r);
if(FUNCTOR(r)== '-')
r = ARG(0,r);
if(INTEGERP(r) && !ONE(r))
{ err = factor_integer(r,&nfactors,&c);
if(!err)
{ err = cancel(ARG(i,t),r,&trash,&u);
assert(err==0);
HIGHLIGHT(c);
ARGREP(*next,i,product(c,u));
SETPRIME(ARG(i,*next));
flag = 1;
}
}
if(FUNCTOR(r) == '^' && INTEGERP(ARG(1,r)) && INTEGERP(ARG(0,r)))
{ err = factor_integer(ARG(0,r),&nfactors,&c);
if(!err)
{ err =cancel(ARG(i,t),r,&trash,&u);
assert(err==0);
HIGHLIGHT(c);
ARGREP(*next,i,product(make_power(c,ARG(1,r)),u));
SETPRIME(ARG(0,ARG(i,*next)));
flag = 1;
}
}
else err = 1;
if(err)
ARGREP(*next,i,ARG(i,t));
}
if(!flag)
return 1;
strcpy(reason, english(274)); /* factor coefficients */
return 0;
}
/*_______________________________________________________________________*/
int purefactor(term t, term *ans)
/* Factor without affecting ShowStep */
{ int err;
SaveShowStepState();
err = factor(t,ans);
RestoreShowStepState();
return err;
}
/*_______________________________________________________________________*/
#define MAXFACTORS 100 /* maximum number of factors that can be returned */
int factor(term t, term *ans)
/* do the best MathXpert can do to factor t; works on products, sums,
and powers; just fails on terms it can't factor. */
/* return 0 for success. If can't factor, return *ans = t. */
/* return value 2 means more than MAXFACTORS factors were found */
/* return value -1 means polynomial is DEFINITELY irreducible */
/* return value 1 just means we couldn't factor it */
{ unsigned short n,k;
unsigned short f = FUNCTOR(t);
int i,j,err;
int savenvariables, savenextdefn, saveeigen;
short savenextassumption;
term temp,arg,localans,a,b,u;
int savemode;
actualop op,lastop=NULL;
int success=0;
char localbuf[DIMREASONBUFFER];
unsigned short path[16];
unsigned short tail[16];
void *savenode;
int savedisplay = inq_display_on();
unsigned long nbytes;
int rval = 1;
int count = 0; /* count the factoring operations used */
k = 0;
*ans = t; /* so it will be correct even if factor first
alters the args of t and then fails. */
if(ATOMIC(t))
return -1; /* irreducible */
if(f !='+' && f != '*' && f != '^')
return 1;
if(ARITY(t) > 6)
{ nbytes = mycoreleft();
if(nbytes < 24576) /* don't run out of memory */
return 1;
}
if(savedisplay)
display_off();
savenvariables = get_nvariables();
savenextdefn = get_nextdefn();
saveeigen = get_eigenindex();
savenextassumption = get_nextassumption();
path[0] = 0; /* so pathcat will work */
start: /* label for tail recursion */
f = FUNCTOR(t);
savenode = heapmax();
if(f == '-')
{ tail[0] = '-';
tail[1] = 1;
tail[2] = 0;
pathcat(path,tail);
err = factor(ARG(0,t),&temp);
if(err)
{ *ans = t;
if(err < 2 && !rval) /* rval is zero if we reached here via tail recursion */
goto out;
rval = err;
goto out;
}
save_and_reset(tnegate(temp),savenode,ans);
set_pathtail(path);
goto out;
}
if(f == '^')
{ tail[0] = '^';
tail[1] = 1;
tail[2] = 0;
pathcat(path,tail);
err = factor(ARG(0,t),&temp);
if(err)
{ *ans = t;
if(err < 2 && !rval) /* rval is zero if we reached here via tail recursion */
goto out;
rval = err;
goto out;
}
save_and_reset( make_power(temp,ARG(1,t)),savenode,ans);
set_pathtail(path);
goto out;
}
if(f=='*') /* then try to factor the args */
{ n = ARITY(t);
localans = make_term('*',MAXFACTORS);
for(i=0;i<n;i++)
{ err = factor(ARG(i,t),&temp);
if(err==2)
{ *ans = t;
rval = 2;
goto out;
}
if(!err)
success = 1;
if(FUNCTOR(temp) == '*')
{ if(k + ARITY(temp) >= MAXFACTORS)
{ *ans = t; /* refuse to factor, too many factors */
rval = 2;
goto out;
}
for(j=0;j<ARITY(temp);j++)
{ ARGREP(localans,k,ARG(j,temp));
++k;
}
}
else
{ ARGREP(localans,k,temp);
++k;
}
}
SETFUNCTOR(localans,'*',k);
if(success)
{ if(!numerical(localans))
polyval(localans,ans);
else
*ans = localans;
save_and_reset(*ans,savenode,ans);
rval = 0;
goto out;
}
else
{ *ans = t;
/* rval can be zero here, if we have recursed through goto start. */
goto out;
}
}
if(f == '+')
{ if(!contains(t,'^'))
{ /* the only thing you could do with a linear polynomial is
content_factor it. This, however, you don't want to do
if the polynomial already is of the form x-a or x+a,
e.g. we don't want to make (x-1/2) into (1/2)(2x-1).
However, what about (x-y/2)? We will say that this should
be left alone also. If any of the summands is an atom we
won't touch it.
*/
for(i=0;i<ARITY(t);i++)
{ u = ARG(i,t);
if(NEGATIVE(u))
u = ARG(0,u);
if(ISATOM(u))
{ *ans = t;
rval = -1;
goto out;
}
}
err = content_factor(t,&a,&b);
if(err)
{ rval = -1;
goto out;
}
*ans = product(a,b);
rval = 0;
goto out;
}
if(IRREDUCIBLE(t))
{ *ans = t;
rval = -1;
goto out;
}
if(CANTFACTOR(t))
{ *ans = t;
rval = 1;
goto out;
}
err = irreducible(t);
if(err == 2) /* definitely irreducible */
{ *ans = t;
rval = -1;
goto out;
}
if(err == 1) /* MathXpert definitely can't factor it */
{ *ans = t;
rval = 1;
goto out;
}
/* else we got no useful information from 'irreducible' */
SETFUNCTOR(arg,ILLEGAL,0);
n = ARITY(t);
for(i=0;i<NFACTOROPS;i++)
{ op = factorops1[i];
if(factor_arities[i] && n != factor_arities[i])
continue;
/* for example differenceofsquares can factor a sub-sum
returning a sum (a-b)(a+b) + c. We don't want that here. */
savemode = get_mathmode();
set_mathmode(AUTOMODE);
err = (*op)(t,arg,&temp,localbuf);
if(!err && FUNCTOR(temp) == '+')
/* this can happen if op == factorbygrouping */
{ err = content_factor(temp,&a,&b);
if(!err)
temp = product(a,b);
}
set_mathmode(savemode);
if(!err)
{ save_and_reset(temp,savenode,&t);
rval = 0;
if((void *) op != (void *) lastop)
{ ++count;
lastop = op;
SetShowStepOperation(lastop);
}
goto start; /* recurse */
}
}
}
if(!rval)
{ if(count == 1)
SetShowStepOperation(lastop);
rval = 0;
goto out;
}
/* On failure, restore nvariables and nextdefn to their
original values. Now that makesubstitution isn't used,
probably they are unchanged anyway, but it does no harm
to make sure.
*/
rval = 1;
out:
if(savedisplay)
display_on();
set_nvariables(savenvariables);
set_eigenvariable(saveeigen);
set_nextdefn(savenextdefn);
set_nextassumption(savenextassumption);
if(rval)
reset_heap(savenode);
return rval;
}
/*_______________________________________________________________________*/
static int factor_once(term t, term *ans, char *reason)
/* Find one factoring operator and apply it to t, returning
the result in *ans, and calling SetShowStepOperation. Put
the reason generated by that operator in 'reason'.
*/
/* return 0 for success. If can't factor, return *ans = t. */
/* return value -1 means polynomial is DEFINITELY irreducible */
/* return value 1 just means we couldn't factor it */
{ unsigned short n;
unsigned short f = FUNCTOR(t);
int i,j,err;
int savenvariables, savenextdefn, saveeigen;
short savenextassumption;
term temp,arg,a,b,u;
int savemode;
actualop op;
unsigned short path[16];
unsigned short tail[16];
void *savenode;
int savedisplay = inq_display_on();
unsigned long nbytes;
int rval = 1;
*ans = t; /* so it will be correct even if factor first
alters the args of t and then fails. */
if(ATOMIC(t))
return -1; /* irreducible */
if(f !='+' && f != '*' && f != '^')
return 1;
if(ARITY(t) > 6)
{ nbytes = mycoreleft();
if(nbytes < 24576) /* don't run out of memory */
return 1;
}
if(savedisplay)
display_off();
savenvariables = get_nvariables();
savenextdefn = get_nextdefn();
saveeigen = get_eigenindex();
savenextassumption = get_nextassumption();
path[0] = 0; /* so pathcat will work */
f = FUNCTOR(t);
savenode = heapmax();
if(f == '-')
{ tail[0] = '-';
tail[1] = 1;
tail[2] = 0;
pathcat(path,tail);
err = factor_once(ARG(0,t),&temp,reason);
if(err)
{ *ans = t;
if(err < 2 && !rval) /* rval is zero if we reached here via tail recursion */
goto out;
rval = err;
goto out;
}
save_and_reset(tnegate(temp),savenode,ans);
set_pathtail(path);
goto out;
}
if(f == '^')
{ tail[0] = '^';
tail[1] = 1;
tail[2] = 0;
pathcat(path,tail);
err = factor_once(ARG(0,t),&temp,reason);
if(err)
{ *ans = t;
if(err < 2 && !rval) /* rval is zero if we reached here via tail recursion */
goto out;
rval = err;
goto out;
}
save_and_reset( make_power(temp,ARG(1,t)),savenode,ans);
set_pathtail(path);
rval = 0;
goto out;
}
if(f=='*') /* then try to factor the args */
{ n = ARITY(t);
for(i=0;i<n;i++)
{ tail[0] = '*';
tail[1] = i+1;
tail[2] = 0;
pathcat(path,tail);
err = factor_once(ARG(i,t),&temp,reason);
tail[0] = 0;
if(!err)
{ pathcat(path,get_pathtail()); // pathtail was set by the recursive call to factor_once
set_pathtail(path);
break;
}
else
{ // reset path to what it was before pathcat
unsigned short *marker = path;
while(*marker) ++marker;
marker -= 2;
*marker = 0;
}
}
if(i==n)
{ rval = 1;
goto out;
}
u = make_term('*',n);
for(j=0;j<n;j++)
ARGREP(u,j,j==i? temp : ARG(j,t)); // corrected 8.29.04
polyval(u,ans);
rval = 0;
goto out;
}
if(f == '+')
{ if(!contains(t,'^'))
{ /* the only thing you could do with a linear polynomial is
content_factor it. This, however, you don't want to do
if the polynomial already is o the form x-a or x+a,
e.g. we don't want to make (x-1/2) into (1/2)(2x-1).
However, what about (x-y/2)? We will say that this should
be left alone also. If any of the summands is an atom we
won't touch it.
*/
for(i=0;i<ARITY(t);i++)
{ u = ARG(i,t);
if(NEGATIVE(u))
u = ARG(0,u);
if(ISATOM(u))
{ *ans = t;
rval = -1;
goto out;
}
}
}
if(IRREDUCIBLE(t))
{ *ans = t;
rval = -1;
goto out;
}
if(CANTFACTOR(t))
{ *ans = t;
rval = 1;
goto out;
}
err = irreducible(t);
if(err == 2) /* definitely irreducible */
{ *ans = t;
rval = -1;
goto out;
}
if(err == 1) /* MathXpert definitely can't factor it */
{ *ans = t;
rval = 1;
goto out;
}
/* else we got no useful information from 'irreducible' */
SETFUNCTOR(arg,ILLEGAL,0);
n = ARITY(t);
for(i=0;i<NFACTOROPS;i++)
{ op = factorops1[i];
if(factor_arities[i] && n != factor_arities[i])
continue;
/* for example differenceofsquares can factor a sub-sum
returning a sum (a-b)(a+b) + c. We don't want that here. */
savemode = get_mathmode();
set_mathmode(AUTOMODE);
err = (*op)(t,arg,&temp,reason);
if(!err && FUNCTOR(temp) == '+')
/* this can happen if op == factorbygrouping */
{ err = content_factor(temp,&a,&b);
if(!err)
temp = product(a,b);
}
set_mathmode(savemode);
if(!err)
{ save_and_reset(temp,savenode,ans);
SetShowStepOperation(op);
rval = 0;
goto out;
}
}
}
rval = 1;
out:
if(savedisplay)
display_on();
set_nvariables(savenvariables);
set_eigenvariable(saveeigen);
set_nextdefn(savenextdefn);
set_nextassumption(savenextassumption);
if(rval)
reset_heap(savenode);
return rval;
}
/*_______________________________________________________________________*/
int factorpolyundersqrt(term t, term arg, term *next, char *reason)
/* factor polynomial under \sqrt
Do not succeed unless there is a repeated factor. */
{ int err;
term u,temp,temp2;
actualop op;
char buffer[DIMREASONBUFFER];
unsigned short path[3];
if(FUNCTOR(t) != SQRT)
return 1;
u = ARG(0,t); /* the term to be factored */
if(FUNCTOR(u) != '+')
return 1;
if(!mvpoly(u))
return 1; /* reject non-polynomials immediately */
err = contentfactor(u,arg,&temp,reason);
if(!err && FUNCTOR(temp) == '*')
{ /* check if the content contains a power more than 2 */
term content = ARG(0,temp);
if(INTEGERP(content))
{ err = factorundersqrt(sqrt1(content),arg,&temp2,buffer);
if(!err)
{ path[0] = SQRT;
path[1] = 1;
path[2] = 0;
set_pathtail(path);
SetShowStepOperation(contentfactor);
*next = sqrt1(temp);
return 0;
}
}
if(FUNCTOR(content) == '^' && INTEGERP(ARG(1,content)))
{ SetShowStepOperation(contentfactor);
path[0] = SQRT;
path[1] = 1;
path[2] = 0;
set_pathtail(path);
*next = sqrt1(temp);
return 0;
}
}
if(!contains(u,'^'))
return 1; /* reject linear functions under sqrt now that contentfactor failed */
err = factorsquareofsum(u,arg,&temp,reason);
if(!err)
{ op = strchr(reason,'-') ? factorsquareofdif : factorsquareofsum;
goto out;
}
err = squarefreefactors(u,arg,&temp,reason);
if(err)
{ errbuf(0,english(1306));
errbuf(1,english(1307));
/* This operation only factors out repeated factors,
which do not occur in a root in this expression. */
return 1;
}
op = squarefreefactors;
out:
*next = make_sqrt(temp);
path[0] = SQRT;
path[1] = 1;
path[2] = 0;
SetShowStepOperation(op);
set_pathtail(path);
return 0;
}
/*_______________________________________________________________________*/
int factorpolyunderroot(term t, term arg, term *next, char *reason)
/* factor polynomial under ^2\sqrt .
Do not succeed unless there is a repeated factor. */
{ int err;
term u,temp,temp2;
actualop op;
unsigned short path[3];
char buffer[DIMREASONBUFFER];
if(FUNCTOR(t) != ROOT)
return 1;
u = ARG(1,t); /* the term to be factored */
if(FUNCTOR(u) != '+')
return 1;
if(!mvpoly(u))
return 1; /* reject non-polynomials immediately */
err = contentfactor(u,arg,&temp,reason);
if(!err && FUNCTOR(temp) == '*')
{ /* check if the content contains a power more than 2 */
term content = ARG(0,temp);
if(INTEGERP(content))
{ err = factorunderroot(make_root(ARG(0,t),content),arg,&temp2,buffer);
if(!err)
{ path[0] = ROOT;
path[1] = 2;
path[2] = 0;
set_pathtail(path);
SetShowStepOperation(contentfactor);
*next = make_root(ARG(0,t),temp);
return 0;
}
}
if(FUNCTOR(content) == '^' && ISINTEGER(ARG(1,content)) &&
ISINTEGER(ARG(0,t)) &&
INTDATA(ARG(1,content)) > INTDATA(ARG(0,t))
)
{ SetShowStepOperation(contentfactor);
path[0] = SQRT;
path[1] = 1;
path[2] = 0;
set_pathtail(path);
*next = sqrt1(temp);
return 0;
}
}
if(!contains(u,'^'))
return 1; /* reject linear functions under sqrt since contentfactor failed */
err = factorsquareofsum(u,arg,&temp,reason);
if(!err)
{ op = strchr(reason,'-') ? factorsquareofdif : factorsquareofsum;
goto out;
}
err = squarefreefactors(u,arg,&temp,reason);
if(err)
{ errbuf(0,english(1306));
errbuf(1,english(1307));
/* This operation only factors out repeated factors,
which do not occur in a root in this expression. */
return 1;
}
op = squarefreefactors;
out:
path[0] = ROOT;
path[1] = 2;
path[2] = 0;
SetShowStepOperation(op);
set_pathtail(path);
*next = make_root(ARG(0,t),temp);
return 0;
}
/*____________________________________________________________________*/
int factoroutconstant(term t, term arg, term *next, char *reason)
/* factor out a constant factor from t. Here 'constant' means:
if arg is an atom then 'constant' means not depending on arg,
else if SOLVETYPE(problemtype) or problemtype is a calculus type,
then constant means not depending on varlist[eigenvariable];
else it means 'constant' */
{ term c,u,temp,z;
int err,i,problemtype;
unsigned short n,k;
if(FUNCTOR(t) != '+')
return 1;
err = contentfactor(t,arg,&temp,reason);
if(err)
return 1;
if(FUNCTOR(arg) != ILLEGAL && !ISATOM(arg))
return 1;
problemtype = get_problemtype();
if(FUNCTOR(arg) == ILLEGAL &&
(SOLVETYPE(problemtype) || problemtype >= LIMITS)
)
arg = get_eigenvariable();
if(FUNCTOR(arg) != ILLEGAL)
{ twoparts(temp,arg,&c,&u);
if(equals(c,temp) || equals(u,temp))
return 1;
}
else
{ if(FUNCTOR(temp) != '*')
return 1;
k = 0;
n = ARITY(temp);
c = make_term('*',n);
for(i=0;i<n;i++)
{ z = ARG(i,temp);
if(constant(z))
{ ARGREP(c,k,z);
++k;
}
}
if(k==0 || k == n)
{ RELEASE(c);
return 1;
}
else
SETFUNCTOR(c,'*',k);
err = cancel(t,c,&temp,&u);
if(err)
return 1;
}
/* reason has already been filled in by contentfactor,
but we want it to match the menu text */
strcpy(reason, english(1381)); /* factor out constant */
*next = product(c,u);
HIGHLIGHT(*next);
return 0;
}
/*__________________________________________________________________________*/
int factordenominator(term t, term arg, term *next, char *reason)
/* factor a denominator, not all the way but just using one factoring operator */
{ term temp,denom;
unsigned short tail[MAXTAIL+3];
int i,err,msgflag=0,sign,flag = 0;
unsigned short n,g;
term summand;
if(FUNCTOR(t) == '+') /* factor one denom in a sum of fractions */
{ n = ARITY(t);
*next = make_term('+',n);
for(i=0;i<n;i++)
{ summand = ARG(i,t);
g = FUNCTOR(summand);
if(g == '-')
{ sign = -1;
summand = ARG(0,summand);
g = FUNCTOR(summand);
}
else
sign = 1;
if(g != '/' || flag)
{ ARGREP(*next,i,ARG(i,t));
continue;
}
/* no denominator has yet factored. Does this one? */
err = factordenominator(summand,arg,&temp,reason);
if(err)
{ ARGREP(*next,i,ARG(i,t));
if(err > 0 && msgflag < 0)
msgflag = 1; /* used to get the right error message
in case of failure, when one denom
is too hard to factor and a later one is
irreducible */
else
msgflag = err;
continue;
}
else
{ /* one denominator factored */
tail[0] = '+';
tail[1] =(unsigned short)(i+1);
if(sign == -1)
{ tail[2] = '-';
tail[3] = 1;
tail[4] = 0;
}
else
tail[2] = 0;
pathcat(tail,get_pathtail()); /* it was set already by
factordenominator to the path from the fraction to
the denom */
set_pathtail(tail);
flag = 1;
}
if(sign == 1)
ARGREP(*next,i,temp);
else
ARGREP(*next,i,tnegate(temp));
}
if(flag)
return 0;
else
{ RELEASE(*next);
if(msgflag > 0)
goto toohard;
else
goto irreducible;
}
}
if(FUNCTOR(t) != '/')
return 1;
denom = ARG(1,t);
if(ATOMIC(denom) ||
(FUNCTOR(denom) == '+' && !contains(denom,'^')) /* e.g. x-a */
)
return 1; /* without trying factor and without generating an
idiotic "denominator too hard to factor" message */
err = factor_once(denom, &temp,reason);
if(err == 1)
goto toohard;
if(err == -1)
goto irreducible;
/* success: */
*next = make_fraction(ARG(0,t),temp);
HIGHLIGHT(*next);
tail[0] = '/';
tail[1] = 2; /* denominator */
tail[2] =0;
pathcat(tail,get_pathtail()); /* factor may have already set it */
tail[MAXTAIL-1] = 0;
/* Ensure that tail is not longer than MAXTAIL, which is all the space
presumed available when set_pathtail is called. If tail were longer,
this artificial termination would screw up ShowStep, but that's better
than causing a GPF; remember MAXTAIL is at least 200 so this would
next-to-never occur. */
set_pathtail(tail);
return 0;
toohard:
errbuf(0, english(276)); /* Denominator too hard to factor */
return 1;
irreducible:
errbuf(0, english(277)); /* Denominator cannot be factored */
return 1;
}
/*_________________________________________________________________*/
int factorop(term t, term arg, term *next, char *reason)
/* factor in one step if possible */
{ term temp;
int err;
err = factor(t,&temp);
if(err)
return 1;
*next = temp;
strcpy(reason, english(278)); /* factor expression */
HIGHLIGHT(*next);
return 0;
}
/*_____________________________________________________________________*/
int arity_aux(term t, term arg, term *next, char *reason, actualop op)
/* op is factorsquareofsum or some other op meant to apply to a sum
of arity 3. t is assumed to be a sum of arity > 3; apply op to
a sub-sum of t if possible, returning 0 and instantiating
*next and *reason. Return 1 if impossible.
If t is a sum of n terms, there are O(n^3) subterms of arity 3.
And this function gets called by selectops1 whenever some user selects a sum.
Therefore it needs memory management to avoid running out of space.
*/
{ term p,u,v,w,temp,a,b,x,y,q,r;
int i,j,k,s,m,err,natoms;
term *atomlist;
void *savenode = heapmax();
unsigned short n = ARITY(t);
unsigned short path[5];
path[0] = 0; /* so no harm will be done by set_pathtail if no path is set */
assert(n>3);
for(i=0;i<n-2;i++)
{ u = ARG(i,t);
if(ZERO(u))
continue;
for(j=i+1;j<n-1;j++)
{ v = ARG(j,t);
if(ZERO(v))
continue;
for(k=j+1;k<n;k++)
{ w = ARG(k,t);
p = make_term('+',3); /* p = u+v+w */
ARGREP(p,0,u);
ARGREP(p,1,v);
ARGREP(p,2,w);
if(!contains(p,'^'))
{ /* don't bother with RELEASE(p), reset_heap will be called */
continue;
}
err = (*op)(p,arg,&temp,reason);
if(!err)
{ q = temp;
if(NEGATIVE(q))
q = ARG(0,q);
if(FUNCTOR(q) == '^' && FUNCTOR(ARG(0,q)) == '+')
additive_sortargs(ARG(0,q));
else if(FUNCTOR(q) == '*')
{ for(m=0;m<ARITY(q);m++)
{ r = ARG(m,q);
if(FUNCTOR(r) == '+')
additive_sortargs(r);
}
}
if(i > 0 || k < n-1)
/* Let ShowStep select only the three args actually
involved, if they are adjacent, or the least subrange
containing the three args. */
{ path[0] = '+';
path[1] =(unsigned short)(i+1);
path[2] = SUBRANGE;
path[3] = (unsigned short)(k+1);
path[4] = 0;
/* set_pathtail(path); Not yet, it can still fail */
}
goto success;
}
reset_heap(savenode); /* releasing p and all
memory used in executing op */
}
}
}
clear_comment_buffer();
/* individual factor operators can leave seemingly irrelevant
comments; wipe them out now. */
return 1; /* failure */
success: /* In spite of the label, failure is still possible */
if(n==4)
{ for(s=0;s<n;s++)
{ if(s!=i && s!=j && s!=k)
break;
}
*next = sum(temp,ARG(s,t));
additive_sortargs(*next);
if(get_mathmode() == AUTOMODE)
{ /* prevent it from working unless *next is a difference
of squares */
char buffer[DIMREASONBUFFER];
term temp;
return differenceofsquares(*next,zero,&temp,buffer);
}
set_pathtail(path);
return 0;
}
u = make_term('+',(unsigned short)(n-3));
m=0;
for(s=0;s<n;s++)
{ if(s!=i && s!=j && s!=k)
{ ARGREP(u,m,ARG(s,t));
++m;
}
}
if(get_mathmode() == AUTOMODE)
{ /* prevent this from working unless the expression
is going to wind up in the form (x \pm y+a)(x \pm y+b).
This means u must be of the form (a+b)x + (a+b)y + ab
*/
if(ARITY(u) != 3)
return 1;
natoms = atomsin(u,&atomlist);
if(natoms != 2)
{ free2(atomlist);
return 1;
}
x = atomlist[0];
y = atomlist[1];
free2(atomlist);
for(i=0;i<3;i++)
{ p = ARG(i,u);
err = cancel(p,x,&v,&a);
if(!err && constant(a))
break;
}
if(i==3)
return 1;
for(j=0;j<3;j++)
{ if(j==i)
continue;
p = ARG(j,u);
err = cancel(p,y,&v,&b);
if(!err && constant(b))
break;
}
if(j==3 || !equals(a,b))
return 1;
for(k=0;k<3;k++)
{ if(k!=i && k!=j)
break;
}
p = ARG(k,u);
if(!NUMBER(p))
return 1;
/* but p may be the wrong constant and this still will work;
for it to work correctly, p must factor p = qr with q+r = a.
Too bad about that. */
}
*next = sum(temp,u);
set_pathtail(path);
return 0;
}
/*_______________________________________________________________________*/
int arity_aux2(term t, term arg, term *next, char *reason, actualop op)
/* op is differenceofsquares or some other op meant to apply to a sum
of arity 2. t is assumed to be a sum of arity > 2; apply op to
a sub-sum of t if possible, returning 0 and instantiating
*next and *reason.
However, see the examples under differenceofsquares. In view of
these examples, we do NOT let it work on a sub-sum one of whose
args contains '+'.
Return 1 if impossible. */
{ term p,u,v,temp;
int i,j,s,k,err;
void *savenode = heapmax();
unsigned short n = ARITY(t);
unsigned short path[5];
for(i=0;i<n-1;i++)
{ u = ARG(i,t);
if(ZERO(u) || contains(u,'+'))
continue;
for(j=i+1;j<n;j++)
{ v = ARG(j,t);
if(ZERO(v) || contains(v,'+'))
continue;
p = sum(u,v);
err = (*op)(p,arg,&temp,reason);
if(!err)
break;
else
reset_heap(savenode);
}
if(j<n)
break;
}
if(i==n-1)
return 1;
if(n==3)
{ for(k=0;k<n;k++)
{ if(k!=i && k!=j)
break;
}
*next = sum(temp,ARG(k,t));
return 0;
}
/* Now n > 3 */
u = make_term('+',(unsigned short)(n-2));
k=0;
for(s=0;s<n;s++)
{ if(s==i || s==j)
continue;
ARGREP(u,k,ARG(s,t));
++k;
}
*next = sum(temp,u);
if(i > 0 || j < n-1)
/* Let ShowStep select only the two args actually
involved, if they are adjacent, or the least subrange
containing the three args. */
{ path[0] = '+';
path[1] = (unsigned short)(i+1);
path[2] = SUBRANGE;
path[3] = (unsigned short)(j+1);
path[4] = 0;
set_pathtail(path);
}
return 0;
}
/*________________________________________________________________*/
static int difofsquaresinfract(term t, term arg, term *next, char *reason)
/* Match patterns (a^2-b)/(a \pm \sqrt b) and reciprocals and (a-b^2)/(\sqrt a \pm b) and
(a-b)/(\sqrt a \pm \sqrt b)and factor the numerator (or denom as the case may be) */
{ int savemode,err;
term num,denom,a,b,c,d,newnum,newdenom,cancelled,temp,u,v;
unsigned short path[5];
if(!FRACTION(t))
return 1;
num = ARG(0,t);
denom = ARG(1,t);
if(FUNCTOR(num) != '+' || FUNCTOR(denom) != '+' ||
ARITY(num) != 2 || ARITY(denom) != 2
)
return 1;
if(!differenceofsquares(denom,arg,&temp,reason) && !cancel(num,temp,&u,&v))
{ *next = make_fraction(num,temp);
path[0] = '/';
path[1] = 2;
path[2] = 0;
set_pathtail(path);
return 0;
}
if(!differenceofsquares(num,arg,&temp,reason) && !cancel(temp,denom,&u,&v))
{ *next = make_fraction(temp,denom);
path[0] = '/';
path[1] = 1;
path[2] = 0;
set_pathtail(path);
return 0;
}
/* where, if anywhere, is the square root? */
a = ARG(0,num);
b = ARG(1,num);
c = ARG(0,denom);
d = ARG(1,denom);
if(NEGATIVE(a))
a = ARG(0,a);
if(NEGATIVE(b))
b = ARG(0,b);
if(NEGATIVE(c))
c = ARG(0,c);
if(NEGATIVE(d))
d = ARG(0,d);
if(contains_sqrt(c) == SQRT || contains_sqrt(d) == SQRT)
/* Then factor the numerator */
{ savemode = get_mathmode();
set_mathmode(MENUMODE); /* so differenceofsquares will do \sqrt */
err = differenceofsquares(num,arg,&newnum,reason);
set_mathmode(savemode);
if(err)
return 1;
err = cancel(newnum,denom,&cancelled,&temp);
if(err)
return 1; /* don't do it */
path[0] = '/';
path[1] = 1;
path[2] = 0;
set_pathtail(path);
*next = make_fraction(newnum,denom);
return 0;
}
if(contains_sqrt(a) == SQRT || contains_sqrt(b) == SQRT)
/* Then factor the denominator */
{ savemode = get_mathmode();
set_mathmode(MENUMODE); /* so differenceofsquares will do \sqrt */
err = differenceofsquares(denom,arg,&newdenom,reason);
set_mathmode(savemode);
if(err)
return 1;
err = cancel(num,newdenom,&cancelled,&temp);
if(err)
return 1; /* don't do it */
path[0] = '/';
path[1] = 2;
path[2] = 0;
set_pathtail(path);
*next = make_fraction(num,newdenom);
return 0;
}
return 1;
}
/*________________________________________________________________*/
int writeaspoly(term t, term arg, term *next, char *reason)
/* write t as a polynomial in arg if possible.
arg doesn't have to be a variable, it can be a compound term. */
/* In automode, this operator chooses a derivative
term as its arg if possible, or in POWERSERIES, the series variable.
*/
{ int err;
int nvariables, saveeigen;
short savenextassumption;
char buffer[128];
term x,p,temp;
int problemtype;
term *atomlist;
int i;
int savenvariables = get_nvariables();
nvariables = variablesin(t,&atomlist);
if(nvariables == 0)
{ free2(atomlist);
return 1;
}
if(FUNCTOR(arg) == ILLEGAL)
{ err = derivative_subterm(t,&arg);
if(err)
{ problemtype = get_problemtype();
if(SOLVETYPE(problemtype) && nvariables == 1)
/* don't rewrite f(x,y) as polynomial in x, e.g.
x^2 + 2xy + y^2 = x^2 + 2yx + y^2,
as it leads to loops in ssolve.
*/
{ arg = get_eigenvariable();
if(!contains(t,FUNCTOR(arg)))
{ arg = atomlist[0];
}
}
else if(problemtype == POWERSERIES) // don't consult eigenvariable as it could be the index variable instead of the series variable.
{ term *varlist = get_varlist();
arg = varlist[0]; // which will be the series variable
}
else
{ free2(atomlist);
return 1;
}
}
if(noccurs(arg,t) < 2 && FUNCTOR(t) != '*' && !FRACTION(t))
{ // we do need to use it on products, e.g. (1/2) (x^k/2^k)
free2(atomlist);
return 1; /* otherwise it will just be reordering terms */
}
}
saveeigen = get_eigenindex();
savenextassumption = get_nextassumption();
if(ISATOM(arg))
{ x = arg;
temp = t;
}
else
{ x = var0;
vaux(x); /* add it to varlist */
if(get_mathmode() == AUTOMODE)
subst(var0,arg,t,&temp);
else
psubst(var0,arg,t,&temp);
}
if(!ISATOM(arg))
{ /* We still don't want to succeed if none of the variables in arg
has been eliminated in p by the substitution of var0 for arg.
It would however be OK if only SOME of the variables were
eliminated.
*/
term *atomlist, *atomlist2;
int nt = variablesin(t,&atomlist);
int np = variablesin(temp,&atomlist2);
free2(atomlist);
free2(atomlist2);
if(np > nt+1)
assert(0);
if(contains(temp,FUNCTOR(var0)))
{ if(np == nt+1)
{ set_nvariables(savenvariables);
return 1;
}
}
else
{ set_nvariables(savenvariables);
return 1;
}
}
err = makepoly(temp,x,&p); /* p is a POLYnomial */
if(!err)
temp = poly_term(p,x);
if(err)
/* Don't just fail, try harder */
{ if(FRACTION(temp))
{ term c,s;
twoparts(temp,x,&c,&s);
temp = product(c,s);
}
else
{ err = polyform(temp,x,&p);
if(!err)
temp = poly_term(p,x);
if(err && FUNCTOR(temp) == '*' && noccurs(x,temp) == 1)
{ /* we get here for example with (1/2)(x^k/2^k) */
unsigned short n = ARITY(temp);
term u,w,cancelled;
int i;
err = 0;
for(i=0;i<n;i++)
{ if(contains(ARG(i,temp),FUNCTOR(x)))
break;
}
assert(i<n); // because noccurs(x,temp)== 1
// isolate the power of x
u = ARG(i,temp);
if(FRACTION(u) && !contains(ARG(1,u),FUNCTOR(x)))
{ u = ARG(0,u);
err = 0;
}
if(equals(u,x) || (FUNCTOR(u) == '^' && equals(ARG(0,u),x)))
err = 0;
else
err = 1;
if(!err)
{ err = cancel(temp,u,&cancelled, next);
if(!err)
{ polyval(*next,&w); // e.g., *next might be (1/2)*(1/2^k)
temp = product(w,cancelled);
}
}
}
if(err)
{ set_eigenvariable(saveeigen);
set_nvariables(savenvariables);
set_nextassumption(savenextassumption);
return 1; /* NOW give up */
}
}
}
if(ISATOM(arg))
*next = temp;
else
subst(arg,var0,temp,next);
if(equals(t, *next))
{ set_eigenvariable(saveeigen);
set_nvariables(savenvariables);
set_nextassumption(savenextassumption);
errbuf(0,english(1803)); /* It's already a polynomial in that expression */
return 1; /* no change */
}
HIGHLIGHT(*next);
SETORDERED(*next); /*just in case orderterms wants to change the order */
for(i=0;i<ARITY(*next);i++)
{ if(NEGATIVE(ARG(i,*next)) && FUNCTOR(ARG(0,ARG(i,*next))) == '*')
SETORDERED(ARG(0,ARG(i,*next)));
else if(FUNCTOR(ARG(i,*next)) == '*')
SETORDERED(ARG(i,*next));
}
strcpy(reason, english(678)); /* write as polynomial */
err = mstring(arg,buffer);
if(!err && strlen(buffer) < 19)
{ strcat(reason, english(759)); /* " in " */
strcat(reason,buffer);
}
set_eigenvariable(saveeigen);
set_nvariables(savenvariables);
set_nextassumption(savenextassumption);
SET_ALREADY(*next); // don't let "simplify" undo the result
return 0;
}
/*_____________________________________________________________*/
int numerical_poly(term t)
/* Return 1 if t is a numerical polynomial in one variable
(so factornumerically can handle it)
*/
{ term *atomlist;
int nvars = variablesin(t,&atomlist);
term x;
if(nvars != 1) /* nvars == 0 || nvars > 1 */
{ free2(atomlist);
return 0;
}
x = atomlist[0];
free2(atomlist);
return ispolyin(t,x);
}
/*____________________________________________________________*/
int factorhelper(term t, term arg, term *next, char *reason)
/* This ad-hoc operator is needed to help with some very special
problems in advanced factoring.
It takes a(x+y)^2 + bx + by + c and changes it to
a(x+y)^2 + b(x+y) + c, which the user can accomplish by
contentfactor applied to bx + by, but automode can't get
without this operator, which is used in automode only.
It only works on a sum of arity 4, i.e. c can't be a sum.
*/
{ term u,v,n,c,s,w;
int err;
unsigned short path[7];
if(FUNCTOR(t) != '+' || ARITY(t) != 4)
return 1;
u = ARG(0,t);
if(FUNCTOR(u) == '^')
s = u;
else if(FUNCTOR(u) == '*')
{ ncs(u,&n,&c,&s);
if(FUNCTOR(s) != '^')
return 1;
}
else
return 1;
if(!equals(ARG(1,s),two))
return 1;
s = ARG(0,s);
if(FUNCTOR(s) != '+')
return 1;
path[0] = '+';
path[2] = SUBRANGE;
path[4] = 0;
if(constant(ARG(3,t)))
{ v = sum(ARG(1,t),ARG(2,t));
c = ARG(3,t);
path[1] = 2;
path[3] = 3;
}
else if(constant(ARG(2,t)))
{ v = sum(ARG(1,t),ARG(3,t));
c = ARG(2,t);
/* Just switch args 2 and 3 */
*next = make_term('+',4);
ARGREP(*next,0,ARG(0,t));
ARGREP(*next,1,ARG(1,t));
ARGREP(*next,2,ARG(3,t));
ARGREP(*next,3,ARG(2,t));
path[1] = 3;
path[3] = 4;
SetShowStepOperation(additivecommute);
strcpy(reason, "$a+b = b+a$");
HIGHLIGHT(ARG(2,*next));
HIGHLIGHT(ARG(3,*next));
return 0;
}
else if(constant(ARG(1,t)))
{ v = sum(ARG(2,t),ARG(3,t));
c = ARG(1,t);
path[1] = 3;
path[3] = 4;
}
else
return 1;
err = contentfactor(v,arg,&w,reason);
if(err)
return 1;
if(NEGATIVE(w))
{ assert(FUNCTOR(ARG(0,w)) == '*');
if(!equals(ARG(1,ARG(0,w)),s))
return 1;
}
else
{ assert(FUNCTOR(w) == '*');
if(!equals(ARG(1,w),s))
return 1;
}
*next = make_term('+',3);
ARGREP(*next,0,ARG(0,t));
ARGREP(*next,1,w);
ARGREP(*next,2,c);
SetShowStepOperation(contentfactor);
set_pathtail(path);
return 0;
}
/*_______________________________________________________________________*/
int sqrt_aux(term u, term *ans)
/* *ans is returned as the square root of u as required
for differenceofsquares. If u is a number, ringflag will be consulted as
described in documentation of differenceofsquares. If u is not a number,
quotient, product, or power, *ans = make_sqrt(u) will be returned, but only
if u is constant.
If u is an even power, *ans is returned as half the power of the same base.
If u is a SQRT or ROOT, *ans is returned as a root with double the index--
but NOT in automode, as this leads to undesired results and even
infinite regress, starting e.g. on \sqrt a - \sqrt b.
Zero return value indicates success.
In auto mode, it will check the global variable 'ringflag', documented
in globals.h, and refuse to generate unwanted roots.
In auto mode, it will also refuse to work if collectpowers could be used
on u, e.g. on u = x^2x^2. Since simple factoring is called in pre_ops,
we need to prevent factoring things like x^2x^2 \pm x^4. */
{ int err,i;
unsigned short m;
term w;
aflag flag = get_arithflag();
aflag saveit = flag;
flag.intexp = flag.ratexp = flag.negexp = 1;
set_arithflag(flag);
if(ONE(u)) /* common special case, no need to go to overlaid file arith.c */
{ *ans = one;
set_arithflag(saveit);
return 0;
}
if(ZERO(u))
{ *ans = zero;
set_arithflag(saveit);
return 0;
}
if(FUNCTOR(u) == SQRT)
{ if(get_mathmode() == AUTOMODE)
return 1;
*ans = make_root(make_int(4L),ARG(0,u));
set_arithflag(saveit);
return 0;
}
if(FUNCTOR(u) == ROOT)
{ term index,temp;
if(get_mathmode() == AUTOMODE)
return 1;
temp = product(two,ARG(0,u));
err = value(temp,&index);
if(err > 2)
index = temp;
else
RELEASE(temp);
*ans = make_root(index,ARG(1,u));
set_arithflag(saveit);
return 0;
}
if(FUNCTOR(u) == '/')
{ term num,den;
err = sqrt_aux(ARG(0,u),&num);
if(err)
{ set_arithflag(saveit);
return 1;
}
err = sqrt_aux(ARG(1,u),&den);
if(err)
{ set_arithflag(saveit);
return 1;
}
if(ONE(den))
*ans = num;
else
*ans = make_fraction(num,den);
set_arithflag(saveit);
return 0;
}
if(FUNCTOR(u) == '^')
{ term a,n,trash,expa;
a = ARG(0,u); /* u = a^2 */
n = ARG(1,u); /* u = a^2 */
if(equals(n,two))
{ *ans = a;
set_arithflag(saveit);
return 0;
}
if(FRACTION(n))
{ if(equals(ARG(0,n),two))
{ *ans = make_power(a,reciprocal(ARG(1,n)));
set_arithflag(saveit);
return 0;
}
err = cancel(ARG(0,n),two,&trash,&expa);
set_arithflag(saveit);
if(err)
return 1;
*ans = make_power(a,make_fraction(expa,ARG(1,n)));
return 0;
}
err = cancel(n,two,&trash,&expa);
if(err)
{ if(!INTEGERP(a))
return 1;
/* if a is a perfect square c^2 then the answer is c^n */
err = value(make_power(a,make_fraction(one,two)),&w);
if(err ==0)
{ *ans = make_power(w,n);
set_arithflag(saveit);
return 0;
}
return 1;
}
*ans = make_power(a,expa);
set_arithflag(saveit);
return 0;
}
if(OBJECT(u) || (FUNCTOR(u) == '-' && OBJECT(ARG(0,u))))
{ err = value(make_power(u,make_fraction(one,two)),ans);
if(err==0)
{ set_arithflag(saveit);
return 0; /* success, an exact root */
}
if(get_mathmode() != AUTOMODE || (get_ringflag() & ALGINT)) /* algebraic factors desired, see globals.h */
{ if(obviously_nonnegative(u))
err = 0;
else if(obviously_negative(u))
err = 1;
else
err = infer(nonnegative(u));
if(err == 0)
{ if(constant(u))
{ *ans = make_sqrt(u);
set_arithflag(saveit);
return 0;
}
else
{ set_arithflag(saveit);
return 1;
}
}
else if(get_ringflag() & GAUSSINT) /* complex factors ok */
{ if(FUNCTOR(u)=='-')
{ term temp;
err = sqrt_aux(ARG(0,u),&temp);
set_arithflag(saveit);
if(err==0)
{ *ans = product(complexi,temp);
return 0;
}
else
return 1;
}
}
set_arithflag(saveit);
return 1; /* complex factors not desired */
}
set_arithflag(saveit);
return 1; /* algebraic factors not desired */
}
if(FUNCTOR(u) != '*')
{ if(constant(u))
{ if(obviously_nonnegative(u))
err = 0;
else
err = 1;
if(!err)
*ans = make_sqrt(u);
set_arithflag(saveit);
return err ? 1 : 0;
}
else
{ set_arithflag(saveit);
return 1;
}
}
/* now FUNCTOR(u) == '*' */
if(get_mathmode() == AUTOMODE && multiple_bases(u))
{ set_arithflag(saveit);
return 1;
}
m = ARITY(u);
*ans = make_term('*',m);
for(i=0;i<m;i++)
{ err = sqrt_aux(ARG(i,u),ARGPTR(*ans)+i);
if(err)
{ set_arithflag(saveit);
return 1;
}
}
set_arithflag(saveit);
return 0;
}
/*__________________________________________________________________________*/
int long_quadratic(term t, term x, term *a, term *b, term *c)
/* t must be a sum of arity at least 4. x is a variable. If
possible, write t in the form ax^2 + bx + c where c does not contain x.
(Then c will be a sum of at least two constant terms, e.g.
x^2 + 2x + 4 + e^2. Such equations arise when solving log equations.)
Return 0 for success. Return 1 for failure, in which case *a, *b, and *c
are garbage.
*/
{ unsigned short n;
int i,count,flag1,flag2,k,sign;
term u,coef,power;
if(FUNCTOR(t) != '+')
return 1;
if(ARITY(t) < 4)
return 1;
count = flag1 = flag2 = 0;
n = ARITY(t);
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(!contains(u,FUNCTOR(x)))
continue;
++count;
if(count > 2)
return 1;
if(NEGATIVE(u))
{ sign = -1;
u = ARG(0,u);
}
else
sign = 1;
if(!ismonomial(u,x,&coef,&power))
return 1;
if(equals(power,two))
{ if(flag2)
return 1;
flag2 = i+1;
*a = sign == -1 ? tnegate(coef) : coef;
}
if(equals(power,one))
{ if(flag1)
return 1;
flag1 = i+1;
*b = sign == -1 ? tnegate(coef) : coef;
}
}
if(count != 2)
return 1;
if(!flag2 || !flag1)
return 1;
/* Now make c, which should contain all the summands of t
except those marked by flag1 and flag2 */
*c = make_term('+',(unsigned short)(n-2));
k = 0;
for(i=0;i<n;i++)
{ if(i+1 != flag1 && i+1 != flag2)
{ ARGREP(*c,k,ARG(i,t));
++k;
}
}
if(k+2 != n)
assert(0);
return 0;
}
/*_______________________________________________________________________*/
int contentfactor(term t, term arg, term *next, char *reason)
/* factor out the naive_listgcd of the coefficients.
Does not necessarily produce *next in fresh space.
It WILL content-factor 3 + 6\sqrt 2 or 3+6i; but automode and
polyval will not call it on such expressions.
We also don't want to factor 1/6 out of 1/3 + 1/2 in
automode--it's better to use common denominators. It looks
strange to see this with the justification ab + ac = a(b+c),
so we prevent it.
If every term in the sum is negative, it will put the negative
sign on the content, producing (-3x-3y) = -3(x+y) rather than
3(-x-y).
*/
{ term a,c;
int err;
unsigned short i,n;
if(FUNCTOR(t) == '=')
{ term u,v;
unsigned short path[5];
u = ARG(0,t);
v = ARG(1,t);
if(FUNCTOR(u) == '+' && FUNCTOR(v) == '*' &&
!contentfactor(u,arg,&c,reason)
)
{ *next = equation(c,v);
path[0] = '=';
path[1] = 1;
path[2] = 0;
set_pathtail(path);
return 0;
}
if(FUNCTOR(v) == '+' && FUNCTOR(u) == '*' &&
!contentfactor(v,arg,&c,reason)
)
{ *next = equation(u,c);
path[0] = '=';
path[1] = 2;
path[2] = 0;
set_pathtail(path);
return 0;
}
}
err = content_factor(t,&c,&a);
if(err)
return 1;
if(SIGNEDRATIONAL(c))
return 1; /* don't factor 1/6 out of 1/2 + 1/3 */
n = ARITY(a);
/* is every summand a negation? */
for(i=0;i<n;i++)
{ if(!NEGATIVE(ARG(i,a)))
break;
}
if(i==n)
{ /* every summand was negative */
a = strongnegate(a);
*next = tnegate(product(c,a));
if(FUNCTOR(ARG(0,*next)) == '*') /* as it must */
sortargs(ARG(0,*next));
}
else
{ *next = product(c,a);
if(FUNCTOR(*next) == '*') /* as it must */
sortargs(*next);
}
if(FUNCTOR(c) != '+' &&
(
(FUNCTOR(*next)== '*' && FUNCTOR(ARG(0,*next)) == '+') ||
(NEGATIVE(*next) && FUNCTOR(ARG(0,ARG(0,*next))) == '+')
)
)
strcpy(reason,"$ac+bc = (a+b)c$");
else
strcpy(reason, "$ab+ac = a(b+c)$");
SETCOLOR(*next,YELLOW);
return 0;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists