Sindbad~EG File Manager
/* Solve linear equations and inequalities */
/* M. Beeson, for Mathpert */
/*
7.30.93 split out of older files
1.29.98 last modified
12.8.14 corrected line 325
*/
#include <string.h>
#include <assert.h>
#include "globals.h"
#include "solvelin.h"
#include "algaux.h"
#include "prover.h"
#include "order.h"
#include "eqn.h"
#include "pvalaux.h" /*is_linear_in */
#include "simpsums.h" /* collect */
static term negate_ineq(term t);
/*____________________________________________________________________*/
int already_solved(term a, term b, term whichvar)
/* return 1 if inequality a < b is already solved for whichvar */
/* return 0 otherwise. */
/* It returns 1 if one side equals whichvar and the other doesn't
contain it; but also some other cases, including some cases in which
neither a nor b contains whichvar; so when using this, don't assume
that the left side is whichvar if it passes. */
/* see comments where it is called */
{ if(equals(a,whichvar) && !contains(b,FUNCTOR(whichvar)))
return 1; /* whichvar can be a derivative term */
if(equals(b,whichvar) && !contains(a,FUNCTOR(whichvar)))
return 1;
if(ATOMIC(a) && ! contains(b,FUNCTOR(whichvar)))
return 1; /* no change */
if(ATOMIC(b) && !contains(a,FUNCTOR(whichvar)))
return 1; /* e.g. 0 < x */
if(FUNCTOR(a) == '^' && equals(ARG(0,a),whichvar) && !contains(b,FUNCTOR(whichvar)))
return 1; /* e.g. x^2 < 0 */
if(FUNCTOR(b) == '^' && equals(ARG(0,b),whichvar) && !contains(a,FUNCTOR(whichvar)))
return 1; /* e.g. 0 < x^2 */
return 0;
}
/* We might also catch the case where the nonconstant side is
not atomic, but a product,
containing some constant terms whose signs can't be inferred.
But this would cost time and space, and come up only very rarely.
As it is, what will happen in this case is that we won't realize
the equation is already solved, so get_whichvar will be called to
try to find a variable to solve for. There must be more than one,
or we wouldn't be in that case. Then if get_whichvar succeeds, it's
because all but one are integer variables. So then solve_linear_ineq
will be called, but it won't succeed (for inequalities) because the
signs aren't known. Good, that's the best you can do. */
/*______________________________________________________________________*/
int get_whichvar(term t, term *whichvar)
/* return 0 if can identify a variable to solve for, and return that
variable in *whichvar. Else return 1 */
{ int natoms,cnt,i,err;
term *atomlist;
term ww;
natoms = atomsin(t,&atomlist);
err = derivative_subterm(t,whichvar);
if(!err)
return 0;
if(natoms==1)
{ *whichvar = atomlist[0];
return 0;
}
/* Now determine whichvar, or give up */
cnt = 0;
for(i=0;i<natoms;i++)
{ ww = type(atomlist[i],INTEGER);
if(immediate(ww) != 1 && !constant(atomlist[i]))
/* pi_term, e, complexi may be in atomlist, and if constant
shouldn't be solved for. (complexi may be not
constant if it's an index variable in a sum) */
{ RELEASE(ww);
*whichvar = atomlist[i];
++cnt;
}
}
if(cnt > 1 || (cnt == 0 && natoms > 1))
{ free2(atomlist); /* more than one non-integer non-constant var, or
none of those, and more than one integer var */
return 1; /* give up */
}
if(cnt == 0)
{ *whichvar = atomlist[0]; /* only one variable, and that an int */
free2(atomlist);
}
return 0; /* success */
}
/*____________________________________________________________________*/
static int sli_aux(unsigned f, term u, term x, term *coef, term *v)
/* if u is a product, break it apart into coef * v where the sign of
coef can be inferred (or just coef != 0 if f == '=' or NE), and
v is a product of the factors containing FUNCTOR(x) and the constant
factors of unknown sign. Return the sign of coef (\pm 1), or just 1
if f == NE or '='. In case of '=' or NE, go ahead and ASSUME the
coefficient is nonzero if you can't refute it. */
{ term n,c,s;
int err;
unsigned h = FUNCTOR(u);
assert(h== '*' || h == '/' );
if(f == '=' || f == NE)
{ twoparts(u,x,&c,&s);
/* ncs isn't enough because this has to work when we're solving
equations for a derivative term. */
err = check1(ne(c,zero));
if(!err) /* coefficient is (now at least) nonzero */
{ *v = s;
*coef = c;
return 1;
}
else
{ *coef = zero;
*v = one;
return 0; /* zero coefficient */
}
}
/* Now f is an inequality sign */
ncs(u,&n,&c,&s); /* we don't use twoparts because this never needs to
apply when solving equations for derivatives */
*coef = product(n,c);
err = infer(lessthan(zero,*coef));
if(!err)
{ *v = s;
return 1;
}
err = infer(lessthan(*coef,zero));
if(!err)
{ *v = s;
return -1;
}
err = infer(lessthan(zero,n));
if(!err)
{ *v = product(c,s);
*coef = n;
return 1;
}
err = infer(lessthan(n,zero));
if(!err)
{ *v = product(c,s);
*coef = n;
return -1;
}
*v = u;
*coef = one;
return 1;
}
/*______________________________________________________________*/
static int nonzero_sum(unsigned f,term t)
/* f is either LE, '<', or NE. Return 0 if t is a sum, all of whose
args are nonnegative, and (except in case f==LE) one of whose args
is strictly positive. Else return 1 */
/* Returns 1 if the global variable 'complex' is on. Thus when we
try to infer x^2+1 != 0, it doesn't work when complex is on. */
{ int err;
unsigned short i,n = ARITY(t);
if(get_complex())
return 1;
for(i=0;i<n;i++)
{ err = infer(le(zero,ARG(i,t)));
if(err)
return 1;
}
/* every term nonnegative */
if(f==LE)
return 0;
/* else we must find at least one positive term */
for(i=0;i<ARITY(t);i++)
{ if(constant(ARG(i,t))) /* look for a positive constant */
{ err = infer(lessthan(zero,ARG(i,t)));
if(!err)
return 0;
}
}
for(i=0;i<ARITY(t);i++)
{ if(!constant(ARG(i,t)))
{ err = infer(lessthan(zero,ARG(i,t)));
if(!err)
return 0;
}
}
return 1; /* failure */
}
/*____________________________________________________________________*/
int solve_linear_ineq(term t, term *ans)
/* if t is a linear inequality or equation
in one variable, solve it and return the
solve inequality in *ans, returning 0 for success; otherwise return 1,
with garbage in *ans. */
/* if t contains more than one variable, but only one which is not
of type INTEGER, solve for that one. */
/* If the input is already solved, that counts as failure. */
/* May also work on some terms t that are not linear, e.g.
if all the non-constant terms collect to one term u, we'll get u < c,
e.g. xy < c or x^n < c. */
/* Also returns true for inequalities 0 < a1+...+an where each ai is
nonnegative and one of them is positive; also for <= and !=. */
{ unsigned f = FUNCTOR(t);
term a,b;
int err;
term whichvar; /* the variable to solve for */
if(f != '<' && f != LE && f != '>' && f != GE && f != NE && f != '=')
return 1;
a = ARG(0,t);
b = ARG(1,t);
if(f=='>')
return solve_linear_ineq(lessthan(b,a),ans);
if(f==GE)
return solve_linear_ineq(le(b,a),ans);
if((f==NE || f == '<' || f == LE) && ZERO(a) && FUNCTOR(b)=='+') /* as in 0 != x^2 + 1 */
{ err = nonzero_sum(f,b);
if(!err)
{ *ans = trueterm;
return 0;
}
}
else if(f==NE && ZERO(b) && FUNCTOR(a) == '+')
{ err = nonzero_sum(NE,a);
if(!err)
{ *ans = trueterm;
return 0;
}
}
/* Now figure out which variable to solve for: */
err = get_whichvar(t,&whichvar);
if(err)
return 1;
if(!is_linear_in(ARG(0,t),whichvar) ||
!is_linear_in(ARG(1,t),whichvar)
)
return 1;
return solve_linear_ineq_for(t,whichvar,ans);
}
/*___________________________________________________________________*/
int solve_linear_ineq_for(term t, term whichvar, term *ans)
/* solve linear inequality or equation t for the specified variable whichvar,
if possible. Return 0 for success, 1 for error, with the answer in *ans.
If the input is already solved, return 1 (that counts as failure);
but put *ans = t in any case, so this can be called without checking its
return value if the input is known to be linear.
The answer is an equation or inequality.
*/
{ unsigned short m;
unsigned short f = FUNCTOR(t);
term u,v,w,q,a,b,coef,constantterm,temp,aa,bb;
int r,i,j,sign,side1,side2,err;
int savecomdenomflag;
a = ARG(0,t);
b = ARG(1,t);
if(!INEQUALITY(f))
return 1;
if(FUNCTOR(a) == '*' && ARITY(a) == 2 && (FUNCTOR(ARG(0,a)) == '+' || FUNCTOR(ARG(1,a)) == '+'))
{ if(FUNCTOR(ARG(0,a)) == '+')
aa = product(ARG(1,a),ARG(0,a));
else
aa = a;
plain_distriblaw(aa,&a);
}
if(FUNCTOR(b) == '*' && ARITY(b) == 2 && (FUNCTOR(ARG(0,b)) == '+' || FUNCTOR(ARG(1,b)) == '+'))
{ if(FUNCTOR(ARG(0,b)) == '+')
bb = product(ARG(1,b),ARG(0,b));
else
bb = b;
if(FUNCTOR(bb) == '*')
plain_distriblaw(bb,&b);
}
/* Consider x < pi - n pi; after this is produced by the code below,
lpt applies polyval, which produces x < (1-n) pi. If we don't
recognize that this is already solved, then we loop. Therefore,
the following code recognizes that an inequality is already solved: */
if(already_solved(a,b,whichvar))
{ *ans = t;
return 1;
}
if(!contains(t,FUNCTOR(whichvar)))
{ *ans = t;
return 1;
}
if(!contains(b,FUNCTOR(whichvar)) &&
contains(a,FUNCTOR(whichvar)) &&
FUNCTOR(a) != '*' && FUNCTOR(a) != '-' &&
FUNCTOR(a) != '/' && FUNCTOR(a) != '+'
)
return 1; /* example: f(x) < 1 */
if(!contains(a,FUNCTOR(whichvar)) &&
contains(b,FUNCTOR(whichvar)) &&
FUNCTOR(b) != '*' && FUNCTOR(b) != '-' &&
FUNCTOR(b) != '/' && FUNCTOR(b) != '+'
)
return 1; /* example: 1 < f(x) */
/* reduce to form 0 f ... */
if(equals(b,zero))
u = (f == '=' || f == NE) ? a : strongnegate(a);
else if(equals(a,zero))
u = b;
else
{ v = sum(b,strongnegate(a));
savecomdenomflag = get_polyvalcomdenomflag();
set_polyvalcomdenomflag(1);
r = polyval(v,&u);
set_polyvalcomdenomflag(savecomdenomflag);
if(r)
u = v;
/* u can be for example of the form x \pm b ; but with several summands b
as e.g. pi and n pi do not get combined by polyval */
}
if(NEGATIVE(u) && (f == '=' || f == NE))
u = ARG(0,u);
else if(NEGATIVE(u)) /* && f is < or LE */
{ temp = make_term(f,2);
ARGREP(temp,0,zero);
ARGREP(temp,1,u);
/* to solve 0 < -v, solve 0 <= v and then negate */
err = solve_linear_ineq_for(negate_ineq(temp),whichvar,ans);
if(err)
return 1;
*ans = negate_ineq(*ans);
return 0;
}
if(!is_linear_in(u,whichvar))
return 1; /* this operator only does linear inequalities and equations */
if(FUNCTOR(u) == '/' && (f == '=' || f == NE || obviously_positive(ARG(1,u))))
u = ARG(0,u); /* since polyval used common denoms, this often happens */
temp = make_term(f,2);
if(FUNCTOR(u) == '*')
{ sign = sli_aux(f,u,whichvar,&coef,&v);
if(equals(u,v))
return 1; /* stop a possible loop in case there's a factor whose
sign can't be determined. */
if(f=='=' || f == NE)
{ ARGREP(temp,0,v);
ARGREP(temp,1,zero);
if(equals(v,whichvar))
{ *ans = temp;
return 0;
}
else
return solve_linear_ineq_for(temp,whichvar,ans);
}
if(sign > 0)
{ ARGREP(temp,0,zero);
ARGREP(temp,1,v);
if(equals(v,whichvar))
{ *ans = temp;
return 0;
}
else
return solve_linear_ineq_for(temp,whichvar,ans);
}
ARGREP(temp,1,zero);
ARGREP(temp,0,v);
if(equals(v,whichvar))
{ *ans = temp;
return 0;
}
return solve_linear_ineq_for(temp,whichvar,ans);
}
if(FUNCTOR(u) != '+')
return 1;
*ans = temp;
m = ARITY(u);
/* Count the nonconstant terms */
j = 0;
for(i=0;i<m;i++)
{ if(contains(ARG(i,u),FUNCTOR(whichvar)))
++j;
}
if(j > 1)
{ /* two or more nonconstant terms */
err = collect(u,&q);
if(err)
return 1;
u = q;
}
j = -1;
for(i=0;i<m;i++)
{ if(contains(ARG(i,u),FUNCTOR(whichvar)))
{ if(j>=0)
return 1; /* two or more non-constant terms in u */
j = i; /* mark location of non-constant term */
}
}
if(j == -1) /* whichvar cancelled out entirely */
{ constantterm = u;
if(f == '=')
*ans = equation(u,zero);
else if(f == NE)
*ans = ne(u,zero);
else
{ *ans = make_term(f,2);
ARGREP(*ans,0, constantterm);
ARGREP(*ans,1, zero);
}
return 0;
}
/* Now all terms except the j-th are constant */
v = ARG(j,u); /* the non-constant term */
if(m==2)
constantterm = ARG((j ? 0 : 1), u);
else
{ constantterm = make_term('+',(unsigned short)(m-1));
for(i=0;i<j;i++)
ARGREP(constantterm,i,ARG(i,u));
for(i=j;i<m-1;i++)
ARGREP(constantterm,i,ARG(i+1,u));
}
/* Now u = v + constantterm */
if(FUNCTOR(v) == '*' || FUNCTOR(v) == '/')
sign = sli_aux(f,v,whichvar,&coef,&a);
else if(NEGATIVE(v) && FUNCTOR(ARG(0,v)) == '*')
{ sign = sli_aux(f,ARG(0,v),whichvar,&coef,&a);
coef = tnegate(coef);
if(f != NE && f != '=')
sign *= -1;
}
else if(NEGATIVE(v))
{ a = ARG(0,v);
coef = minusone;
sign = -1;
}
else
{ a = v;
coef = one;
sign = 1;
}
/* 0 f (coef * a + constantterm) */
/* Now create a f constantterm/-coef, if sign < 0, or
constantterm/-coef f a (if sign > 0)
but with the quotient simplified
*/
side1 = ((f == '=' || f == NE || sign < 0) ? 0 : 1);
side2 = (side1 ? 0 : 1);
ARGREP(*ans,side1,a);
if(equals(coef,minusone))
{ polyval(constantterm,&w);
ARGREP(*ans,side2,w);
if(equals(*ans,t))
return 1;
}
else if(ONE(coef))
{ polyval(strongnegate(constantterm),&w);
ARGREP(*ans,side2,w);
if(equals(*ans,t))
return 1;
}
else
{ polyval(tnegate(signedfraction(constantterm,coef)),&w);
ARGREP(*ans,side2,w);
if(equals(*ans,t))
return 1;
}
if(equals(a,whichvar))
{ SET_ALREADY(*ans);
return 0;
}
return 1;
}
/*___________________________________________________________________*/
int derivative_subterm(term t, term *ans)
/* if t contains a subterm du/dx (or a higher derivative)
with u an atom or a term f(x), or a unique term y',
or an integral, return that term in *ans. Return 0 for success.
It needs to return an integral so we can solve for an integral
when integrating by parts and the original integral recurs.
*/
{ unsigned short i,n;
int err;
term u;
if(ATOMIC(t))
return 1;
if(FUNCTOR(t) == PR)
{ *ans = t;
return 0;
}
if(FUNCTOR(t) == DIFF)
{ u = ARG(0,t);
if(ATOMIC(u) ||
(ARITY(u) == 1 && !PREDEFINED_FUNCTOR(FUNCTOR(u)) && ATOMIC(ARG(0,u)))
)
{ *ans = t;
return 0;
}
}
if(FUNCTOR(t) == INTEGRAL)
{ *ans = t;
return 0;
}
n = ARITY(t);
for(i=0;i<n;i++)
{ err = derivative_subterm(ARG(i,t),ans);
if(!err)
return 0;
}
return 1;
}
/*_____________________________________________________________________*/
static term negate_ineq(term t)
/* t is an inequality (or true or falseterm). Return an inequality (or
false or true) equivalent to the negation of t. Return the answer using
< or LE. */
{ unsigned short f = FUNCTOR(t);
term a,b;
if(equals(t,falseterm))
return trueterm;
if(equals(t,trueterm))
return falseterm;
a = ARG(0,t);
b = ARG(1,t);
switch(f)
{ case '<': return le(b,a);
case LE : return lessthan(b,a);
case '>': return le(a,b);
case GE: return lessthan(a,b);
case NE: return equation(a,b);
case '=': return ne(a,b);
default: assert(0);
}
return trueterm; /* can't get here, but avoids a warning */
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists