Sindbad~EG File Manager
/* Some equation-solving operators
M. Beeson, for MathXpert
Original date: 12.27.90
3.13.99 last modified
3.4.00 added code at the comment 'example, sin(1/n)/n < 1/n^2'
1.19.06 corrected cancelfactor.
*/
#define ALGEBRA_DLL
#include <string.h>
#include <assert.h>
#include <math.h>
#include "globals.h"
#include "errbuf.h"
#include "graphstr.h"
#include "document.h"
#include "cflags.h"
#include "ops.h"
#include "operator.h"
#include "probtype.h"
#include "dcomplex.h"
#include "order.h"
#include "cancel.h"
#include "factor.h"
#include "simpprod.h"
#include "simpsums.h"
#include "algaux.h"
#include "advfact.h"
#include "ceval.h"
#include "complex.h" /* rootofunity */
#include "eqn.h"
#include "prover.h"
#include "fraction.h" /* naivecomdenom */
#include "solvelin.h"
#include "deval.h"
#include "trigpoly.h"
#include "symbols.h"
#include "pvalaux.h" /* content_factor, eqpoly */
#include "trig.h" /* doublesin etc. */
#include "mstring.h"
#include "fraction.h" /* denom */
#include "autosimp.h" /* SetShowStepArgs */
#include "calc.h" /* polyvalop */
#include "tdefn.h"
#include "dispfunc.h" /* atom_string */
#include "binders.h" /* get_binders */
static int noccurrences(unsigned short, term);
static void sqrts_and_nonsqrts(term t, term *a, term *b);
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int selecteqn(term eqns, term arg, term *next, char *reason)
/* Display only the selected equation. */
/* The value returned by selected_equation = get_selected_equation()
is used by one_step and exec to
restrict operators to work on only one equation in an OR or AND. Negative
value of selected_equation is used to display only one equation; positive
value means all equations are displayed, but only the selected one is
worked on. Positive values come from get_index_arg (in response to
"Work on which equation?".) Negative values come from this operator.
In the case of negative values, the selected equation will be marked
in its .info field by SET_SELECTED; the display code will look there,
and when the current line is an OR or AND, and one of the args is marked
SELECTED this way, only that arg will be displayed.
When this is called in Term Selection Mode, the arg can be the
selected equation itself, rather than the number of the equation.
*/
{ int i,selected_equation;
unsigned short n = ARITY(eqns);
if(FUNCTOR(eqns) != OR && FUNCTOR(eqns) != AND)
return 1;
*next = make_term(FUNCTOR(eqns), n);
strcpy(reason, english(216)); /* selected */
if(get_selected_equation())
/* can't nest selections if one selection splits into
several equations */
{ errbuf(0, english(217)); /* You already have an equation selected. */
errbuf(1, english(218)); /* First use \"show all equations\"; */
errbuf(2, english(219)); /* after that you can select an equation. */
return 1;
}
if(FUNCTOR(arg) == '=')
{ /* equation itself has been supplied as arg */
for(i=0;i<n;i++)
{ if(equals(ARG(i,eqns),arg))
break;
}
if(i==n)
return 1;
arg = make_int(i+1);
}
selected_equation = - (int) INTDATA(arg);
set_selected_equation(selected_equation);
selected_equation = - selected_equation; /* making it positive */
for(i=0;i<n;i++)
{ if(i==selected_equation-1)
{ copy(ARG(i,eqns),ARGPTR(*next) + i);
HIGHLIGHT(ARG(i,*next));
SET_SELECTED(ARG(i,*next)); /* mark it 'selected' */
}
else
ARGREP(*next,i,ARG(i,eqns));
}
return 0;
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int showalleqns(term eqn, term arg, term *next, char *reason)
{ unsigned short n;
int i;
if(get_selected_equation()==0)
return 1;
if(FUNCTOR(eqn) != AND && FUNCTOR(eqn) != OR)
return 1;
n = ARITY(eqn);
set_selected_equation(0);
strcpy(reason, english(220)); /* show all equations */
*next = eqn;
for(i=0;i<n;i++)
UNSELECT(ARG(i,*next));
if(FUNCTOR(eqn) == OR) /* flatten at toplevel */
{ unsigned short n = ARITY(eqn);
unsigned short cnt=0;
int i,j;
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,eqn))==OR)
cnt += ARITY(ARG(i,eqn));
else
++cnt;
}
if(cnt > n) /* flattening required */
{ *next = make_term(OR,cnt);
cnt = 0;
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,eqn))==OR)
{ for(j = 0; j < ARITY(ARG(i,eqn)); j++)
{ ARGREP(*next,cnt,ARG(j,ARG(i,eqn)));
++cnt;
}
}
else
{ ARGREP(*next,cnt,ARG(i,eqn));
++cnt;
}
}
}
}
return 0;
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int collectmultiplesolns(term t, term arg, term *next, char *reason)
/* finds two duplicate solutions if they exist and combines them to one */
/* or, find a nested multiplicity and multiply the multiplicities */
{ term u,v,new;
long ii,jj,kk;
int i,j,k;
unsigned short n;
unsigned long m1,m2;
int currenttopic;
if(FUNCTOR(t) == MULTIPLICITY && FUNCTOR(ARG(0,t)) == MULTIPLICITY)
/* nested multiplicities */
{ ii = INTDATA(ARG(1,t));
jj = INTDATA(ARG(1,ARG(0,t)));
kk = ii*jj;
*next = make_term(MULTIPLICITY,2);
ARGREP(*next,0,ARG(0,ARG(0,t)));
ARGREP(*next,1,make_int(kk));
strcpy(reason, english(221)); /* combine multiplicities */
HIGHLIGHT(ARG(1,*next));
return 0;
}
if(FUNCTOR(t) != OR)
return 1;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,t))==MULTIPLICITY)
{ m1 = INTDATA(ARG(1,ARG(i,t)));
u = ARG(0,ARG(i,t));
}
else
{ m1 = 1;
u = ARG(i,t);
}
for(j=i+1;j<n;j++)
{ if(FUNCTOR(ARG(j,t))==MULTIPLICITY)
{ m2 = INTDATA(ARG(1,ARG(j,t)));
v = ARG(0,ARG(j,t));
}
else
{ m2 = 1;
v = ARG(j,t);
}
if(equals(u,v)) /* found one ! */
{ currenttopic = get_currenttopic();
if(get_problemtype() == MINMAX ||
/* In minmax problems we don't keep track of multiplicities */
currenttopic == _cubic_one_root ||
currenttopic == _complex_cubics
/* In cubic equations, "multiplicity 2" is
an artifact of the Viete solution. The root
is not really multiple. */
)
new = u;
else
{ new = make_term(MULTIPLICITY,2);
ARGREP(new,0,u);
ARGREP(new,1,make_int(m1+m2));
}
if(n==2)
*next = new;
else
{ *next = make_term(OR,(unsigned short)(n-1));
for(k=0;k<i;k++)
ARGREP(*next,k,ARG(k,t));
ARGREP(*next,i,new);
for(k=i+1; k<j;k++)
ARGREP(*next,k,ARG(k,t));
for(k=j+1;k<n;k++)
ARGREP(*next,k-1,ARG(k,t));
}
strcpy(reason, english(222)); /* combine solutions */
return 0;
}
}
}
return 1;
}
/*__________________________________________________________________*/
void fsubst(term new,term old, term t, term *ans)
/* substitute new for old in t, but don't substitute for the
binding locus of a variable in an indefinite integral or derivative */
{ unsigned short f = FUNCTOR(t);
unsigned short n = ARITY(t);
int i;
if(ATOMIC(t))
{ subst(new,old,t,ans);
return;
}
*ans = make_term(f,n);
if((f==INTEGRAL || f==DIFF) && n==2)
{ subst(new,old,ARG(0,t),ARGPTR(*ans));
ARGREP(*ans,1,ARG(1,t));
return;
}
if(f==DIFF && n==3)
{ subst(new,old,ARG(0,t),ARGPTR(*ans));
subst(new,old,ARG(1,t),ARGPTR(*ans)+1);
ARGREP(*ans,2,ARG(1,t));
return;
}
for(i=0;i<n;i++)
fsubst(new,old,ARG(i,t),ARGPTR(*ans)+i);
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int evalatpoint(term eqn, term arg, term *next, char *reason)
/* Not called in auto mode */
/* Evaluate equation at a point */
{ term left,right,q,temp;
double ans;
int i,err,err2;
char buffer[81];
term *atomlist;
int natoms;
unsigned short f = FUNCTOR(eqn);
int nvariables = get_nvariables();
int problemtype = get_problemtype();
if(problemtype == IMPLICIT_DIFF ||
problemtype == MINMAX ||
problemtype == RELATED_RATES
)
return 1;
atomlist = (term *) callocate(nvariables, sizeof(term));
if(atomlist==NULL)
{ nospace();
return 1;
}
if(f == AND || f == OR)
return 1; /* fail immediately; never call deval on such a thing */
if(iscomplex(eqn) || iscomplex(arg))
return 1; /* does not do complex arithmetic */
natoms = get_ind_set(eqn,atomlist);
/* getarg has supplied a list of exactly natoms numbers which should be
put in for these atoms in order. */
if(natoms == 0)
{ /* for example if the user chooses this after all solutions
have been rejected by checkroot */
free2(atomlist);
return 1;
}
/* if DIFF occurs at all it's only allowed as the main functor on the
left of an equation: */
if( (f != '=' && contains(eqn,DIFF))
|| (f == '=' && FUNCTOR(ARG(0,eqn)) == DIFF &&
( contains(ARG(0,ARG(0,eqn)),DIFF) || contains(ARG(1,eqn),DIFF))
)
|| (f == '=' && contains(eqn,DIFF) && FUNCTOR(ARG(0,eqn)) != DIFF)
)
{ errbuf(0, english(223)); /* You must first evaluate the derivative. */
return 1;
}
if(contains2(eqn,INTEGRAL,2)) /* integrals aren't allowed at all */
{ errbuf(0, english(224)); /* You must first evaluate the integral. */
return 1;
}
if(contains(eqn,LIMIT)) /* limits aren't allowed at all */
{ errbuf(0, english(225));
/* You probably want \'experiment numerically\' */
errbuf(1, english(226));
/* on the LIMITS menu. This operation */
errbuf(2, english(227));
/* doesn't work on limits. */
return 1;
}
if(contains2(eqn,INTEGRAL,4))
{ errbuf(0, english(228));
/* Definite integrals can be evaluated */
errbuf(1, english(229));
/* numerically, but not by this operation. */
errbuf(2,english(230));
/* Look on the DEFINITE INTEGRALS menu. */
return 1;
}
if(natoms == 1)
{ assert(seminumerical(arg)); /* it could be � or even �^2 */
fsubst(arg,atomlist[0],eqn,&q);
}
else
{ assert(FUNCTOR(arg)==AND && ARITY(arg) == natoms);
q = eqn;
for(i=0;i<natoms;i++)
{ fsubst(ARG(i,arg),atomlist[i],q,&temp);
q = temp;
}
}
if(f == '=')
{ left = ARG(0,q);
right = ARG(1,q);
if(ZERO(right))
{ err = deval(left,&ans);
if(err)
goto fail;
*next = make_double(ans);
}
else if (ZERO(left))
{ err = deval(right,&ans);
if(err)
goto fail;
*next = make_double(ans);
}
else
{ double p,q;
err = deval(left,&p);
err2 = deval(right,&q);
if(err && err2)
{ if(err <= 2)
err = err2; /* to get a useful message */
goto fail;
}
*next = equation(err ? left : make_double(p),err2 ? right : make_double(q));
if(err)
commentbuf(0, dem(err));
if(err2)
commentbuf(0, dem(err2));
}
}
else if(INEQUALITY(f))
return 1; /* can't use this on inequalities */
else
{ err = deval(q,&ans);
if(err)
goto fail;
*next = make_double(ans);
}
if(natoms<=2)
{ strcpy(reason, atom_string(atomlist[0]));
strcat(reason,"=");
mstring((natoms==1 ? arg : ARG(0,arg)),buffer);
strcat(reason,buffer);
}
if(natoms==2)
{ strcat(reason,",");
strcat(reason,atom_string(atomlist[1]));
strcat(reason,"=");
mstring(ARG(1,arg),buffer);
strcat(reason,buffer);
}
else if(natoms > 2)
/* if (natoms==1) we get here, but reason is already complete */
strcpy(reason, english(231)); /* evaluate at point */
HIGHLIGHT(*next);
free2(atomlist);
return 0;
fail:
free2(atomlist);
errbuf(0, dem(err));
return 1;
}
/*__________________________________________________________________*/
static void set_parameters(term t, term values, char *reason)
/* Set the value pointers of the parameters in t
(that is, all variables other than the eigenvariable)
as specified in values */
{ int i,natoms,err;
double z;
term temp;
char localbuf[128];
int nvariables = get_nvariables();
term *atomlist;
term x = get_eigenvariable();
atomlist = (term *) callocate(nvariables, sizeof(term));
natoms = get_ind_set(t,atomlist);
/* natoms and atomlist include the eigenvariable */
if(natoms == 0)
return;
if(natoms==1 && equals(x,atomlist[0]))
return;
if(natoms == 1)
{ assert(FUNCTOR(values) != AND);
deval(values,&z);
SETVALUE(atomlist[0],z);
temp = equation(atomlist[1],values);
mstring(temp,reason);
RELEASE(temp);
return;
}
/* Swap the eigenvariable with atomlist[0] */
if(!equals(x,atomlist[0]))
{ for(i=0;i<natoms;i++)
{ if(equals(atomlist[i],x))
{ temp = atomlist[0];
atomlist[0] = atomlist[i];
atomlist[i] = temp;
break;
}
}
}
if(natoms == 2 && contains(t,FUNCTOR(x)))
/* then there should just be one parameter */
{ assert(FUNCTOR(values) != AND);
assert(numerical(values));
deval(values,&z);
SETVALUE(atomlist[1],z);
free2(atomlist);
temp = equation(atomlist[1],values);
mstring(temp,reason);
RELEASE(temp);
return;
}
if(FUNCTOR(values) != AND)
assert(0);
if(ARITY(values) != natoms-1)
assert(0);
/* Now there are several parameters */
for(i=1;i<natoms;i++)
{ deval(ARG(i,values),&z);
SETVALUE(atomlist[i],z);
}
/* Now construct a reason string like a=1, b=2 */
*reason = '\0';
for(i=1;i<natoms;i++)
{ temp = equation(atomlist[i],ARG(i,values));
err = mstring(temp,localbuf);
RELEASE(temp);
if(err || strlen(localbuf) + strlen(reason) > DIMREASONBUFFER)
{ /* detailed reason string is VERY long, there must be
MANY parameters with long names */
strcpy(reason,english(232)); /* solve numerically */
break; /* give up making any other reason string */
}
if(i>1)
strcat(reason,", ");
strcat(reason,localbuf);
}
free2(atomlist);
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int solvenumerically(term eqn, term arg, term *next, char *reason)
/* If there are no parameters in the equation,
arg is and(leftend,rightend) where leftend and rightend are terms
that deval can get a double from.
If there ARE parameters, arg has the form AND(p,q), where
q is as above, and p is a number or AND of numbers giving the
desired values of the parameters. */
{ term left,right,f;
term x,values;
int err;
int parameterflag = 0;
double leftend,rightend,ans,zz;
int problemtype;
if(FUNCTOR(eqn) != '=')
return 1;
problemtype = get_problemtype();
if(problemtype == IMPLICIT_DIFF ||
problemtype == MINMAX ||
problemtype == RELATED_RATES
)
return 1;
assert(FUNCTOR(arg) == AND);
if(FUNCTOR(ARG(1,arg)) == AND)
{ values = ARG(0,arg);
arg = ARG(1,arg);
set_parameters(eqn,values,reason);
parameterflag = FUNCTOR(values)==AND ? ARITY(values) : 1;
}
left = ARG(0,eqn);
right = ARG(1,eqn);
x = get_eigenvariable();
deval(ARG(0,arg),&leftend); /* checkarg already did this and checked it worked */
deval(ARG(1,arg),&rightend);
if(ZERO(right))
f = left;
else if(ZERO(left))
f = right;
else
f = sum(left,tnegate(right));
/* Now check whether f is defined at the endpoints */
SETVALUE(x,leftend);
err = deval(f,&zz);
if(err)
{ errbuf(0, english(1415));
/* Equation is not defined at left endpoint. */
return 1;
}
SETVALUE(x,rightend);
err = deval(f,&zz);
if(err)
{ errbuf(0, english(1416));
/* Equation is not defined at right endpoint. */
return 1;
}
err = solve(f,x,leftend,rightend,&ans); /* Brent's method, see solve.c */
if(!err)
{ *next = equation(x,make_double(ans));
HIGHLIGHT(*next);
if(!parameterflag)
strcpy(reason, english(232));
/* solve numerically */
return 0;
}
if(err == 1)
{ errbuf(0, english(233)); /* root not bracketed */
return 1;
}
if(err == 2)
{ errbuf(0, english(234));
/* Apparent failure of numerical method */
errbuf(1, english(235));
/* to converge, even after many iterations. */
errbuf(2, english(1417));
/* Perhaps your function is not continuous on the interval. */
return 1;
}
if(err == 4) /* failure of deval */
{ errbuf(0, english(1418));
errbuf(1, english(1419));
errbuf(2, english(1420));
/* Function must be defined and continuous on the interval.
Even if it is, if extremely large or small numbers arise
in the calculations, numerical solution can fail. */
return 1;
}
return 1; /* can't get here */
}
/*__________________________________________________________________*/
static int completesquare_aux( term left, term *x, term *y, term *ans, term *addthis)
/* return zero if left is a quadratic in *x and *y, and you add 'addthis' to it
to complete the square, producing *ans. All pointer variables are
outputs. */
{ term a,b,c,newconst,oldconst,ysq,temp;
if(FUNCTOR(left) != '+')
return 1; /* reject it fast */
if(ARITY(left)==2) /* ax^2 + bx maybe */
{ temp = sum(left,one);
if(!isquadratic(temp,&a,&b,&c,x,y))
return 1;
c = sum(c,minusone);
}
else if(!isquadratic(left,&a,&b,&c,x,y))
return 1;
/* Now we're going to do it; calculate the desired constant term */
polyval( make_fraction(make_power(b,two),product(four,a)), &temp);
if(ONE(*y))
{ newconst = temp;
oldconst = c;
}
else
{ ysq = make_power(*y,two);
newconst = product(temp,ysq);
oldconst = product(c,ysq);
}
polyval(sum(newconst,tnegate(oldconst)),addthis);
temp = sum(left,*addthis);
if(!collect(temp,ans))
*ans = temp;
if(FUNCTOR(*ans) == '+')
SET_FACTORME(*ans); /* beg automode to factor it. */
return 0;
}
/*__________________________________________________________________*/
static int completethesquare2(term eqn, term arg, term *next, char *reason)
/* ax^2 + bx + c = d => ax^2 + bx + c + p = d + p
where the left side becomes a perfect square.
Thus b = 2a�(c+p) so p = (b/2a)^2-c */
{ term left,right,newleft,newright;
term x,y,addthis,temp;
int err,swapflag;
unsigned short f = FUNCTOR(eqn);
if(!INEQUALITY(f))
return 1;
if(FUNCTOR(ARG(0,eqn)) == '+')
{ left = ARG(0,eqn);
right = ARG(1,eqn);
swapflag = 0;
}
else if(FUNCTOR(ARG(1,eqn)) == '+')
{ left = ARG(1,eqn);
right = ARG(0,eqn);
swapflag = 1;
}
else
return 1;
err = completesquare_aux(left,&x,&y,&newleft,&addthis);
if(err)
{ errbuf(0, english(236));
/* Left-hand side of equation must be quadratic. */
return 1;
}
if( (ISATOM(x) && contains(right,FUNCTOR(x)))
||(ISATOM(y) && contains(right,FUNCTOR(y)))
)
{ errbuf(0, english(237));
/* Right-hand side of equation must be constant. */
return 1;
}
temp = sum(right,addthis);
if(!collect(temp,&newright))
newright = temp;
*next = make_term(f,2);
ARGREP(*next,0, swapflag ? newright : newleft);
ARGREP(*next,1, swapflag ? newleft : newright);
HIGHLIGHT(*next);
strcpy(reason, english(238)); /* complete the square */
inhibit(alltoleft); /* released by factorsquareofdif, factorsquareofsum */
return 0;
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int completethesquare(term eqn, term arg, term *next, char *reason)
/* ax^2 + bx + c = d => ax^2 + bx + c + p = d + p
where the left side becomes a perfect square.
Thus b = 2a�(c+p) so p = (b/2a)^2-c */
{ term left,right,newleft,newright;
term newconst,oldconst,ysq;
term a,b,c,u,v;
term x,y,addthis,temp;
term *atomlist;
int nvars;
unsigned short m;
int err,swapflag;
unsigned short f = FUNCTOR(eqn);
if(!INEQUALITY(f))
return 1;
if(status(completethesquare) == WELLKNOWN)
return completethesquare2(eqn,arg,next,reason);
/* does it all in one step. Otherwise the code below shows more steps */
if(FUNCTOR(ARG(0,eqn)) == '+' && contains(ARG(0,eqn),'^'))
{ left = ARG(0,eqn);
right = ARG(1,eqn);
swapflag = 0;
}
else if(FUNCTOR(ARG(1,eqn)) == '+' && contains(ARG(1,eqn),'^'))
{ left = ARG(1,eqn);
right = ARG(0,eqn);
swapflag = 1;
}
else
{ errbuf(0, english(236));
/* Left-hand side of equation must be quadratic. */
return 1;
}
if(ARITY(left) > 2)
{ if(!isquadratic(left,&a,&b,&c,&x,&y))
{ errbuf(0, english(236));
/* Left-hand side of equation must be quadratic. */
return 1;
}
}
else /* ARITY(left) == 2 */
{ nvars = variablesin(left,&atomlist);
if(nvars > 0 && (seminumerical(ARG(0,left)) || seminumerical(ARG(1,left))))
{ errbuf(0, english(2223)); /* Completing the square requires a nonconstant linear term */
return 1;
}
if(nvars <= 1)
{ u = sum(left,one);
if(!isquadratic(u,&a,&b,&c,&x,&y))
{ RELEASE(u);
errbuf(0, english(236));
/* Left-hand side of equation must be quadratic. */
return 1;
}
if(nvars == 1)
c = zero;
else
polyval(sum(c,minusone),&c);
}
else
{ u = sum(left,square(atomlist[1]));
if(!isquadratic(u,&a,&b,&c,&x,&y))
{ RELEASE(u);
errbuf(0, english(236));
/* Left-hand side of equation must be quadratic. */
return 1;
}
c = zero;
}
}
if(!ONE(a) && get_mathmode() == AUTOMODE)
{ if(f == '=')
err = diveqn(eqn,a,next,reason);
else
err = divineq(eqn,a,next,reason);
if(err)
return 1;
SetShowStepArg(a);
SetShowStepOperation(f == '=' ? diveqn : divineq);
return 0;
}
if(ONE(a))
{ temp = make_power(make_fraction(b,two),two); /* (5/2)^2 in example x^2 + 5x - 1 */
PROTECT(temp);
}
else
temp = make_fraction(make_power(b,two),product(four,a));
if(ONE(y))
{ newconst = temp;
oldconst = c;
}
else
{ ysq = make_power(y,two);
newconst = product(temp,ysq);
oldconst = product(c,ysq);
}
addthis = sum(newconst,tnegate(oldconst));
temp = sum(left,addthis);
newleft = make_term('+',ARITY(temp));
additivecancel_aux(ARGPTR(temp),ARITY(temp),ARGPTR(newleft),&m, &v);
if(m < ARITY(temp))
SETFUNCTOR(newleft,'+',m);
else
{ RELEASE(newleft);
newleft = temp;
}
if(FUNCTOR(newleft) == '+')
SET_FACTORME(newleft); /* beg automode to factor it. */
if( (ISATOM(x) && contains(right,FUNCTOR(x)))
||(ISATOM(y) && contains(right,FUNCTOR(y)))
)
{ errbuf(0, english(237));
/* Right-hand side of equation must be constant. */
return 1;
}
copy(addthis,&v); /* don't create a DAG by using addthis twice */
strip_protections(&v);
temp = sum(right,v);
if(status(completethesquare) < WELLKNOWN ||
!collect(temp,&newright)
)
newright = temp; /* leave it as (5/2)^2 + 1 rather than make it 29/4 */
*next = make_term(f,2);
ARGREP(*next,0, swapflag ? newright : newleft);
ARGREP(*next,1, swapflag ? newleft : newright);
HIGHLIGHT(*next);
strcpy(reason, english(238)); /* complete the square */
inhibit(alltoleft); /* released by factorsquareofdif, factorsquareofsum */
inhibit(cancelterm);
return 0;
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int alltoleft(term eqn, term arg, term *next, char *reason)
/* put equation in the form u=0 */
/* In auto mode, do it only if the left side is a polynomial, and NOT
a perfect square, or is a trig
polynomial with two or more terms and at least two occurrences of x */
{ term temp,u;
int err,st;
unsigned short f = FUNCTOR(eqn);
char buffer[128];
term left,right;
if(!INEQUALITY(f))
return 1;
left = ARG(0,eqn);
right = ARG(1,eqn);
if(ZERO(right))
return 1;
temp = make_term(f,2);
st = status(transfer1);
u = st < KNOWN ? tnegate(right) : strongnegate(right);
ARGREP(temp,0,sum(left,u));
ARGREP(temp,1,zero);
if(status(transfer) < KNOWN || status(collectall) < KNOWN )
*next =temp;
else
{ err = collectall(temp,arg,next,reason);
if(err)
*next = temp;
}
if(NEGATIVE(right))
{ SetShowStepArg(ARG(0,right));
SetShowStepOperation(f == '=' ? addeqn : (f == '<' || f == '>') ? addeqn1 : addeqn2);
err = mstring(ARG(0,right),buffer);
if(err || strlen(buffer) > MAXREASONSTRING-4)
strcpy(reason, english(189)); /* add to both sides */
else
{ strcpy(reason, english(190)); /* add */
strcat(reason,buffer);
}
}
else
{ SetShowStepArg(right);
SetShowStepOperation(f == '=' ? subeqn: (f == '<' || f == '>') ? subeqn1 : subeqn2);
err = mstring(right,buffer);
if(err || strlen(buffer) > MAXREASONSTRING-9)
strcpy(reason, english(239)); /* subtract right side */
else
{ strcpy(reason, english(192)); /* subtract */
strcat(reason,buffer);
}
}
HIGHLIGHT(*next);
return 0;
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int collected(term t)
/* return number of occurrences of varlist[eigenvariable] in t,
or if doing implicit differentiation problems, the number of
occurrences of DIFF */
{ if(get_problemtype()==IMPLICIT_DIFF)
return noccurrences(DIFF,t);
else
return noccurrences(FUNCTOR(get_eigenvariable()),t);
}
/*__________________________________________________________________*/
static int noccurrences(unsigned short f, term t)
/* return the number of occurrences of functor f in term t */
{ int ans;
unsigned short n;
int i;
if(ISATOM(t))
return (FUNCTOR(t) == f ? 1 : 0);
if(OBJECT(t))
return 0;
ans = 0;
if(FUNCTOR(t)==f)
++ans;
n = ARITY(t);
for(i=0;i<n;i++)
{ ans += noccurrences(f,ARG(i,t));
}
return ans;
}
/*_____________________________________________________________________*/
static int contains_double_factor(term t)
/* return 1 if t is an equation, product, fraction, or negation of product or fraction
with a double as a factor, or a double itself, and there is no other numerical
factor, return 1. Return 0 otherwise.
*/
{ unsigned short f,n;
int i,count,doublecount;
term u;
if(OBJECT(t) && TYPE(t) == DOUBLE)
return 1;
if(ATOMIC(t))
return 0;
if(NEGATIVE(t) || FRACTION(t))
t = ARG(0,t);
f = FUNCTOR(t);
if(f == '=')
return contains_double_factor(ARG(0,t)) || contains_double_factor(ARG(1,t));
if(f != '*')
return 0;
n = ARITY(t);
count = doublecount = 0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(OBJECT(u))
++count;
if(OBJECT(u) && TYPE(u) == DOUBLE)
++doublecount;
}
if(doublecount == 1 && count == 1)
return 1;
return 0;
}
/*_____________________________________________________________________*/
MEXPORT_ALGEBRA int cancelfactor(term eqn, term arg, term *next, char *reason)
/* cancel the naive_gcd, call it c, of the two sides. If c is constant,
just check it's nonzero. Otherwise add c=0 as a new equation, if we're
solving equations. But, if we're verifying identities, we may simply
assume c=0 "without loss of generality". Such a 'wlog' assumption arises
when logically we have an argument by cases, and one of them is trivial so
we can 'wlog' assume the negation of that case. We then discharge that
assumption when exiting from that case, which happens at the end of the
calculation. MathXpert can't handle this much logic, so it just assumes
that c != 0, and it will never be discharged but still be there at the
end.
Actually by calling cancel instead of naive_gcd, we get more generality,
e.g. we can cancel 2 from 2x = 2a + 4 .
In automode, don't use this operator if the cancelled equation is
constant. For example on 4x-x = 3x, we don't want to preempt
trueeqn, obtaining or(4-1=3,x=x).
*/
{ term c,left,right,newleft,newright,ans;
int err,signflag=0,problemtype;
unsigned short f,g;
if(FUNCTOR(eqn) != '=')
return 1;
left = ARG(0,eqn);
right = ARG(1,eqn);
f = FUNCTOR(left);
g = FUNCTOR(right);
if(f == '-')
{ f = FUNCTOR(ARG(0,left));
signflag = signflag ? 0 : 1;
left = ARG(0,left);
}
if(g == '-')
{ g = FUNCTOR(ARG(0,right));
signflag = signflag ? 0 : 1;
right = ARG(0,right);
}
if(!ATOMIC(left) && f != '*' && f != '+' && f != '^')
return 1;
if(!ATOMIC(right) && g != '*' && g != '+' && g != '^')
return 1;
/* if for example either side is a fraction we should
use muleqn first. Cancel produces weird results on
fractions. */
err = cancel(left,right,&c,&ans);
if(err)
return 1;
if(OBJECT(c) && contains_double_factor(ans))
return 1; /* divide both sides looks better */
if(get_mathmode() == AUTOMODE && RATIONALP(c))
return 1; /* multiply or divide both sides instead;
example, (1/4) x = u/2 + v/4 => x = 2u + v cancelling 1/4,
it's better to multiply both sides by 4 */
if(NEGATIVE(ans))
{ ans = ARG(0,ans);
c = tnegate(c);
signflag = signflag ? 0 : 1;
}
if(FUNCTOR(ans) == '/')
{ newleft = ARG(0,ans);
newright = ARG(1,ans);
if(signflag) /* put the negation on the right to save a 'change signs' step */
{ if(NEGATIVE(newleft))
newleft = ARG(0,newleft);
else
newright = tnegate(newright);
}
}
else if(signflag)
{ newleft = ans;
newright = minusone; /* put the negation on the right */
}
else
{ newleft = ans;
newright = one;
}
strcpy(reason, english(240)); /* cancel common factor */
problemtype = get_problemtype();
if((SOLVETYPE(problemtype) && econstant(c)) || constant(c))
{ if(obviously_nonzero(c))
err = 0;
else
err = check(nonzero(c));
/* 1 means refutation, 2 means failure to infer or refute and refusal to assume */
if(err == 2)
return 1;
if(err==1) /* 1 means refutation, 2 means failure to infer or refute and refusal to assume */
{ strcpy(reason, english(241)); /* common factor is zero */
*next = equation(zero,zero);
HIGHLIGHT(*next);
return 0;
}
if(err != 0)
assert(0);
*next = equation(newleft,newright);
HIGHLIGHT(*next);
return 0;
}
/* Now, if the common factor wasn't a constant */
if(get_mathmode() == AUTOMODE && constant(newleft) && constant(newright))
return 1; /* don't work on 4x-x = 3x to get or(4-1=3,x=0) */
if(!infer(nonzero(c)))
{ *next = equation(newleft,newright);
HIGHLIGHT(*next);
return 0;
}
if(!infer(equation(c,zero)))
{ strcpy(reason, english(241)); /* common factor is zero */
*next = equation(zero,zero);
HIGHLIGHT(*next);
return 0;
}
if(problemtype == TRIG_IDENTITY)
{ assume(lpt(nonzero(c)));
*next = equation(newleft,newright);
HIGHLIGHT(*next);
return 0;
}
*next = or(equation(newleft,newright),equation(c,zero));
strcpy(reason, english(2479)); /* ac = bc iff a=b or c=0 */
HIGHLIGHT(*next);
return 0;
}
/*________________________________________________________________*/
MEXPORT_ALGEBRA int abseqn(term eqn, term arg, term *next, char *reason)
/* |u| = c iff or(u=c,u=-c), provided c >= 0 */
{ term temp,left, right;
int swapflag = 0;
int err;
if(FUNCTOR(eqn) != '=')
return 1;
left = ARG(0,eqn);
right = ARG(1,eqn);
if(FUNCTOR(left) == ABS && FUNCTOR(right) == ABS)
{ *next = or(
equation(ARG(0,left),ARG(0,right)),
equation(ARG(0,left),tnegate(ARG(0,right)))
);
goto out;
}
if (FUNCTOR(right) == ABS)
{ temp = right;
right = left;
left = temp;
swapflag = 1;
}
if(FUNCTOR(left) != ABS)
return 1;
if(OBJECT(right))
err = 0;
else if(econstant(right))
err = check(le(zero,right));
else
err = infer(le(zero,right));
if(err)
{ errbuf(0, english(1549)); /* Right side must be non-negative. */
return 1;
}
if(swapflag)
*next = or(
equation(right,ARG(0,left)),
equation(tnegate(right),ARG(0,left))
);
else
*next = or(
equation(ARG(0,left),right),
equation(ARG(0,left),tnegate(right))
);
out:
strcpy(reason, english(242)); /* |u|=c iff u=c or u=-c */
HIGHLIGHT(*next);
return 0;
}
/*______________________________________________________________*/
MEXPORT_ALGEBRA int delete_false(term t, term *ans)
/* if t is an OR, delete any 'false' arguments, returning result in *ans */
/* return 0 for something deleted, 1 otherwise. Answer can be
garbage if return value is 1. */
/* Placed in this file because likely to arise only when
an equation reduces to an impossibility */
{ int cnt = 0;
int k,i;
unsigned short nn = ARITY(t);
term temp;
if(FUNCTOR(t) != OR)
return 1;
for(i=0;i<nn;i++)
{ if(equals(ARG(i,t),false))
++cnt;
}
if(cnt == 0)
return 1;
if(cnt == nn) /* all args were false! */
{ *ans = false;
return 0;
}
if(cnt == nn-1) /* all but one were false */
{ for(i=0;i<nn;i++)
{ if(!equals(ARG(i,t),false))
{ *ans = ARG(i,t);
return 0;
}
}
}
temp = make_term(OR,(unsigned short)(nn-cnt));
k=0;
for(i=0;i<nn;i++)
{ if(!equals(ARG(i,t),false))
{ ARGREP(temp,k,ARG(i,t));
++k;
}
}
*ans = temp;
return 0;
}
/*__________________________________________________________________*/
/* in auto mode, don't use cross-multiply if it will put X on both sides
of the equation when it was only on the left before. And don't
cross-multiply if X is only on the left and the left side is not a
quotient, as in x = 2/3, or even x + 4/3 = 2/3, or even (2/3)x + 1/3 = 4/3.
crossmultiply has to be pre-associated, e.g. in (x-2)/3 = 8/5, to
prevent the 3 from being divided through the x-2. */
MEXPORT_ALGEBRA int crossmultiply(term eqn, term arg, term *next, char *reason)
{ term left,right,newleft,newright,multby,u;
int leftsign = 0;
int rightsign = 0;
char buffer[81];
int err;
if(FUNCTOR(eqn)!= '=')
return 1;
left = ARG(0,eqn);
right = ARG(1,eqn);
if(FUNCTOR(left) != '/' && FUNCTOR(right) != '/')
return 1; /* at least one side must be a fraction for this to work */
if(NEGATIVE(left) && FRACTION(ARG(0,left)))
{ left = ARG(0,left);
leftsign = -1; /* means in the end negate the left side */
}
if(NEGATIVE(right) && FRACTION(ARG(0,right)))
{ right = ARG(0,right);
rightsign = -1;
}
if(FRACTION(left) && FRACTION(right))
{ newleft = signedproduct(ARG(0,left),ARG(1,right));
newright = signedproduct(ARG(1,left),ARG(0,right));
if(status(collectpowers) > LEARNING)
{ err = rawcollectpowers(newleft,&u,1);
if(!err)
newleft = u;
err = rawcollectpowers(newright,&u,1);
if(!err)
newright = u;
}
if(FUNCTOR(newleft)=='*')
sortargs(newleft);
if(FUNCTOR(newright)=='*')
sortargs(newright);
if(NEGATIVE(newleft) && FUNCTOR(ARG(0,newleft)) == '*')
sortargs(ARG(0,newleft));
if(NEGATIVE(newright) && FUNCTOR(ARG(0,newright)) == '*')
sortargs(ARG(0,newright));
strcpy(reason, english(243)); /* cross multiply */
if(leftsign == -1)
newleft = tnegate(newleft);
if(rightsign == -1)
newright = tnegate(newright);
*next = equation(newleft,newright);
HIGHLIGHT(*next);
if(!obviously_nonzero(ARG(1,left)) || !obviously_nonzero(ARG(1,right)))
set_checksolutionsflag(1);
return 0;
}
else if(FUNCTOR(left) == '/')
{ multby = ARG(1,left);
newright = niceproduct(multby,right);
newleft = ARG(0,left);
SetShowStepOperation(muleqn);
SetShowStepArg(ARG(1,left));
}
else if(FUNCTOR(right) == '/')
{ multby = ARG(1,right);
newleft = niceproduct(left,multby);
newright = ARG(0,right);
SetShowStepOperation(muleqn);
SetShowStepArg(ARG(1,right));
}
if(leftsign == -1)
newleft = strongnegate(newleft);
if(rightsign == -1)
newright = strongnegate(newright);
*next = equation(newleft,newright);
HIGHLIGHT(*next);
strcpy(reason, english(196)); /* multiply by */
err = mstring(multby,buffer);
if(err || strlen(buffer) > 9)
{ strcat(reason, english(279)); /* denom */
return 0;
}
strcat(reason,buffer);
if(!obviously_nonzero(multby))
set_checksolutionsflag(1);
SetShowStepArg(multby);
SetShowStepOperation(muleqn);
return 0;
}
/*__________________________________________________________________*/
static term get_eqn(term u)
/* produces u=0 unless u is a linear term ax�b, or x�b, in which
cases it solves the linear equation, PROVIDED that solvelinear is
well-known. */
{ term v,ans;
int err;
v = equation(u,zero);
if(collected(u) > 1)
return v;
err = solve_linear_ineq(v,&ans);
if(!err)
{ RELEASE(v);
return ans;
}
else
return v;
}
/*__________________________________________________________________*/
/* spliteqn takes an equation A*B = 0 (or with several factors)
and produces a disjunction of separate equations. For example
it takes (x-3)(x-4)=0 and produces OR(x=3,x=4). However, if the
factors are non-linear then it doesn't solve them.
It also works if zero is on the left.
If, however, there is only one non-constant equation, it just
produces that equation, instead of a disjunction; and in general,
constant terms should be cancelled out
It also works on an OR of equations, by working on each arg,
so that it can be called in pre_ops on an OR in order to
be applied before maximalsub.
*/
MEXPORT_ALGEBRA int spliteqn(term eqn, term arg, term *next, char *reason)
{ term left,right,u,w,temp;
unsigned short n,k;
int i,j,flag,err,refutedflag=0;
int whicharg = -1;
unsigned short path[11];
if(FUNCTOR(eqn) == OR)
{ n = ARITY(eqn);
u = make_term(OR,n);
flag = 0;
for(i=0;i<n;i++)
{ err = spliteqn(ARG(i,eqn),arg,&temp,reason);
if(err)
ARGREP(u,i,ARG(i,eqn));
else
{ flag = 1;
ARGREP(u,i,temp);
path[0] = OR;
path[1] = (unsigned short)(i+1);
path[2] = 0;
pathcat(path,get_pathtail());
set_pathtail(path);
}
}
if(!flag)
return 1; /* it did not work on any of the equations */
*next = topflatten(u);
return 0;
}
if(FUNCTOR(eqn) != '=')
return 1;
left = ARG(0,eqn);
right = ARG(1,eqn);
if(!ZERO(right))
{ if(ZERO(left)) /* work on 0 = abc as well as on abc = 0 */
{ err = spliteqn(equation(ARG(1,eqn),ARG(0,eqn)),arg,next,reason);
if(err)
return 1;
pathcopy(path,get_pathtail());
if(path[0] == '=')
path[1] =(unsigned short)(path[1]==1 ? 2 : 1);
return 0;
}
else
return 1;
}
if(FUNCTOR(left) != '*')
return 1;
n = ARITY(left);
*next = make_term(OR,n);
k=0;
for(i=0;i<n;i++)
{ u = ARG(i,left);
if(econstant(u))
{ if(ISZERO(u))
{ if(get_mathmode()!= AUTOMODE)
{ errbuf(0, english(1980));
/* One of the factors is zero. */
return 1;
}
*next = equation(zero,zero);
path[0] = '=';
path[1] = 1;
path[2] = 0;
set_pathtail(path);
SetShowStepOperation(multbyzero);
strcpy(reason, "$x�0 = 0$");
HIGHLIGHT(ARG(0,*next));
return 0;
}
if(!get_binders())
{ err = check(nonzero(u));
if(err)
{ /* u was not explicitly zero but was equal to zero */
if(get_mathmode() != AUTOMODE)
{ errbuf(0,english(1981));
/* One of the factors is, or simplifies to, zero. */
return 1;
}
polyval(u,&temp);
if(!ZERO(temp))
return 1;
path[0] = '=';
path[1] = 1;
path[2] = '*';
path[3] = (unsigned short)(i+1);
path[4] = 0;
set_pathtail(path);
SetShowStepOperation(polyvalop);
temp = make_term('*',n);
for(j=0;j<n;j++)
ARGREP(temp,j, j==i ? zero : ARG(j,left));
HIGHLIGHT(ARG(i,temp));
*next = equation(temp,zero);
strcpy(reason, english(1589)); /* simplify */
return 0;
}
else
continue;
}
else
continue;
}
temp = get_eqn(u);
if(immediate(temp)== -1) /* assumptions contradicted */
{ if(refutedflag)
{ commentbuf(0, english(212));
/* !Some factors are nonzero by current assumptions */
}
else
{ commentbuf(0, english(211));
/* !One factor has to be nonzero by current assumptions */
++refutedflag;
}
}
else
{ ARGREP(*next,k,temp);
whicharg = i;
++k;
}
}
if(k==0) /* all the equations were constant or at least provably nonzero ! */
{ *next = false;
strcpy(reason, english(244)); /* unsolvable equation */
SetShowStepOperation(rejecteqn);
return 0;
}
if(k==1)
{ temp = ARG(0,*next);
RELEASE(*next);
if(get_mathmode() == AUTOMODE)
{ if(n == 2)
{ w = ARG(whicharg ? 0 : 1, left);
SetShowStepArg(w);
SetShowStepOperation(diveqn);
clear_comment_buffer();
return diveqn(eqn,w,next,reason);
}
else /* divide by all the nonconstant terms */
{ SetShowStepOperation(diveqn);
clear_comment_buffer();
w = make_term('*',(unsigned short)(n-1));
for(j=0;j<n-1;j++)
ARGREP(w,j,ARG(j<whicharg ? j : j+1,left));
if(whicharg == n-1)
SetShowStepArg(w);
return diveqn(eqn,w,next,reason);
}
}
else
{ *next = temp;
HIGHLIGHT(*next);
strcpy(reason, english(215)); /* a=0 or b=0 if ab=0 */
return 0;
}
}
SETFUNCTOR(*next,OR,k);
HIGHLIGHT(*next);
strcpy(reason, english(215)); /* a=0 or b=0 if ab=0 */
return 0;
}
/*______________________________________________________________________*/
MEXPORT_ALGEBRA int spliteqn2(term eqn, term arg, term *next, char *reason)
/* if ab = ac then a=0 or b=c */
{ term left,right,u,temp,a,b,c,d,q;
unsigned short n;
double z,zb,zd;
term v;
int i,flag,err;
if(FUNCTOR(eqn) == OR)
{ n = ARITY(eqn);
u = make_term(OR,n);
flag = 0;
for(i=0;i<n;i++)
{ err = spliteqn2(ARG(i,eqn),arg,&temp,reason);
if(err)
ARGREP(u,i,ARG(i,eqn));
else
{ flag = 1;
ARGREP(u,i,temp);
}
}
if(!flag)
return 1; /* it did not work on any of the equations */
*next = topflatten(u);
return 0;
}
if(FUNCTOR(eqn) != '=')
return 1;
left = ARG(0,eqn);
right = ARG(1,eqn);
if(OBJECT(left) || OBJECT(right))
return 1;
if(FUNCTOR(left) == '+')
{ err = content_factor(left,&a,&b);
if(err)
return 1;
}
else
{ a = left;
b = one;
}
if(FUNCTOR(right) == '+')
{ err = content_factor(right,&c,&d);
if(err)
return 1;
}
else
{ c = right;
d = one;
}
if(FRACTION(a) || FRACTION(c))
return 1;
naive_gcd(a,c,&u);
if(ONE(u))
return 1;
if(!equals(u,a))
{ err = cancel(left,u,&v,&temp);
if(err)
return 1;
b = product(temp,b);
if(FUNCTOR(b) == '*')
sortargs(b);
}
if(!equals(u,c))
{ err = cancel(right,u,&v,&temp);
if(err)
return 1;
d = product(temp,d);
if(FUNCTOR(d) == '*')
sortargs(d);
}
if(seminumerical(u) && deval(u,&z) && z != BADVAL && z != 0)
{ errbuf(0,english(1552));
/* Divide by the nonzero common factor, instead of using this operation. */
return 1;
}
temp = equation(u,zero);
err = refute(temp);
if(!err)
{ errbuf(0,english(1593));
/* Since the common factor of the two sides can't be zero in this case, you should just divide by it. */
return 1;
}
q = equation(b,d);
if(get_mathmode() == AUTOMODE && seminumerical(q))
{ deval(b,&zb);
deval(d,&zd);
if(zd != zb)
return 1; /* example: x = -x, we don't want or(x = 0,1 = -1) */
}
*next = or(temp, equation(b,d));
HIGHLIGHT(*next);
strcpy(reason, english(1421)); /* a=0 or b=c if ab=ac */
release(doublesin);
release(doublecos1); /* possibly inhibited by sumofsin etc. */
release(doublecos2);
release(doublecos3);
release(doublecos4);
return 0;
}
/*__________________________________________________________________*/
/* Here are two auxiliaries needed below by select_mularg: */
static unsigned short countdenoms(term t)
/* count the denominators in a product, sum, fraction or negation thereof;
example, if t is (1/x)y(-(a/b)) we get 2 */
{ unsigned short n,k;
int i;
if(FUNCTOR(t) == '-')
return countdenoms(ARG(0,t));
if(FUNCTOR(t) == '/' && FUNCTOR(ARG(1,t)) == '*')
return ARITY(ARG(1,t));
if(FUNCTOR(t) == '/') /* and denom is not a product */
return 1;
if(FUNCTOR(t) == '*' || FUNCTOR(t) == '+')
{ k = 0;
n = ARITY(t);
for(i=0;i<n;i++)
k+= countdenoms(ARG(i,t));
return k;
}
else
return 0;
}
/*__________________________________________________________________*/
static void auto_muleqn_aux(term t, term *ans, int *nans)
/* t is a product,sum, quotient, or negation;
collect all the denominators
into a product and place them in the pre-allocated array ans,
which must be large enough to hold them. The number of denominators
is returned in nans.
Nonzero return value means there were no denoms */
{ unsigned short n;
int i;
term u;
if(FUNCTOR(t) == '-')
{ auto_muleqn_aux(ARG(0,t),ans,nans);
return;
}
if(FUNCTOR(t) == '/' && FUNCTOR(ARG(1,t)) == '*')
{ u = ARG(1,t);
n = ARITY(u);
*nans = (int) n;
for(i=0;i<n;i++)
ans[i] = ARG(i,u);
return;
}
if(FUNCTOR(t) == '/') /* and the denom isn't a product */
{ *nans = 1;
*ans = ARG(1,t);
return;
}
if(FUNCTOR(t) == '*' || FUNCTOR(t) == '+')
{ unsigned short n = ARITY(t);
int i,k,tt;
k=0;
for(i=0;i<n;i++)
{ auto_muleqn_aux(ARG(i,t),ans + k,&tt);
k += tt;
}
*nans = k;
return;
}
*nans = 0;
return;
}
/*__________________________________________________________________*/
int select_mularg(term eqn, term *arg)
/* choose a term by which to multiply an equation or inequality
in auto mode. Return 0 for success, 1 for failure.
/* Auto mode uses common denominators to deal with sums in equations,
so it isn't necessary to use the lcm's in this function. */
/* If left is a product, then auto_divide will divide by constants, so
you don't want to multiply by them unless left is a sum, and you
have to distribute the multiplication in or it will loop with
auto_divide, or unless the left side is already a quotient, so
you aren't creating a new product.
Exception. Consider (1/4)(x-3) = 5. We want to multiply by 4,
not divide by (1/4). We won't loop.
When left is a sum, and right is constant, when do we want to
multiply by a constant? Consider
x-2 = 5/24; it's better not to multiply by 24; but consider
3x-2 = 5/24; if you don't multiply, you'll get compound fractions; and in
(x-2)/3 = 5/24; you do want to multiply by 3, but not by 24.
When left is a sum of fractions and right is a non-constant-numerator
fraction, multiply by the lcm of the denominators.
When left is a product containing a power with a negative exponent,
we should multiply by the corresponding power with a positive exponent.
When one side is zero, be careful not to make a mistake because of
eliminating a term whose codomain has to be excluded from the final
solution.
*/
{ term left,right,c,s,temp,x,q,a,b;
int i,k,n,err;
unsigned short f=FUNCTOR(eqn);
unsigned short g,h,m,ndenoms;
if(!INEQUALITY(f))
return 1;
left = ARG(0,eqn);
right = ARG(1,eqn);
if(get_currenttopic() == _logarithmic_differentiation)
{ if( FRACTION(left) &&
(contains(ARG(0,left),DIFF) || contains(ARG(0,left),PR)) &&
!contains(right,DIFF)
)
{ *arg = ARG(1,left);
return 0;
}
return 1;
}
if(NEGATIVE(left))
left = ARG(0,left);
if(NEGATIVE(right))
right = ARG(0,right);
err = derivative_subterm(eqn,&x);
if(err)
x = get_eigenvariable();
if(ZERO(left) && f != '=')
{ left = right;
right = zero;
}
g=FUNCTOR(left);
h=FUNCTOR(right);
if(ZERO(right) && FUNCTOR(left) == '*' && contains_sqrt(left))
{ /* In u sqrt v < 0, multiply by sqrt v.
There is a special operation for multiplying u/sqrt v by v sqrt v,
so this doesn't need to be handled here.
*/
sqrts_and_nonsqrts(left,&a,&b);
if(ONE(a))
return 1;
*arg = a;
return 0;
}
if(g == '/' && FUNCTOR(ARG(0,left)) == ABS)
{ *arg = ARG(1,left);
return 0;
}
if(h == '/' && FUNCTOR(ARG(0,right)) == ABS)
{ *arg = ARG(1,right);
return 0;
}
if(g == '*')
{ ratpart(left,&c);
if(FUNCTOR(c) == '/')
{ *arg = reciprocal(c);
return 0;
}
/* Look for a negative exponent among the factors */
m = ARITY(left);
for(i=0;i<m;i++)
{ temp = ARG(i,left);
if(FUNCTOR(temp)=='^' && NEGATIVE(ARG(1,temp)))
{ *arg = make_power(ARG(0,temp),ARG(0,ARG(1,temp)));
return 0;
}
}
return 1;
}
if(f != '=' && h == '*' && !econstant(right))
{ ratpart(right,&c);
if(FUNCTOR(c) == '/')
{ *arg = reciprocal(c);
return 0;
}
/* Look for a negative exponent among the factors */
m = ARITY(right);
for(i=0;i<m;i++)
{ temp = ARG(i,right);
if(FUNCTOR(temp)=='^' && NEGATIVE(ARG(1,temp)))
{ *arg = make_power(ARG(0,temp),ARG(0,ARG(1,temp)));
return 0;
}
}
return 1;
}
if(g == '/' && h == '/' && !econstant(ARG(1,left)) && !econstant(ARG(1,right)))
{ if( /* example, sin(1/n)/n < 1/n^2 */
(f == '<' || f == LE) &&
FUNCTOR(ARG(0,left)) == SIN &&
!contains_trig(ARG(1,left)) &&
!contains_trig(ARG(1,right))
)
{ *arg = ARG(1,left);
return 0;
}
return 1; /* use alltoleft and common denominators instead */
}
if(g == '/' && h == '/' && !econstant(left) && !econstant(right) &&
econstant(ARG(1,left)) && econstant(ARG(1,right))
) /* Example: x/3 = (x+1)/4, but not x/3 = 5/24 */
{ temp = sum(right,left);
naive_lcm(ARG(1,left),ARG(1,right),arg);
err = value(product(ARG(1,left),ARG(1,right)),&s);
if(equals(s,*arg) || equals(*arg,product(ARG(1,left),ARG(1,right))))
SetShowStepArgs(ARG(1,left),ARG(1,right));
if(!err)
*arg = s; /* makes the reason be 'multiply by 12'
instead of 'multiply by 3*4' */
return 0;
}
if(g == '/' && !econstant(ARG(0,left)))
{ if(FUNCTOR(right) == '+' && sum_of_fractions(right) && !econstant(right))
{ temp = sum(right,left);
err = naivecomdenom(temp,&c);
assert(!err); /* there's at least one fraction in the sum */
assert(SIGNEDFRACTION(c));
*arg = denom(c);
}
else
*arg = ARG(1,left);
return 0;
}
if(h == '/' && !econstant(ARG(0,right)))
{ if(FUNCTOR(left) == '+' && sum_of_fractions(left) && !econstant(left))
{ temp = sum(left,right);
err = naivecomdenom(temp,&c);
assert(!err); /* there's at least one fraction in the sum */
assert(SIGNEDFRACTION(c));
*arg = denom(c);
}
else
*arg = ARG(1,right);
return 0;
}
if(g == '/' && econstant(ARG(0,left)) && !econstant(ARG(1,left)))
/* example, 1/(4(x+1)) = c, multiply by x+1 but not 4(x+1) */
{ temp = ARG(1,left);
if(FUNCTOR(temp) != '*')
{ *arg = temp;
return 0;
}
twoparts(temp,x,&c,&s);
*arg = s;
return 0;
}
if(h == '/' && econstant(ARG(0,right)) && !econstant(ARG(1,right)))
/* example, c = 1/(x+1) */
{ temp = ARG(1,right);
if(FUNCTOR(temp) != '*')
{ *arg = temp;
return 0;
}
twoparts(temp,x,&c,&s);
*arg = s;
return 0;
}
if(g == '/' && econstant(right) && !econstant(ARG(1,left)))
/* example, (x+2)/(4(x+1)) = c, multiply by 4(x+1) */
{ *arg = ARG(1,left);
return 0;
}
if(h == '/' && econstant(left) && !econstant(ARG(1,right)))
/* example, c =(x+2)/(4(x+1)), multiply by 4(x+1) */
{ *arg = ARG(1,right);
return 0;
}
if(econstant(left) && h == '+')
{ temp = left; /* swap left and right */
left = right;
right = temp;
g = h; /* and don't forget to swap g and h too; but h is
never used again so the full swap isn't needed. */
}
if(econstant(right) && g == '+')
{ /* count the non-constant terms on the left */
k=0;
for(i=0;i<ARITY(left);i++)
{ if(!econstant(ARG(i,left)))
++k;
}
if(k==1) /* then ignore denominators on the right */
{ /* collect all denominators on the left and
multiply by the product */
ndenoms = countdenoms(left);
if(ndenoms==0)
return 1;
if(ndenoms==1)
auto_muleqn_aux(left,arg,&n);
else
{ q = make_term('*',ndenoms);
auto_muleqn_aux(left,ARGPTR(q),&n);
assert(n==ndenoms);
naive_listlcm(q,arg); /* naive_listlcm uses fresh space */
RELEASE(q);
}
return 0;
}
/* else use denoms on the right side too */
c = make_term('*',2);
ARGREP(c,0,left);
ARGREP(c,1,right);
ndenoms = countdenoms(c);
if(ndenoms==0)
return 1;
if(ndenoms==1)
{ auto_muleqn_aux(c,arg,&n);
assert(n==1);
}
else
{ q = make_term('*',ndenoms);
auto_muleqn_aux(c,ARGPTR(q),&n);
assert(n==ndenoms);
naive_listlcm(q,arg);
RELEASE(q); /* naive_listlcm uses fresh space */
RELEASE(c);
}
return 0;
}
return 1;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int sum_of_fractions(term t)
/* return 1 if t is a sum containing one or more fractions, or
a product one of whose factors is such a sum */
{ unsigned short n;
int i;
if(ATOMIC(t))
return 0;
if(FUNCTOR(t) == '*')
{ n = ARITY(t);
for(i=0;i<n;i++)
{ if(sum_of_fractions(ARG(i,t)))
return 1;
}
return 0;
}
if(FUNCTOR(t) != '+')
return 0;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(SIGNEDFRACTION(ARG(i,t)))
return 1;
}
return 0;
}
/*____________________________________________________________*/
MEXPORT_ALGEBRA int get_ind_set(term t, term *atomlist)
/* atomlist is an array of terms of length nvariables */
/* Fill it with an "independent set" of variables occurring
in t. If there are no dependent variables in t that will
just be all variables in t. If, say, u is defined in terms
of x, and u occurs in t, then atomlist will contain x and not u
or u and not x, according as x occurs in t or not.
*/
{ term *varlist = get_varlist();
varinf *varinfo = get_varinfo();
int nvariables = get_nvariables();
term x;
int natoms=0;
int i,j;
for(i=0;i<nvariables;i++)
{ x = varlist[i];
if( contains(t,FUNCTOR(x)) &&
varinfo[i].scope != BOUND
)
{ if(!varinfo[i].dp)
{ atomlist[natoms] = x;
++natoms;
}
else
{ /* determine whether x depends on some other
variable in t */
for(j=0;j<nvariables;j++)
{ if(j==i || !contains(t,FUNCTOR(varlist[j])))
continue;
if(depends(x,varlist[j]))
break;
}
if(j==nvariables)
{ atomlist[natoms] = x;
++natoms;
}
}
}
}
return natoms;
}
/*___________________________________________________________________*/
static void sqrts_and_nonsqrts(term t, term *a, term *b)
/* t is a product. Sort the args into two categories:
those which are non-econstant SQRT, ABS, or ROOT terms,
or non-constant positive rational powers, which go into *a,
and the rest, which go into *b.
However, when putting ROOT or fractional-power terms
with power r other than 1/2 into *a, don't put the term
itself but the term with power 1-r, e.g. for x^(1/3)
we put in x^(2/3), and for root(n,x) we put in root(n,x)^(n-1).
*/
{ unsigned short n = ARITY(t);
unsigned short f,j,k;
int i;
term u,index,power,temp;
*a = make_term('*',n);
*b = make_term('*',n);
k = j = 0;
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(econstant(u))
{ ARGREP(*b,j,u);
++j;
continue;
}
f = FUNCTOR(u);
if(f == SQRT || f == ABS ||
(f == '^' && RATIONALP(ARG(1,u)) && ONE(ARG(0,ARG(1,u))) && equals(ARG(1,ARG(1,u)),two))
)
{ ARGREP(*a,k,u);
++k;
continue;
}
if(f == ROOT)
{ index = ARG(0,u);
if(INTEGERP(index))
value(sum(index,minusone),&power);
else
power = sum(index,minusone);
ARGREP(*a,k,make_power(u,power));
++k;
continue;
}
if(f == '^' && RATIONALP(ARG(1,u)))
{ value(sum(one, tnegate(ARG(1,u))),&power);
ARGREP(*a,k,make_power(ARG(0,u),power));
++k;
continue;
}
ARGREP(*b,j,u);
++j;
}
if(k == 0)
{ RELEASE(*a);
*a = one;
}
else if(k == 1)
{ temp = ARG(0,*a);
RELEASE(*a);
*a = temp;
}
else
SETFUNCTOR(*a, '*',k);
if(j == 0)
{ RELEASE(*b);
*b = one;
}
else if(j == 1)
{ temp = ARG(0,*b);
RELEASE(*b);
*b = temp;
}
else
SETFUNCTOR(*b, '*',j);
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists