Sindbad~EG File Manager
/* find substititions automatically */
/* M. Beeson
4.16.91 Original date
1.22.98 last modified
*/
#define ALGEBRA_DLL
#include <assert.h>
#include <stdlib.h>
#include "globals.h"
#include "cancel.h"
#include "autosub.h"
#include "order.h"
#include "algaux.h"
#include "factor.h"
#include "match.h"
#include "prover.h"
#include "probtype.h"
#include "eqn.h"
#include "polynoms.h"
#include "solvelin.h"
#include "ops.h"
#include "maxsub.h"
#include "symbols.h"
#include "mathmode.h" /* get_substitutionflag */
#include "pvalaux.h" /* is_linear_in */
#include "psubst.h"
#include "errbuf.h"
#include "gcdsub.h" /* get_gcdsub */
#include "autosimp.h" /* ResetShowStep */
#include "trig.h" /* TRIGFUNCTOR */
#include "advfact.h" /* nthroot_aux */
#define eqtest(u,v) (equals(u,v) || eqtest(u,v))
static int eqlinear(term,term);
static int testsub(term t, term sofar, term *ans, term *newvar);
static int analyze_roots(term);
static int adhoc_autosub(term t, term *sub, term *ans);
static int autosub2(int flag,term t, term *sub, term *ans);
static int block_sqrtsub(term t, term sofar);
static int better_by_comdenom(term t,term x);
static int signed_reciprocals(term a, term b);
static int contains_sqrtx(term t, term x);
static int exponential_sub(term t, term x, term *s);
/*_______________________________________________________________________*/
static int acceptable(term t, term context)
/* return 1 if t is acceptable as a substitution for autosub to produce
(as a subterm of context), and
zero otherwise; specifically:
t is a power whose base is atomic, and whose power doesn't depend on the base,
or a product of such powers and possibly constant factors, or a quotient
of such terms. Also, a root or square root of an atom or a
linear function of the eigenvariable. Also, t can't be constant,
i.e. can't contain only variables listed as parameters.
Examples: e^(ix); 3x^2y; xy are acceptable; x^x is not acceptable */
{ int i;
unsigned short f = FUNCTOR(t);
unsigned short n;
term a,nn,c,s;
term x = get_eigenvariable();
term base;
long m;
if(constant(t))
return 0;
switch(f)
{ case ROOT:
if(ISATOM(ARG(1,t)))
return 1;
if(FUNCTOR(ARG(1,t)) == '*')
{ ncs(ARG(1,t),&nn,&c,&s);
if(ISATOM(s))
return 1;
}
return 0;
case SQRT:
if(ISATOM(ARG(0,t)))
return 1;
if(FUNCTOR(ARG(0,t)) == '*')
{ ncs(ARG(0,t),&nn,&c,&s);
if(ISATOM(s))
return 1;
}
return 0;
case '+':
if(is_linear_in(t,x))
return 1; /* success */
return 0; /* failure */
case '*':
n = ARITY(t);
for(i=0;i<n;i++)
{ if(!acceptable(ARG(i,t),context) && !constant(ARG(i,t)) && !ATOMIC(ARG(i,t)) )
break;
}
if(i<n)
return 0; /* failure */
return 1; /* success */
case '^':
base = ARG(0,t); /* doesn't have to be the eigenvariable */
a = ARG(1,t); /* t = base^a */
if(!ISATOM(base))
{ if(get_substitutionflag() == VISIBLESUBS && is_linear_in(base,x))
return 1; /* e.g. (y-1)^(1/3) is acceptable,
but only with explicit substitutions */
return 0; /* otherwise, non-atomic base is unacceptable */
}
if(depends(a,base))
return 0; /* failure */
m = -1;
if(FUNCTOR(a) == '-' && ISINTEGER(ARG(0,a)))
m = INTDATA(ARG(0,a));
else if(ISINTEGER(a))
m = INTDATA(a);
if(m > 3)
{ if ((m % 3) ==0 || !(m&1) ) /* m divisible by 3 or 2 */
return 1; /* success */
}
return (noccurs(base,context) != 1); /* reject e.g. x^2 in x^2 -y^6 */
case '/':
if(ATOMIC(ARG(0,t)) && ATOMIC(ARG(1,t)) && !constant(t))
return 1; /* example, h/x in (1+h/x)^(x/h) */
if(constant(ARG(0,t)) || ISATOM(ARG(0,t)))
return acceptable(ARG(1,t),context);
if(constant(ARG(1,t)) || ISATOM(ARG(1,t)))
return acceptable(ARG(0,t),context);
return (acceptable(ARG(0,t),context) && acceptable(ARG(1,t),context));
}
return 0; /* fail except in stated cases */
}
/*_______________________________________________________________________*/
static int autosub_aux(term t, term context, term *sofar)
/* look for the maximal substitution in subterm t which is compatible with the
substitution *sofar found already, and eliminates some variable(s).
Return 0 for success, 1 for failure; the answer is returned in *sofar
When this is called from autosub, *sofar is ILLEGAL; this means no
substitution has been found already.
*/
{ term temp,cancelled,c,s,saveit,s1,s2,u,newt,newsofar,qq;
unsigned short n;
unsigned short f = FUNCTOR(t);
term *atomlist = NULL;
unsigned short atomflag = 0;
int problemtype;
int nvariables = get_nvariables();
term *varlist = get_varlist();
int i,j,err,natoms,k,m;
if(NEGATIVE(t))
return autosub_aux(ARG(0,t),context,sofar);
if(FUNCTOR(*sofar) != ILLEGAL)
{ natoms = atomsin(*sofar,&atomlist);
for(i=0;i<natoms;i++)
{ if(depends(t,atomlist[i]))
break;
}
free2(atomlist); /* allocated by atomsin above */
if(i==natoms) /* t doesn't contain variables in common with sofar
even if definitions of variables in t are unwound */
return 0; /* success; pass by a constant term without changing *sofar */
}
/* Now either *sofar and t have variables in common, or *sofar is ILLEGAL */
if(OBJECT(t))
return 0; /* pass it by as in 1-x^2y^2 */
if(FRACTION(*sofar) && TRIGFUNCTOR(f) && INTEGERP(ARG(1,*sofar)))
{ /* we want to find u = x/2 in 2 sin(x/2) cos(x/2) = sin x for example.
Since in general we DON'T want to find u = x/2 we have 'return 1'
below in the ISATOM(t) case; but then to find u = x/2 when desired,
we need this special code.
*/
if(equals(ARG(0,*sofar),ARG(0,t)))
return 0;
/* While we're at it, find u = x/6 in sin(x/2) = ...cos(x/3... */
if(FRACTION(ARG(0,t)) &&
INTEGERP(ARG(1,ARG(0,t))) &&
equals(ARG(0,ARG(0,t)),ARG(0,*sofar))
)
{ ratgcd2(reciprocal(ARG(1,*sofar)),reciprocal(ARG(1,ARG(0,t))),&u);
if(FRACTION(u))
{ *sofar = make_fraction(ARG(0,*sofar),ARG(1,u));
return 0;
}
}
}
if(ISATOM(t))
{ if(FUNCTOR(*sofar) == ILLEGAL)
return 0; /* pass it by as in a - x^4 */
/* will result also in passing by x in x - x^4 */
else if(FUNCTOR(*sofar) == SQRT && equals(ARG(0,*sofar),t))
return 0; /* keep going if sofar = sqrt(t) */
else if(FUNCTOR(*sofar) == ROOT && equals(ARG(1,*sofar),t))
return 0;
else if(FUNCTOR(*sofar) == '^' && equals(ARG(0,*sofar),t) &&
RATIONALP(ARG(1,*sofar)) && ONE(ARG(0,ARG(1,*sofar)))
)
return 0;
else
return 1; /* fail as in x^4 - x */
}
if(FUNCTOR(t) == ROOT && FUNCTOR(ARG(1,t)) == '^' && INTEGERP(ARG(1,ARG(1,t))))
/* example: root(3,x^2). Replace it by root(3,x) so it will find u = root(3,x) */
t = make_root(ARG(0,t),ARG(0,ARG(1,t)));
if(acceptable(t,context) && /* see above */
!(FUNCTOR(*sofar)==ILLEGAL && equals(t,context))
/* don't bite off the whole term even if it passes 'acceptable' */
)
{ if(FUNCTOR(*sofar) == ILLEGAL)
{ *sofar = t; /* this gets us started */
return 0;
}
else if(OBJECT(*sofar))
return 1; /* failure */
else if(ISATOM(*sofar))
{ if( f == '+'
&& contains(t,FUNCTOR(*sofar))
&& is_linear_in(t,*sofar)
&& get_substitutionflag() == VISIBLESUBS
/* don't produce (y-1) + �(y-1) + 3 because
it will just get unwound again */
)
{ *sofar = t;
return 0; /* success */
}
else if(f == SQRT || f == ROOT)
{ u = f == SQRT ? ARG(0,t) : ARG(1,t);
if(equals(*sofar,u))
{ *sofar = t;
return 0;
}
else if(FUNCTOR(u) == '*')
{ twoparts(u,*sofar,&c,&s);
if(equals(*sofar,s))
{ *sofar = t;
return 0;
}
}
}
else if(f == '^' && RATIONALP(ARG(1,t)))
{ temp = ARG(1,t);
if(FUNCTOR(temp) == '/' && ONE(ARG(0,temp)))
{ if(equals(*sofar,ARG(0,t)))
{ *sofar = t;
return 0;
}
else if(FUNCTOR(ARG(0,t)) == '*')
{ twoparts(ARG(0,t),*sofar,&c,&s);
if(equals(*sofar,s))
{ *sofar = t;
return 0;
}
}
}
}
else if (f == '*')
/* example, *sofar = u and t = 5�u */
{ twoparts(t,*sofar,&c,&s);
if(ONE(s) || ONE(c))
/* without ONE(c) we get loops because possibly s==t */
return 1;
return autosub_aux(s,context,sofar);
}
return 1; /* failure */
}
else if(FUNCTOR(*sofar) == '/' && f != '/' && f != '+' &&
!(f == '^' && FUNCTOR(ARG(0,t)) == '+')
)
return 1; /* failure */
else if(FUNCTOR(*sofar) == '/' && f == '/')
{ term p,q;
if(eqtest(ARG(0,t),ARG(1,*sofar)) && eqtest(ARG(1,t),ARG(0,*sofar)))
/* they are reciprocals, up to a sign */
return 0; /* keeping the same *sofar */
naive_gcd(ARG(0,t),ARG(0,*sofar),&p);
naive_gcd(ARG(1,t),ARG(1,*sofar),&q);
if(!ONE(q))
*sofar = make_fraction(p,q);
else if(ONE(p))
return 1; /* failure */
return 0; /* success */
}
else if(FUNCTOR(*sofar) == '^' && f == '^')
/* for example: *sofar = x^5, t = x^4 */
{ if(!equals(ARG(0,*sofar),ARG(0,t)))
return 1;
naive_gcd(ARG(1,t),ARG(1,*sofar),&temp);
if(ONE(temp))
return 1; /* game over */
else
{ *sofar = make_power(ARG(0,*sofar),temp);
return 0;
}
}
else if(FUNCTOR(*sofar) == '^' && f == '*')
/* example, *sofar = x^4 and t = 2x^2 as in x^4 + 2x^2 + 1 */
{ ratpart2(t,&c,&s);
problemtype = get_problemtype();
if(!ONE(c) /* otherwise we'll loop */
&& !(SOLVETYPE(problemtype) && econstant(s))
&& !(!SOLVETYPE(problemtype) && constant(s))
/* block generation of substitutions like u = �2 */
)
return autosub_aux(s,context,sofar);
else /* example, *sofar = y^4 and t = xy^2 */
{ s1 = t;
for(j=0;j<nvariables;j++)
{ if(contains(*sofar,FUNCTOR(varlist[j])))
continue;
twoparts(s1,varlist[j],&c,&s2);
if(FUNCTOR(s2) != '*')
break;
}
if(equals(s1,t)) /* in the example s1 = y^2 */
return 1; /* failure */
if(SOLVETYPE(problemtype) && econstant(s1))
return 1; /* guard against producing constant substitutions */
if(!SOLVETYPE(problemtype) && constant(s1))
return 1;
return autosub_aux(s1,context,sofar);
}
}
else if(FUNCTOR(*sofar) == '^') /* and t isn't an exponent or product */
{ if(ISATOM(ARG(0,*sofar)) && INTEGERP(ARG(1,*sofar))
&& f == '+' && contains(t,FUNCTOR(ARG(0,*sofar)))
&& is_linear_in(t,ARG(0,*sofar))
/* e.g. *sofar = x^2 and t = ax+b */
&& get_substitutionflag() == VISIBLESUBS
)
{ *sofar = t;
return 0;
}
return 1; /* game over */
}
else if(f == '^' && equals(*sofar,ARG(0,t)))
{ copy(*sofar,&temp);
err = autosub_aux(ARG(1,t),context,&temp);
if(err)
return 1;
if(equals(temp,*sofar))
{ destroy_term(temp); /* safe because temp has not changed,
so it's the original term mady by copy */
return 0; /* e.g. t = (*sofar)^constant */
}
else
return 1; /* can't prove that destroy_term(temp) is OK here,
because autosub_aux may have changed temp and
incorporated some pointers to parts of t. Although
there WAS a destroy_term here that caused no observed
crashes, on 2.16.97 I took it out while hand-verifying
this code. */
}
else if(f == '*' && FUNCTOR(*sofar) == '*' && equals(t, *sofar))
return 0; /* used in lim(t->0, sin(3t)/3t); speeds up next code
by eliminating calls to ratpart2 etc. */
else if(FUNCTOR(*sofar) == '*')
{ ratpart2(*sofar,&c,&s); /* e.g. sofar = 4x^4, t = x^2 or 4x^2 */
problemtype = get_problemtype();
if(!ONE(c) /* otherwise we'll loop */
&& !(SOLVETYPE(problemtype) && econstant(s))
&& !(!SOLVETYPE(problemtype) && constant(s))
/* block generation of substitutions like u = �2 */
)
{ if(FUNCTOR(t) == '*')
{ term cc, ct, st;
ratpart2(t,&ct,&st);
if(!ONE(ct))
{ polygcd(c,ct,&cc);
newsofar = product(cc,s);
}
else
newsofar = s;
}
else
newsofar = s;
if(equals(*sofar,newsofar) || ISATOM(newsofar))
return 1; /* stop a loop and fail */
/* If we don't stop atomic newsofar, then
in the next recursive call sofar can get
enlarged to a linear function, which can
cause a loop. */
*sofar = newsofar;
return autosub_aux(t,context,sofar); /* temp = x^2 */
/* give up trying for at�, just try t� */
}
}
if(f == '*' ) /* example, sofar = xy^4 and t = xy^2 */
{ err = cancel(t,*sofar,&cancelled,&temp);
if(err)
return 1;
if(constant(temp))
return 0;
k = atomsin(temp,&atomlist);
free2(atomlist);
if(k==natoms)
return 1;
*sofar=temp; /* y^2 in the example */
return 0;
}
else if(f != '+' && !(f == '^' && FUNCTOR(ARG(0,t))=='+'))
return 1;
/* but if t is a sum or a power of a sum, go on */
}
n = ARITY(t);
temp = *sofar;
if(f == '+')
/* put the summands of t in a more likely order and
eliminate useless minus signs */
{ newt = make_term('+',n);
i=0;
while(ATOMIC(ARG(i,t)) && i < n-1)
{ ARGREP(newt,i+1,ARG(i,t));
++i;
}
/* Now you've filled in args 1,...i */
if(ATOMIC(ARG(i,t))) /* so i==n-1, all args were atomic */
return 1;
/* Put the first non-atomic arg in the 0th place */
ARGREP(newt,0,ARG(i,t));
if(i==n-2) /* there's just one more arg */
ARGREP(newt,n-1,ARG(n-1,t));
else if(i < n-2)
{ /* There's at least two more args */
/* Now similarly shove atomic things in from the right */
j = n-1;
while(ATOMIC(ARG(j,t)) && j > i+1)
{ ARGREP(newt, j-1,ARG(j,t));
--j;
}
/* So you've filled in j,...,n-2 */
ARGREP(newt,n-1,ARG(j,t));
if(j!=i+1)
{ for(k=i+1;k<j;k++)
ARGREP(newt,k,ARG(k,t));
}
if(get_orderflag() != DESCENDING) /* swap the first two args */
{ saveit = ARG(0,newt);
ARGREP(newt,0,ARG(1,newt));
ARGREP(newt,1,saveit);
}
}
t = newt; /* affects only the local copy of t */
}
saveit = temp;
for(m=0;m<n;m++) /* try it starting with the m-th term */
{ temp = saveit;
qq = ARG(m,t);
if(FUNCTOR(temp)== ILLEGAL && ISATOM(qq))
{ if(!constant(qq))
atomflag = FUNCTOR(qq);
}
else
{ err = autosub_aux(ARG(m,t),context,&temp);
if(err)
continue; /* to another m */
if(!err && FUNCTOR(temp) == '+')
{ /* temp is linear; try the non-constant,
non-atomic summands of temp. For example,
if temp = 1+h/x, we want to try h/x
*/
for(k=0;k<ARITY(temp);k++)
{ u = ARG(k,temp);
if(constant(u) || ATOMIC(u))
continue;
err = autosub_aux(t,context,&u);
if(!err)
{ *sofar = u;
return 0;
}
}
continue; /* to another m */
}
}
for(i=1;i<n;i++)
{ err = autosub_aux(ARG((m+i) %n ,t),context,&temp);
if(err)
break; /* try a different m, or if temp is a sum,
try the args of temp first. */
if(m+i==n-1 && FUNCTOR(temp)==ILLEGAL)
break; /* we've already tried args 0,...,m anyway */
}
if(i==n)
{ *sofar = temp;
if(FUNCTOR(temp)==ILLEGAL)
return 1; /* e.g. if we were given x+y, a sum of atoms */
if(atomflag) /* we passed by an atom first */
/* so throw away any constant attached to temp */
/* example: x + 2�x =3 = 0, temp = 2�x but
should be �x */
{ twoparts(temp, MAKE_ATOM(atomflag),&c,sofar);
if(FUNCTOR(*sofar) == '^' && INTEGERP(ARG(1,*sofar)))
return 1; /* fail, e.g. x + x^4, with temp = x^2 */
}
return 0;
}
if(FUNCTOR(temp) == '+')
{ for(k=0;k<ARITY(temp);k++)
{ u = ARG(k,temp);
if(constant(u) || ATOMIC(u))
continue;
err = autosub_aux(t,context,&u);
if(!err)
{ *sofar = u;
return 0;
}
}
}
}
return 1; /* failure */
}
/*_______________________________________________________________________*/
static int firstpowerin(term t, term *ans)
/* look for the first subterm of t with functor '^' and return
its exponent in *ans with return value 0; or if there is no
subterm of t with functor '^', return 1. */
{ int i,err;
unsigned short n;
if(FUNCTOR(t) == '^')
{ *ans = ARG(1,t);
return 0;
}
if(ATOMIC(t))
return 1;
n = ARITY(t);
for(i=0;i<n;i++)
{ err = firstpowerin(ARG(i,t),ans);
if(!err) return 0;
}
return 1;
}
/*_______________________________________________________________________*/
static int whatroot(term sofar, term *candidate)
/* auxiliary used by autosub below */
/* sofar is a substitution that is too good: the original expression
is linear in sofar. So we need to take a root of sofar: but what
root? *candidate will tell. *candidate should not be negative
at exit from this function; it's only useful if it's even or
divisible by 3. */
/* zero return is success, 1 is failure */
{ term a,b;
int i;
switch(FUNCTOR(sofar))
{ case '*' :
for(i=0;i<ARITY(sofar);i++)
{ if(FUNCTOR(ARG(i,sofar))=='^')
{ *candidate = ARG(1,ARG(i,sofar));
break;
}
}
return i==ARITY(sofar) ? 1 : 0;
case '-' :
return whatroot(ARG(0,sofar),candidate);
case '^' :
*candidate = ARG(1,sofar);
if(FUNCTOR(*candidate) == '-')
*candidate = ARG(0, *candidate);
return 0;
case '/' :
if(constant(ARG(0,sofar)))
return whatroot(ARG(1,sofar),candidate);
if(constant(ARG(1,sofar)))
return whatroot(ARG(0,sofar),candidate);
whatroot(ARG(0,sofar),&a);
whatroot(ARG(0,sofar),&b);
if(ISINTEGER(a) && ISINTEGER(b))
{ long ma = INTDATA(a);
long mb = INTDATA(b);
if(!(ma&1) && !(mb&1)) /* both even */
{ *candidate = two;
return 0;
}
if ( (ma % 3) == 0 && (mb % 3) == 0) /* both divisible by 3 */
{ *candidate = three;
return 0;
}
else
return 1;
}
}
return 1;
}
/*_______________________________________________________________________*/
MEXPORT_ALGEBRA int autosub(term t, term *sub, term *ans)
/* "computer makes a substitution" on the menus calls either
invisiblesub or makesubstitution, depending on the global variable
substitutionflag. Either one calls autosub to determine what
substitution to make.
*/
/* We say u is a component of t if t = f(u) for some f (where f = identity
and f=t don't count). This function endeavors to find the maximal component
of t, and return it in ARG(1,*sub). In general this is a difficult
problem; only special cases can be handled. (Here t=f(u) means equals,
taking ring, exponent, and logarithm laws into account.)
It returns sub in the form u = expr, and *ans as t written as a function
of u, with occurrences of u colored yellow. The new variables are put
into varlist, but the definition is NOT entered via 'let'; that should be
done if desired by the calling function.
It can also return a double substitution, in the form
AND(u,v) = AND(expr1,expr2) that 'let' requires.
*/
/* autosub finds the following kinds of substitutions:
e^(ix) in e^(ix) + e(-ix)
x^n in a polynomial containing only exponents which are multiples of n
Examples: given x^2y^2 -1, it finds u=xy;
x^4y^4 + 2x^2y^2 + 1, u = x^2y^2
x^4y^4-1, u = x^2y^2
e^(2ix) -1, u = e^(ix)
4x^4 + 2x^2 + 1, u = 2x^2
similarly with numbers in any of the above examples
x^9 - y^6 , u = x^3
x^3 - y^6, u = y^2 (not y^3, this is tricky!)
x^6 -x^3y^3 + y6, u,v = x^3,y^3 (double substitution)
Example: it will handle (y-1)^2 + 3(y^2-1) + 2(y+1)^2
specially, finding (u,v)= (y-1,y+1) using adhoc_autosub.
Without adhoc_autosub it wouldn't ever introduce 2 new
variables where there was only one.
*/
{ return autosub2(1,t,sub,ans);
}
/*__________________________________________________________________________*/
static int autosub2(int flag,term t, term *sub, term *ans)
/* Do the work of autosub as documented above. If flag is nonzero,
make a recursive call with flag == 0. If flag is zero, don't make
the recursive call; this stops an infinite regression of calls to
autosub. */
{ term sofar,temp;
int err,natoms;
term *atomlist;
int saveit = get_nvariables();
short savenextassumption = get_nextassumption();
term sub2;
term newvar;
int i;
/* try to eliminate a variable or variables by a substitution */
if(saveit == 0)
return 1; /* fail immediately, no variables to eliminate */
SETFUNCTOR(sofar,ILLEGAL,0); /* starting value for autosub_aux */
err = autosub_aux(t,t,&sofar);
if(err)
{ sofar = get_gcdsub(t,get_eigenvariable());
/* finds u = x^(1/6) in f(sqrt(u), root(3,u)) for example */
if(equals(sofar,zero))
err = 1;
else
err = 0;
}
if(!err && !ATOMIC(sofar))
{ err = testsub(t,sofar,ans,&newvar);
if(err) /* failure */
{ set_nvariables(saveit);
set_nextassumption(savenextassumption);
/* get rid of variable introduced by testsub */
return 1;
}
}
else
{ /* we get here if autosub_aux and get_gcdsub both failed.
For example, we get here
on (x+y)^2 + 3x + 3y + 2, where we want to find u=x+y */
if(FUNCTOR(t) == '+' && FUNCTOR(ARG(0,t)) == '^' &&
FUNCTOR(ARG(0,ARG(0,t))) == '+'
)
{ sofar = ARG(0,ARG(0,t));
err = testsub(t,sofar,ans,&newvar);
if(!err)
goto out;
}
err = maximal_sub(t,&sofar);
if(!err)
{ err = testsub(t,sofar,ans,&newvar);
if(!err)
goto out;
}
set_nvariables(saveit);
set_nextassumption(savenextassumption);
/* trap 3(y+1)^2 +11(y^2-1) -4(y-1)^2 and similar examples,
producing u = y+1, v = y-1 */
err = adhoc_autosub(t,sub,ans);
if(!err)
return 0;
set_nvariables(saveit);
set_nextassumption(savenextassumption);
return 1; /* give up and fail */
}
out: /* sweet success */
*sub = equation(newvar,sofar);
natoms = atomsin(*ans,&atomlist);
free2(atomlist);
if(FUNCTOR(*ans) == '=' &&
(equals(newvar,ARG(0,*ans)) && !contains(ARG(1,*ans),FUNCTOR(newvar)))
)
/* don't choose u = the whole left side of an equation when the
right side is constant. */
{ set_nvariables(saveit);
set_nextassumption(savenextassumption);
return 1;
}
if(natoms > 1 && flag) /* there are still variables besides newvar */
{ temp = *ans; /* we get here with x^6 + x^3y^3 + y^6 for example */
err = autosub2(0,temp,&sub2,ans); /* pass 0 to stop an infinite regression */
if(err)
{ *ans = temp;
return 0;
}
else
{ int nextdefn = get_nextdefn();
temp = *sub;
*sub = equation(and(ARG(0,*sub),ARG(0,sub2)),and(ARG(1,*sub),ARG(1,sub2)));
/* but test if this has already been tried once! */
for(i=0;i<nextdefn;i++)
{ if(equals(ARG(1,*sub),get_defn(i).right))
{ set_nvariables(saveit);
set_nextassumption(savenextassumption);
return 1; /* give up */
}
}
return 0;
}
}
return 0;
}
/*________________________________________________________________________*/
static int testsub(term t, term sofar, term *ans, term *newvar)
/* test the candidate substitution u = sofar to see if it will
do for the result of autosub on t. If so, invent a new variable,
return it in *newvar, and return the result of substituting
newvar in t in *ans. Return 0 for success, 1 for failure,
2 in case there are too many variables to create a new one.
*/
/* autosub_aux can return wrong results in two ways: either
the result can be linear in the new variable, as in x^4 -1,
where we get u = x^4, or it can pass by an initial occurrence of
an atom, as in x-x^4, returning u=x^2
We also use testsub to reject u = sqrt(linear(x)) when
t contains another sqrt(linear(x)), e.g. we don't substitute
u = sqrt x if t also contains sqrt(x+1).
*/
{ int i,err,nextdefn,problemtype;
term u,temp,candidate;
int natoms;
term *atomlist;
int saveit = get_nvariables();
short savenextassumption = get_nextassumption();
int saveeigen = get_eigenindex();
char data[2] = "a"; /* just to get a[1] = '\0' */
if(equals(t,sofar))
return 1; /* quickly */
if(get_mathmode() == AUTOMODE) /* don't repeat an old attempt */
{ nextdefn = get_nextdefn();
problemtype = get_problemtype();
for(i=0;i<nextdefn;i++)
{ u = get_defn(i).right;
if(equals(sofar,u) && SOLVETYPE(problemtype))
return 1; /* fail */
/* but in limits and integrals, we sometimes NEED
to use the same substitution twice, in different
limits or integrals that arose from the original
problem. E.g. lim(x->0,sin(2x)/(2x)) can arise twice
and you need u = 2x to solve it both times.
*/
}
}
if(get_mathmode() == AUTOMODE && get_substitutionflag() == INVISIBLESUBS)
{ data[0] = MU; /* very unlikely user will later choose 'mu'
and get a confusing 'variable already in use' message */
*newvar = getnewvar(t, data);
if(FUNCTOR(*newvar) == ILLEGAL)
return 2;
}
else
{ *newvar = getnewvar(t,"uvwpqstzxy");
if(FUNCTOR(*newvar) == ILLEGAL)
return 2;
}
HIGHLIGHT(*newvar);
if((FUNCTOR(sofar) == SQRT || (FUNCTOR(sofar) == '^' && RATIONALP(ARG(1,sofar)))) &&
get_mathmode() == AUTOMODE &&
block_sqrtsub(t,sofar)
)
{ set_eigenvariable(saveeigen);
set_nvariables(saveit); /* get rid of the result of getnewvar */
set_nextassumption(savenextassumption);
return 1;
}
err = psubst(*newvar,sofar,t,ans);
if(err <= 1) /* failure, or fractional exponent required */
{ set_eigenvariable(saveeigen);
set_nvariables(saveit); /* get rid of the result of getnewvar */
set_nextassumption(savenextassumption);
return 1;
}
natoms = atomsin(sofar,&atomlist);
/* *ans better not contain any atoms in atomlist; does it? */
for(i=0;i<natoms;i++)
{ if(contains(*ans,FUNCTOR(atomlist[i])))
{ set_eigenvariable(saveeigen);
set_nvariables(saveit);
set_nextassumption(savenextassumption);
return 1;
}
}
/* ok, the variables were eliminated properly */
free2(atomlist);
problemtype = get_problemtype();
if(problemtype == DIFFERENTIATE_FROM_DEFN ||
problemtype == LIMITS ||
problemtype == LHOPITAL
)
return 0; /* this has been called from changelimitvariable,
and a linear change of variable is OK, indeed
needed to complete d/dx ln x from defn */
if(get_mathmode() != AUTOMODE)
return 0;
/* now check that *ans isn't linear in newvar */
if(eqlinear(*ans,*newvar))
{ /* take a root of sofar; what root? */
err = whatroot(sofar,&candidate);
if(err)
{ set_eigenvariable(saveeigen);
set_nvariables(saveit);
set_nextassumption(savenextassumption);
return 1;
}
if(ISINTEGER(candidate))
{ long m = INTDATA(candidate);
if(!(m % 6)) /* m divisible by 6 */
/* example: x^2-y^6 and x^3-y^6 */
/* where sofar = y^6 */
/* So do we want the sqrt or the cube root? */
/* Find out by looking for exponents in *ans */
{ err = firstpowerin(t,&temp);
if(err)
m = 2;
else if(!ISINTEGER(temp))
return 1;
else
m = INTDATA(temp);
/* and continue */
}
if(!(m&1) ) /* m is even */
err = sqrt_aux(sofar,&temp);
else
{ if((m % 3) != 0 ) /* m not a multiple of 3 */
return 1; /* can't do anything useful */
err = nthroot_aux(sofar,three,&temp);
}
if(err || ATOMIC(temp))
{ set_eigenvariable(saveeigen);
set_nvariables(saveit);
return 1;
}
sofar = temp;
psubst(*newvar,sofar,t,ans);
}
else
{ set_eigenvariable(saveeigen);
set_nvariables(saveit);
set_nextassumption(savenextassumption);
return 1;
}
}
return 0;
}
/*________________________________________________________________________*/
static int eqlinear(term t, term x)
/* is t linear in atom x ? If so return 1, if not return 0 */
{ int i,flag;
unsigned short n;
unsigned short f = FUNCTOR(t);
if(ATOMIC(t))
return 1;
if(f == '+' || INEQUALITY(f))
{ n = ARITY(t);
for(i=0;i<n;i++)
{ if (!eqlinear(ARG(i,t),x))
return 0;
}
return 1;
}
if(f == '*')
{ n = ARITY(t);
flag = 0;
for(i=0;i<n;i++)
{ if(contains(ARG(i,t),FUNCTOR(x))) /* skip constant factors */
{ if(flag==0 && eqlinear(ARG(i,t),x))
flag = 1; /* and continue */
else
return 1; /* second factor containing x, it's not linear */
}
}
}
if(f == '-')
return eqlinear(ARG(0,t),x);
if(f == '/' && !contains(ARG(1,t),FUNCTOR(x)) )
return eqlinear(ARG(0,t),x);
if(contains(t,FUNCTOR(x)))
return 0;
else return 1;
}
/*______________________________________________________________________*/
static int complicated(term t)
/* t is a fraction. Return 1 if its num and denom are both
nonconstant and one or the other contains a sum. This is used
in the next function, fractionalsubstitution. */
{ term num,denom;
assert(FUNCTOR(t) == '/');
num = ARG(0,t);
denom = ARG(1,t);
if(econstant(num))
return 0;
if(econstant(denom))
return 0;
if(contains(num,'+'))
return 1;
if(contains(denom,'+'))
return 1;
return 0;
}
/*______________________________________________________________________*/
static int select_fs_arg2(term t, term *ans)
/* an auxiliary used below to find a substitution like sqrt(x-2)/x in
3 sqrt(x-2)/x + x/sqrt(x-2) = 4. t is passed in as an equation,
which is known to contain sqrts in terms with other nonconstant terms.
*ans should come out sqrt(x-2)/x in this example.
Return 0 for success.
*/
{ unsigned short f = FUNCTOR(t);
unsigned short n = ARITY(t);
term c;
int i,err;
if(f == '/')
{ if(
(contains_sqrt(ARG(0,t)) || contains_sqrt(ARG(1,t))) &&
!econstant(ARG(0,t)) &&
!econstant(ARG(1,t))
)
{ ratpart2(t,&c,ans);
return 0;
}
else
return 1;
}
if(ATOMIC(t))
return 1;
for(i=0;i<n;i++)
{ err = select_fs_arg2(ARG(i,t),ans);
if(!err)
return 0;
}
return 1;
}
/*______________________________________________________________________*/
static int select_fs_arg(term t, term *ans)
/* an auxiliary used by the next operator. If t is a SQRT or ROOT
or a term containing a non-constant ROOT or SQRT,
return the SQRT or ROOT term in *ans, returning 0 for success.
Nonzero return is failure. 1 means no non-constant ROOT or SQRT;
2 means two such terms with different, non-reciprocal arguments.
*/
{ unsigned short f = FUNCTOR(t);
unsigned short n = ARITY(t);
unsigned short k;
int i,err;
long index;
term workspace,u,v,arg;
if(f == SQRT && !econstant(ARG(0,t)))
{ *ans = t;
return 0;
}
if(f == ROOT && !econstant(ARG(1,t)))
{ *ans = t;
return 0;
}
if(ATOMIC(t))
return 1;
workspace = make_term(AND,n);
k = 0;
for(i=0;i<n;i++)
{ err = select_fs_arg(ARG(i,t),ARGPTR(workspace)+k);
if(err == 2)
return 2; /* failure */
if(!err)
++k;
}
if(k == 0)
{ RELEASE(workspace);
return 1;
}
if(k == 1)
{ *ans = ARG(0,workspace);
RELEASE(workspace);
return 0;
}
SETFUNCTOR(workspace,AND,k);
u = ARG(0,workspace);
assert(FUNCTOR(u) == ROOT || FUNCTOR(u) == SQRT);
arg = FUNCTOR(u) == ROOT ? ARG(1,u) : ARG(0,u);
index = FUNCTOR(u) == ROOT ? INTDATA(ARG(0,u)) : 2;
for(i=1;i<k;i++)
{ u = ARG(i,workspace);
assert(FUNCTOR(u) == ROOT || FUNCTOR(u) == SQRT);
v = FUNCTOR(u) == SQRT ? ARG(0,u) : ARG(1,u);
if(!equals(v,arg))
{ if(FRACTION(arg) && FRACTION(v)
&& equals(ARG(0,arg),ARG(1,v)) && equals(ARG(1,arg),ARG(0,v))
)
; /* v and arg are reciprocals, this is OK, so do nothing */
/* example: �(x/a) + �(a/x), we must find u = �(x/a) */
else
return 2;
}
if(FUNCTOR(u) == ROOT && !ISINTEGER(ARG(0,u)))
return 1;
if(FUNCTOR(u) == SQRT)
continue;
if(INTDATA(ARG(0,u)) > index)
index = INTDATA(ARG(0,u));
}
if(index==2)
{ *ans = sqrt1(arg);
return 0;
}
*ans = make_root(make_int(index),arg);
return 0;
}
/*______________________________________________________________________*/
static int contains_two_rootfracts(term t)
/* count the number of fractions in t which contain sqrt, root, or abs */
/* here 'in' means, as summands in an equation or sum t, or possibly
a monomial in the fraction occurs as such a summand.
*/
{ unsigned short f = FUNCTOR(t);
int i,ans;
unsigned short n;
term c,s;
if(ATOMIC(t) || econstant(t))
return 0;
if(f == '/')
{ if(contains_sqrt(ARG(0,t)) && !econstant(ARG(1,t)))
return 1;
if(contains_sqrt(ARG(1,t)) && !econstant(ARG(0,t)))
return 1;
return 0;
}
if(f == '-')
return contains_two_rootfracts(ARG(0,t));
if(f == '*' && contains(t, '/'))
{ ratpart2(t,&c,&s);
if(!ONE(c))
return contains_two_rootfracts(s);
else
return 0;
}
if(f == '^' && econstant(ARG(1,t)))
return contains_two_rootfracts(ARG(0,t));
if(f == '=')
return contains_two_rootfracts(ARG(0,t)) + contains_two_rootfracts(ARG(1,t));
if(f == '+')
{ ans = 0;
n = ARITY(t);
for(i=0;i<n;i++)
ans += contains_two_rootfracts(ARG(i,t));
return ans;
}
return 0;
}
/*______________________________________________________________________*/
static int already_tried(term s)
/* return 1 if s has already been used as the right-side of a let_defn;
0 if not */
{ int i;
int nextdefn = get_nextdefn();
for(i=0;i<nextdefn;i++)
{ if(equals(s,get_defn(i).right))
return 1;
}
return 0;
}
/*______________________________________________________________________*/
MEXPORT_ALGEBRA int gcdsubstitution(term t, term arg, term *next, char *reason)
/* substitute u = gcd of powers of x in the equation */
{ int err,saveit,saveeigen,nextdefn,savenextdefn,i;
short savenextassumption;
unsigned short f = FUNCTOR(t);
term u,s,newarg,x;
int mathmode;
if(!INEQUALITY(f))
return 1;
saveit = get_nvariables();
savenextassumption = get_nextassumption();
saveeigen = get_eigenindex();
savenextdefn = get_nextdefn();
x = get_eigenvariable();
s = get_gcdsub(t,x);
if(equals(s,zero) || equals(s,x))
return 1; /* failure */
mathmode = get_mathmode();
if(mathmode == AUTOMODE &&
FUNCTOR(s) == '^' && INTEGERP(ARG(1,s)) && equals(ARG(0,s),x)
)
return 1; /* don't change x^2-9 = 0 to u-9=0, u = x^2, in automode */
/* This definition might already have been used on one equation or
inequality, and if so we don't want to introduce a second letter. */
nextdefn = get_nextdefn();
for(i=0;i<nextdefn;i++)
{ if(equals(s,get_defn(i).right))
{ u = get_defn(i).left;
break;
}
}
if(i==nextdefn) /* not used before */
{ u = getnewvar(t,"uvwpqst");
if(FUNCTOR(u) == ILLEGAL)
return 2; /* too many variables */
}
newarg = equation(u,s);
if(FUNCTOR(s) == SQRT && block_sqrtsub(t,s))
err = 1;
else
err = makesubstitution(t,newarg,next,reason);
if(err ||
too_simple(*next,u,s) ||
/* don't change x^2 = 3 to u = 3 because it just has to be
unwound immediately anyway. Too_simple will get lots of
other useless cases too. */
( mathmode == AUTOMODE &&
FUNCTOR(s)== '^' && RATIONALP(ARG(1,s)) && equals(ARG(0,s),x) &&
contains_fractional_exponents(*next)
/* don't use u = x^(p/q) unless it will eliminate fractional exponents
entirely. Example, (x-1)^(1/2) -x^(1/2) = 0
becomes (u^2-1)^(1/2) - u this way which can only be unwound. */
)
)
{ /* it didn't work. */
set_eigenvariable(saveeigen);
set_nvariables(saveit); /* get rid of the new variable */
set_nextassumption(savenextassumption);
set_nextdefn(savenextdefn);
ResetShowStep();
/* because makesubstitution called SetShowStepOperation already */
return 1;
}
return 0;
}
/*______________________________________________________________________*/
MEXPORT_ALGEBRA int fractionalsubstitution(term t, term arg, term *next, char *reason)
/* used only in auto mode */
/* t is an equation. If one side of t is a fraction or a power of a
fraction, it checks whether the substitution u = that fraction will
eliminate the variable. Otherwise crossmultiply is used and we lose
our chance forever to find that substitution.
Also this must be done on equations whose sides are sums of
terms each of which is a nonconstant fraction or a constant.
Return 2 if getnewvar fails (too many variables)
*/
/* Also, if one side contains SQRT or ROOT, and there is another occurrence
of x outside the sqrt or root term, it tries
the SQRT or ROOT term, and its argument, as a possible substitution;
else powereqn or squareeqn destroys the chance.
Consider sqrt f(x) = 1 + root(4,f(x)).
We want u = root(4,f(x)), not just u =f(x).
Consider log(sqrt(x-1) + 1) + 2 log(sqrt(x-1) -2) = log 4;
We want u = sqrt(x-1), but if we simplify first we won't find it.
That's why we need contains(t,SQRT) and not just contains_monomially(t,SQRT).
But, we DON't want to substitute on sqrt x = 4; so we require there to be
nonconstant terms outside the sqrt. Thus we will substitute on
x sqrt x = 4 or on sqrt x = x+4
We reject linear substitutions, because in many examples using a linear
substitution blocks a simpler solution.
*/
/* Also, if one side contains an integer raised to a nonconstant power,
e.g. 2^x, and there is another occurrence of x outside that term,
it tries u = 2^x as a possible substitution, otherwise
introducelninexponent destroys the chance. Example,
4^x - 6 2^x = -8, we want to find u = 2^x.
*/
{ term left,right,u,v;
int i,err,k;
int flag = 0; /* set when c and s are determined */
int saveit,saveeigen,savenextdefn;
short savenextassumption;
term c,s,newarg,x,temp;
unsigned short f = FUNCTOR(t);
if(!INEQUALITY(f))
return 1;
saveit = get_nvariables();
savenextassumption = get_nextassumption();
saveeigen = get_eigenindex();
savenextdefn = get_nextdefn();
x = get_eigenvariable();
left = ARG(0,t);
right = ARG(1,t);
if(econstant(right))
{ if(FUNCTOR(left) != '+')
return 1;
/* example: f(x)/x + 3x/f(x) + 2 = 0, polynomial f */
k = 0;
for(i=0;i<ARITY(left);i++)
{ if(econstant(ARG(i,left)))
continue;
if(k == 0)
{ temp = ARG(i,left);
k = 1;
}
else
{ right = ARG(i,left);
k = 2;
break;
}
}
if(k < 2)
return 1;
left = temp;
}
else if(econstant(left))
{ if(FUNCTOR(right) != '+')
return 1;
k = 0;
for(i=0;i<ARITY(right);i++)
{ if(econstant(ARG(i,right)))
continue;
if(k == 0)
{ temp = ARG(i,right);
k = 1;
}
else
{ left = ARG(i,right);
k = 2;
break;
}
}
if(k < 2)
return 1;
right = temp;
}
if(exponential_sub(t,x,&s) > 1 && !already_tried(s))
{ u = getnewvar(t,"uvwpqst");
if(FUNCTOR(u) == ILLEGAL)
return 2; /* too many variables already */
newarg = equation(u,s);
err = makesubstitution(t,newarg,next,reason);
if(!err)
return 0;
/* well, that didn't work. */
set_eigenvariable(saveeigen);
set_nvariables(saveit); /* get rid of the new variable */
set_nextassumption(savenextassumption);
set_nextdefn(savenextdefn);
/* but don't give up and return */
}
if(!analyze_roots(t))
/* is there a nonconstant SQRT or ROOT with other nonconstant terms
outside the ROOT or SQRT ? */
{ if(contains_two_rootfracts(t) >= 2)
{ err = select_fs_arg2(t,&s);
if(FUNCTOR(s) == SQRT && block_sqrtsub(t,s))
err = 1;
if(!err && !already_tried(s))
{ u = getnewvar(t,"uvwpqst");
if(FUNCTOR(u) == ILLEGAL)
return 2; /* too many variables already */
newarg = equation(u,s);
err = makesubstitution(t,newarg,next,reason);
if(!err)
{ if(better_by_comdenom(t,x))
{ set_eigenvariable(saveeigen);
set_nvariables(saveit); /* get rid of the new variable */
set_nextassumption(savenextassumption);
set_nextdefn(savenextdefn);
return 1;
}
return 0;
}
/* well, that didn't work. */
set_eigenvariable(saveeigen);
set_nvariables(saveit); /* get rid of the new variable */
set_nextassumption(savenextassumption);
set_nextdefn(savenextdefn);
/* but don't give up and return */
}
}
/* Keep trying */
err = select_fs_arg(t,&s);
if(err || already_tried(s))
goto fail;
if(get_mathmode() == AUTOMODE &&
(equals(s,ARG(0,t)) || equals(s,ARG(1,t)))
)
goto fail;
u = getnewvar(t,"uvwpqst");
if(FUNCTOR(u) == ILLEGAL)
return 2; /* too many variables */
newarg = equation(u,s);
err = makesubstitution(t,newarg,next,reason);
if(!err)
return 0;
/* well, that didn't work. */
set_eigenvariable(saveeigen);
set_nvariables(saveit); /* get rid of the new variable */
set_nextassumption(savenextassumption);
set_nextdefn(savenextdefn);
if(FUNCTOR(s) == SQRT || FUNCTOR(s) == ROOT)
/* Now try again with the arg of the SQRT or ROOT term,
but not if it is linear in x */
{ v = FUNCTOR(s) == SQRT ? ARG(0,s) : ARG(1,s);
if(is_linear_in(v,get_eigenvariable()))
return 1;
ratpart2(v,&c,&s);
flag = 1;
}
else
/* without rejecting at this point
we loop on, for example, (u^2+1)/u = 1 */
return 1;
}
else if(econstant(right))
{ if(FUNCTOR(left) != '+')
return 1;
/* example: f(x)/x + 3x/f(x) + 2 = 0, polynomial f */
k = 0;
for(i=0;i<ARITY(left);i++)
{ if(econstant(ARG(i,left)))
continue;
if(k == 0)
{ temp = ARG(i,left);
k = 1;
}
else
{ right = ARG(i,left);
k = 2;
break;
}
}
if(k < 2)
return 1;
left = temp;
}
else if(econstant(left))
{ if(FUNCTOR(right) != '+')
return 1;
k = 0;
for(i=0;i<ARITY(right);i++)
{ if(econstant(ARG(i,right)))
continue;
if(k == 0)
{ temp = ARG(i,right);
k = 1;
}
else
{ left = ARG(i,right);
k = 2;
break;
}
}
if(k < 2)
return 1;
right = temp;
}
if(!flag)
{ if(SIGNEDFRACTION(left) && SIGNEDFRACTION(right) &&
signed_reciprocals(left,right)
)
{ /* try (x^2-1)/3x before going to (x^2-1)/x */
u = getnewvar(t,"uvwpqst");
if(FUNCTOR(u) == ILLEGAL)
{ set_nvariables(saveit);
set_nextassumption(savenextassumption);
return 2; /* too many variables */
}
s = NEGATIVE(left) ? ARG(0,left) : left;
newarg = equation(u,s);
err = makesubstitution(t,newarg,next,reason);
if(!err && !better_by_comdenom(t,x))
return 0;
set_eigenvariable(saveeigen);
set_nvariables(saveit);
set_nextassumption(savenextassumption);
set_nextdefn(savenextdefn);
if(!err)
ResetShowStep();
/* well, it didn't work, so proceed */
}
if(FRACTION(left) && complicated(left))
/* don't use this e.g. on 11 x / 30 */
ratpart2(left,&c,&s);
else if(FRACTION(right) && complicated(right))
ratpart2(right,&c,&s);
else if(FUNCTOR(left) == '^' && FRACTION(ARG(0,left)) &&
econstant(ARG(1,left)) &&
complicated(ARG(0,left))
)
ratpart2(ARG(0,left),&c,&s);
else if(FUNCTOR(right) == '^' && FRACTION(ARG(0,right)) &&
econstant(ARG(1,right)) &&
complicated(ARG(0,right))
)
ratpart2(ARG(0,right),&c,&s);
else
return 1;
flag = 1;
}
if(!flag)
assert(0);
if(ATOMIC(s) || already_tried(s))
return 1; /* don't just change the name of a letter! */
/* and don't repeat a substitution already tried */
u = getnewvar(t,"uvwpqst");
if(FUNCTOR(u) == ILLEGAL)
{ set_nvariables(saveit);
set_nextassumption(savenextassumption);
return 2; /* too many variables */
}
newarg = equation(u,s);
err = makesubstitution(t,newarg,next,reason);
if(!err && !better_by_comdenom(t,x))
return 0;
/* and if the substitution failed, get rid of the new variable,
which was created by getnewvar */
fail:
set_eigenvariable(saveeigen);
set_nvariables(saveit);
set_nextassumption(savenextassumption);
set_nextdefn(savenextdefn);
ResetShowStep();
return 1;
}
/*_______________________________________________________________________*/
static int analyze_roots(term t)
/* return 0 if t contains a nonconstant ROOT or SQRT and also contains other
nonconstant terms outside the first ROOT or SQRT.
Return 1 if it contains a (single) nonconstant SQRT or ROOT but
no nonconstant terms outside.
Return 2 if it is nonconstant but doesn't contain SQRT or ROOT.
Return 3 if it's constant.
In other words, the answer has bit 1 zero if there's a
nonconstant SQRT or ROOT, and bit 0 zero if there are nonconstant terms
outside the first SQRTs or ROOT (or there's no nonconstant SQRT or ROOT).
So we'll set bit 1 to zero when we meet a nonconstant root, and then
set bit 0 to zero when we meet another nonconstant term.
*/
{ unsigned short f = FUNCTOR(t);
unsigned short n = ARITY(t);
int i,err,ans;
if(ATOMIC(t))
return econstant(t) ? 3 : 2;
if(f == SQRT || f == ROOT)
{ err = analyze_roots(f==SQRT ? ARG(0,t) : ARG(1,t));
switch(err)
{ case 0: return 0;
case 1: return 1;
case 2: return 1;
case 3: return 3;
}
}
ans = 3;
for(i=0;i<n;i++)
{ err = analyze_roots(ARG(i,t));
if(ans != 3 && !(err & 2))
/* there was already a nonconstant term and now we have
a nonconstant SQRT or ROOT */
return 0;
ans &= err; /* set bits 0 or 1 to zero if they are zero in err,
i.e. if we found a SQRT or ROOT, set bit 1 to zero,
and if we found a nonconstant term (outside any sqrt
or root) set bit 0 to zero */
if(ans == 0)
break; /* no point going on */
}
return ans;
}
/*________________________________________________________________*/
static int adhoc_autosub(term t, term *sub, term *ans)
/* trap 3(y+1)^2 +11(y^2-1) -4(y-1)^2 and similar examples,
producing *sub = and(u,v) = and(y+1,y-1), and *ans 3u^2 + 11uv - 4v^2
Return 0 for success, 1 for failure, 2 for too many variables.
*/
{ term a[3];
term x[3];
term power,temp,u,v,w;
int i,j,k,m,p,err,count = 0;
unsigned short n = ARITY(t);
if(FUNCTOR(t) != '+' || !(n==3 || n==4))
return 1;
if(n==3)
{ /* rapidly check that all summands contain '+' */
for(i=0;i<3;i++)
{ if(!contains(ARG(i,t),'+'))
return 1;
}
}
if(n==4)
{ /* exactly two summands must contain '+' */
for(i=0;i<4;i++)
{ if(!contains(ARG(i,t),'+'))
++count;
if(count > 2)
return 1;
}
if(count < 2)
return 1;
}
err = 0;
p = -1;
for(i=0;i<3;i++)
{ getmonomial(ARG(i,t),&a[i],&x[i],&power);
if(!equals(power,two) || FUNCTOR(x[i]) != '+' || ARITY(x[i]) != 2)
{ if(err && n == 3)
return 1; /* two non-monomials */
if(err && n == 4)
p = i;
else
k = i; /* mark the non-monomial */
}
}
if(n==4)
{ if(p < 0)
return 1; /* only one non-monomial was found */
x[k] = sum(ARG(k,t),ARG(p,t));
a[k] = one;
}
else
ratpart2(ARG(k,t),&a[k],&x[k]);
switch(k)
{ case 0:
i = 1;
j = 2;
break;
case 1:
i = 0;
j = 2;
break;
case 2:
i = 0;
j = 1;
break;
}
polyval(sum(product(x[i],x[j]),tnegate(x[k])),&temp);
if(!ZERO(temp))
return 1;
x[k] = product(x[i],x[j]);
if(FUNCTOR(x[k])=='*')
sortargs(x[k]);
w = make_term('+',3);
for(m=0;m<3;m++)
{ if(m==k)
ARGREP(w,m,product(a[m],x[m]));
else
ARGREP(w,m, product(a[m],make_power(x[m],two)));
}
u = getnewvar(t,"uvwpqr");
if(FUNCTOR(u) == ILLEGAL)
return 2;
v = getnewvar(t,"uvwpqr");
if(FUNCTOR(v) == ILLEGAL)
return 2;
HIGHLIGHT(u);
HIGHLIGHT(v);
subst(u,x[i],w,&temp); /* NOT psubst, because then e.g. if u = y-1, v = y+1,
y+1 will become u+2 and v will not be used. */
subst(v,x[j],temp,ans);
*sub = equation(and(u,v),and(x[i],x[j]));
return 0;
}
/*_____________________________________________________________*/
static int block_aux(term t, term x)
/* return zero if some occurence of x in t is in an expression
NOT of the form sqrt(linear(x)) or linear(x)^(rational) or
sqrt(product-of-linears) or product-of-linears^(rational). Return
1 if t does not contain x or all occurrences of x are of the
forms mentioned. Here sqrt(linear(x)) means the constant term of the linear
part really occurs; e.g. sqrt(x) doesn't count.
*/
{ unsigned short f = FUNCTOR(t);
unsigned short n = ARITY(t);
unsigned short m;
int i;
term u;
if(equals(t,x))
return 0;
if(ATOMIC(t))
return 1;
if(f == SQRT || (f == '^' && RATIONALP(ARG(1,t))))
{ u = ARG(0,t);
if(FUNCTOR(u) == '*')
{ m = ARITY(u);
for(i=0;i<m;i++)
{ if(!contains(ARG(i,u),FUNCTOR(x)))
continue;
if(equals(ARG(i,u),x))
return 0;
if(!is_linear_in(ARG(i,u),x))
return 0;
}
return 1;
}
if(equals(u,x))
return 0;
if(FUNCTOR(u) == '^' && equals(ARG(0,u),x))
return 0;
if(is_linear_in(u,x) || !contains(u,FUNCTOR(x)))
return 1;
return 0;
}
for(i=0;i<n;i++)
{ if(!block_aux(ARG(i,t),x))
return 0;
}
return 1;
}
/*_____________________________________________________________*/
static int block_sqrtsub(term t, term sofar)
/* return 1 if every occurence of x in t is in an expression
sqrt(linear(x)) or sqrt(product-of-linears(x0)
and substituting var0 for sofar in t does
not eliminate x. This is used to prevent
u = sqrt x in equations where it will just result in sqrt(u^2 + c)
which is no better than sqrt(x+c). Also do this for
powers of 1/2 instead of sqrt.
*/
{ term x = get_eigenvariable();
term temp,p;
if(!block_aux(t,x))
return 0; /* some occurrence of x is in a not in the form
sqrt(linear(x)) or sqrt(product-of-linears)
or linear(x)^rational or product-of-linears^rational
*/
subst(var0,sofar,t,&temp);
if(!contains(temp,FUNCTOR(x)))
return 0;
/* but e.g. x sqrt x is now x var0, and we don't want to block
substitutions on this. */
if(FUNCTOR(sofar) == SQRT)
{ subst(var0,sofar,temp,&p);
if(!contains_sqrtx(p,x))
return 0; /* after substituting var0 for sqrt x there were
no more sqrt(term-involving-x) */
}
return 1;
}
/*_______________________________________________________________*/
static int better_by_comdenom(term t, term x)
/* return 1 if we should NOT use fractionalsubstitution on
equation t, because it's faster by common denominators.
Example: sqrt(x-1)/sqrt(x+1) - sqrt(x+1)/sqrt(x-1) = 1.
If this is reduced to u-1/u = 1 it takes much longer,
because when put over a common denominator the numerator
simplifies to a constant. x is passed in as the eigenvariable
of t; when this is called it is no longer the official eigenvariable.
*/
{ char buffer[DIMREASONBUFFER];
int err;
unsigned short f = FUNCTOR(t);
term u,v;
if(!INEQUALITY(f))
return 0;
u = ARG(0,t);
v = ARG(1,t);
if(!contains(u,FUNCTOR(x)))
u = v;
if(FUNCTOR(u) != '+')
return 0;
err = commondenomandsimp(u,zero,&v,buffer);
if(err)
return 0;
if(!contains(v,FUNCTOR(x)))
return 1;
if(FRACTION(v) && !contains(ARG(0,v),FUNCTOR(x)))
return 1;
return 0;
}
/*_____________________________________________________________________*/
static int signed_reciprocals(term a, term b)
/* assumes a and b are SIGNEDFRACTIONS; return 1 if
after stripping off signs they are reciprocals. */
{ if(NEGATIVE(a))
a = ARG(0,a);
if(NEGATIVE(b))
b = ARG(0,b);
if(!FRACTION(a) || !FRACTION(b))
return 0;
if(equals(ARG(0,a),ARG(1,b)) && equals(ARG(1,a),ARG(0,b)))
return 1;
return 0;
}
/*_________________________________________________________________________*/
static int contains_sqrtx(term t, term x)
/* return 1 if t contains a SQRT or fractional power
which contains FUNCTOR(x) */
{ int i;
unsigned short n;
if(FUNCTOR(t) == SQRT)
return contains(ARG(0,t),FUNCTOR(x));
if(ATOMIC(t))
return 0;
n = ARITY(t);
for(i=0;i<n;i++)
{ if(contains_sqrtx(ARG(i,t),x))
return 1;
}
return 0;
}
/*__________________________________________________________________________*/
static int exponential_sub(term t, term x, term *s)
/* Look for subterms c^u where u contains x in t. Return in *s the
term c^p where p is the gcd of such u's. Example, in e^(6x) - 6e^(3x) + 5
return *s = e^(3x). Return the number of such terms; return 0 if there
is no such subterm. It is presumed x is a variable.
*/
{ int i,count,k,err,flag;
unsigned short n;
term temp,p,c,ss;
if(NEGATIVE(t))
t = ARG(0,t);
if(ATOMIC(t))
return 0;
if(FUNCTOR(t) == '*')
{ twoparts(t,x,&c,&ss);
t = ss;
}
if(FUNCTOR(t) == '^' && contains(ARG(1,t),FUNCTOR(x)))
{ *s = t;
return 1;
}
n = ARITY(t);
count = flag = 0;
for(i=0;i<n;i++)
{ k = exponential_sub(ARG(i,t),x,&temp);
count += k;
if(k && !flag)
{ *s = temp;
flag = 1;
}
else if(k)
{ if(equals(ARG(0,temp),ARG(0,*s)))
{ err = polygcd(ARG(1,temp),ARG(1,*s),&p);
if(!err && ONE(p))
return 0;
if(!err)
*s = make_power(ARG(0,*s),p);
else
*s = temp;
}
}
}
return count;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists