Sindbad~EG File Manager
/* ssolve -- symbolic solving of simple equations in one step
M. Beeson
Original date 12.27.90
12.4.98 last modified
1.7.00 modified safe_solve at lines 372 and 390 and after out:
1.16.00 corrected the code after out: in safe_solve.
3.28.00 added checksolutionsflag code to safe_solve
7.14.05 corrected safe_solve where temp2 is set; formerly it treated inequalities as equations
Corrected calls to save_and_reset and to heapmax in safe_solve so terms set in loopcheck
are not destroyed.
1.19.06 modified ssolve where it changes NE to =, so it fails if it makes assumptions solving the equation.
1.21.06 changed 'temp' to 'equation(temp,0)' at the dated line.
*/
#define AUTOMODE_DLL
#include <string.h>
#include <math.h>
#include "globals.h"
#include "graphstr.h"
#include "display.h"
#include "document.h"
#include <assert.h>
#include "ops.h"
#include "operator.h"
#include "probtype.h"
#include "order.h"
#include "factor.h"
#include "simpprod.h"
#include "simpsums.h"
#include "algaux.h"
#include "advfact.h"
#include "eqn.h"
#include "checkarg.h"
#include "automode.h"
#include "prover.h" /* interval_as_and */
#include "mpmem.h"
#include "deval.h"
#include "trigtran.h" /* trig_suppress_factoring */
#include "display1.h"
#include "symbols.h"
#include "cflags.h" /* inq_display_on() etc. */
#include "errbuf.h"
#include "autosimp.h" /* get_pathlength, get_path */
#include "nextline.h" /* strip_multiplicities */
#include "cancel.h" /* naive_listgcd */
#include "tdefn.h"
#include "solvelin.h"
#include "trig.h"
#include "pvalaux.h" /* obviously_positive */
#include "algaux.h" /* set_noassumptions, get_noassumptions */
static void checksolutions(term, term *);
static void check_numerically(term,term,term *);
static int safe_solve(int depthflag, term u, term *ans);
static int loopcheck(term t);
static int npast;
static void set_polyval(int flag);
#define NSOLVEOPS 20
/* 20 is more operators than pre_equation can possibly generate */
#define MAXDEPTH 30 /* maximum recursion depth in ssolve. */
#define LOOPLIMIT 10 /* loop-checking depth in ssolve. */
/* This is used to stop loops, which may well exist between the
various rules for applying different operations. */
/*___________________________________________________________________*/
/* These are the operators pre-associated to inequalities */
#define NINEQ 5
actualop ineq_preops[NINEQ] =
{ cancelterm,
fractionalsubstitution,
crossmultiply,
transferineq,
transferstrictineq,
};
/*___________________________________________________________________*/
MEXPORT_AUTOMODE int ssolve(term u, term x, term *ans)
/* Do the best Mathpert can to solve an equation, inequality,
or disjunction of equations or inequalities in one step.
u is an equation; x is the variable (or term) to be solved for;
*ans is where to write the answer.
The input from non-recursive calls is assumed to be of one of the above forms.
However, recursive calls also can generate an interval (as an AND term)
as an input.
The form of the answer (in case of complete success) is one of the following:
(1) an equation x = c or an inequality x < c, x � c, c < x, or c � x
(2) an interval, represented as an AND term of arity 2
(3) an OR of such equations, inequalities, or intervals
(4) 'true', 'false' or any proposition not containing x,
in degenerate cases. False means the equation
has no solution; 'true' means it is an identity. If you
ask, for example, to solve z=0 for x you will get *ans = (z=0).
In case of partial success only, there may also appear in the OR some
arbitrary (unsolved) equations or inequalities. In case the return
value is 2, *ans can be garbage.
The return value is
0 if the equation could be solved (including the answers 'true' or 'false')
1 if it could be partially solved, in which case some of the
terms in *ans are still-unsolved equations, but NOT if new variables
introduced by substitution are involved in the partial solutions;
the answer must involve only the original variables (and possibly
integer variables introduced by solving trig equations)
2 if not even one solution could be found, or if the partial solutions involve
an extra variable (introduced by substitution; integer variables introduced
by solving trig equations are OK).
Note: if u is an already-solved equation, this function succeeds with *ans = u.
This function assumes that the expressions in the equation are all guaranteed
defined by the current assumptions, so it doesn't hesitate, for example,
to multiply by denominators. If this is not the case, as in minmax
problems where we work on the equation f'(x) = 0, then spurious solutions
may be generated, as in x=1/4 for |4x-1|/(4x-1) = 0.
Also, certain operations may introduce
spurious solutions, such as squaring both sides. Therefore, in the end
the solutions are checked numerically. Any extra variables in the equations
have SOME value in the value list, which is used.
*/
{ int i,count,err,err2,save_stopflag;
unsigned short n;
term temp,newvar,v;
int saveeigenvariable,savenextdefn,nvariables,nvars;
short savenextassumption;
int save_problemtype = get_problemtype();
int save_currenttopic = get_currenttopic();
term *varlist;
if(equals(u,true) || equals(u,false))
{ *ans = u;
return 0;
}
if(!contains(u,FUNCTOR(x)))
return 2; /* immediately fail */
npast = 0; /* dimension of loop-checking array */
saveeigenvariable = get_eigenindex();
savenextdefn = get_nextdefn();
savenextassumption = get_nextassumption();
save_stopflag = GetCommentStop();
SetCommentStop(1); /* prevent operations from leaving comments in comment_buffer */
/* and also error messages in error_buffer */
nvariables = get_nvariables();
/* Make x the eigenvariable before calling safe_solve; the original
eigenvariable will be reset before exiting ssolve.
*/
if(FUNCTOR(u) == NE)
{ SETFUNCTOR(u,'=',2);
err = ssolve(u,x,&temp);
if(err==2)
goto out;
if(get_nextassumption() != savenextassumption)
{ err = 2;
/* assumptions made while solving a = b are just the wrong ones to make while solving a != b.
Example: sqrt(xy) != -y. We don't want to assume y <= 0 so as to square the equation.
*/
goto out;
}
if(contains(temp,MULTIPLICITY))
temp = strip_multiplicities(temp);
if(ATOMIC(temp))
{ *ans = equals(temp,true) ? false : true;
return 0;
}
if(INEQUALITY(FUNCTOR(temp)))
{ err2 = negate_eq(temp,ans);
if(err2)
return 2;
return err;
}
if(FUNCTOR(temp) == OR)
{ n = ARITY(temp);
*ans = make_term(AND,n);
/* If the conjuncts do contain existential integer variables,
at least they don't contain the SAME ones, so it is OK to
call negate_eq term by term. */
for(i=0;i<n;i++)
{ if(INEQUALITY(FUNCTOR(ARG(i,*ans))))
{ err2 = negate_eq(ARG(i,temp),ARGPTR(*ans)+i);
if(err2)
return 2;
}
else
{ RELEASE(*ans);
return 2;
}
}
return err;
}
if(FUNCTOR(temp) == '<')
{ *ans = le(ARG(1,temp),ARG(0,temp));
return 0;
}
if(FUNCTOR(temp) == LE)
{ *ans = lessthan(ARG(1,temp),ARG(0,temp));
return 0;
}
}
varlist = get_varlist();
if(ISATOM(x))
{ for(i=0;i<nvariables;i++)
{ if(equals(varlist[i],x))
{ set_eigenvariable(i);
break;
}
}
if(i == nvariables)
assert(0); /* x must be in the varlist somewhere */
if(save_problemtype == RELATED_RATES || save_problemtype == IMPLICIT_DIFF)
{ set_problemtype(SOLVE_EQUATION);
/* otherwise econstant will call every term not containing DIFF
a constant. The problemtype will be restored before exiting */
set_currenttopic(_solve_equation);
}
}
else
{ /* for example, when solving for dy/dx or an integral */
/* Substitute a new variable for the term being solved for,
and make it the eigenvariable. */
newvar = getnewvar(u,"uvwpqr");
let(newvar,x);
set_problemtype(SOLVE_EQUATION);
/* otherwise econstant looks for DIFF */
set_eigenvariable(get_nvariables()-1);
subst(newvar,x,u,&v);
u = v;
}
set_polyval(0);
err = safe_solve(0,u,ans);
set_polyval(1);
if(err == 2)
goto out;
if(!ISATOM(x))
{ subst(x,newvar,*ans,&temp);
*ans = temp;
}
varlist = get_varlist(); /* AFTER safe_solve so new variables are included */
nvars = get_nvariables();
/* Now *ans is not garbage because we handled err == 2 already */
/* check whether new variables are involved in *ans */
for(i=nvariables; i < nvars; i++)
{ if(TYPE(varlist[i]) == INTEGER)
continue; /* ignore integer variables */
if(contains(*ans,FUNCTOR(varlist[i])))
break;
}
if(i < nvars)
{ char buffer[DIMREASONBUFFER];
u = *ans;
err = unwinddefinition(u,zero,&temp,buffer);
if(!err)
{ err = ssolve(temp,x,ans);
goto out;
}
err = 2;
goto out;
}
/* Check for newly-introduced integer variables */
count = 0;
for(i=nvariables; i<nvars; i++)
{ if(TYPE(varlist[i])==INTEGER)
++count;
}
if(count == 0) /* no new integer variables */
eliminate_vars(nvariables,savenextassumption); /* see below */
else
{ /* get rid of all new variables not contained in *ans. The new variables
that ARE contained in *ans must be of type INTEGER. Careful though:
we must also get rid of new or modified assumptions that contain
only the eliminated variables, and we must not eliminate variables
that occur in assumptions that also contain non-eliminated variables.
*/
count = nvariables;
for(i=nvariables; i<nvars; i++)
{ if(contains(*ans,FUNCTOR(varlist[i])) && i >= count)
{ assert(TYPE(varlist[i]) == INTEGER);
if(i > count)
swapvars(count,i);
++count;
}
}
/* now varlist[count] to varlist[nvars-1] are to be eliminated.
But don't forget they may still occur in assumptions.
Therefore 'set_nvariables(count)' would be incorrect here;
it would leave assumptions containing variables not in the
varlist. */
eliminate_vars(count,savenextassumption);
}
out:
set_eigenvariable(saveeigenvariable);
set_nextdefn(savenextdefn);
set_problemtype(save_problemtype);
set_currenttopic(save_currenttopic);
ResetShowStep();
SetCommentStop(save_stopflag);
return err;
}
/*________________________________________________________________________*/
static int safe_solve(int depthflag, term u, term *ans)
/* do the work of ssolve, stopping if the recursion depth exceeds MAXDEPTH.
Solve for the eigenvariable, which has been set by ssolve before this
was called. In recursive calls the eigenvariable can change if substitutions
are made for the eigenvariable.
See above for documentation of ssolve.
safe_solve is allowed to return an equation containing new variables.
ssolve is not; it makes a call to safe_solve which may call itself recursively,
but if in the end new variables are not eliminated, ssolve will declare that
to be failure. The return values of safe_solve are as for ssolve: 0 for
completely solved, 1 for partly solved (*ans is not garbage) and 2 for
failure (*ans is garbage).
*/
{ int i,j,k,err,found,nsolveops,st;
actualop solveops[NSOLVEOPS];
int saveeigenvariable = get_eigenindex();
int savedisplay = inq_display_on(); /* controls display of "Using real numbers only" */
int savemode = get_mathmode();
int saveproblemtype = get_problemtype();
int savetopic = get_currenttopic();
int save_trigexpandflag = get_trigexpandflag();
int savefactorflag = get_factorflag();
/* make sure ssolve leaves factorflag unchanged. */
char localbuf[DIMREASONBUFFER];
term mid,arg,temp,temp2,v,p;
int zeroflag = 0;
actualop o[48];
int nops,trigcount;
unsigned short tflag;
int flag=0;
unsigned short count = 0;
unsigned long nbytes;
void *savenode;
unsigned short f,n;
term x = get_eigenvariable();
int save_checksolutionsflag;
int save_noassumptions = get_noassumptions();
if(depthflag >= MAXDEPTH)
{ *ans = u;
return 1;
}
/* check if we're close to running out of heap space */
nbytes = mycoreleft();
if(nbytes < 24576) /* less than 24K left */
return 2; /* don't risk running out of space */
f = FUNCTOR(u);
assert(f != NE); /* ssolve replaces NE before calling safe_solve */
n = ARITY(u);
if(equals(u,false) || equals(u,true))
{ *ans = u;
return 0;
}
save_checksolutionsflag = get_checksolutionsflag();
st = status(completethesquare);
set_status(completethesquare,WELLKNOWN);
if(f == AND && interval_as_and(u) && equals(ARG(1,ARG(0,u)),x))
{ *ans = u;
err = 0; /* already solved */
goto out;
}
if(savetopic != _related_rates && savetopic != _implicit_diff)
{ set_problemtype(contains(u,'=') ? SOLVE_EQUATION : INEQUALITIES);
/* needed to get autosum to attract lns for example.
Will reset it to saveproblemtype before returning */
if(get_problemtype() == INEQUALITIES)
set_noassumptions(1);
/* stop divineq from making assumptions that things are positive */
set_currenttopic(contains(u,'=') ? _solve_equation : _solve_root_inequality);
/* if the current topic is integration, econstant will not work right,
returning !contains(..,INTEGRAL) */
}
if(f == OR) /* call ssolve on each arg separately */
{ mid = make_term(OR,n);
for(i=0;i<n; i++)
{ err = safe_solve(depthflag+1,ARG(i,u),&temp);
if(err==2)
{ ARGREP(mid,i,ARG(i,u));
flag = 2;
++count;
continue;
}
else if(err && flag < 2)
flag = 1;
ARGREP(mid,i,temp);
count += (unsigned short)( FUNCTOR(temp) == OR ? ARITY(temp) : 1);
}
if(count != n) /* mid needs flattening */
{ *ans = make_term(OR,count);
k=0;
for(i=0;i<n;i++)
{ temp = ARG(i,mid);
if(FUNCTOR(temp) != OR && !equals(temp,false))
{ ARGREP(*ans,k,temp);
++k;
}
else for(j=0;j<ARITY(temp);j++)
{ ARGREP(*ans,k,ARG(j,temp));
++k;
}
}
assert(k <=count);
if(k < count)
SETFUNCTOR(*ans,OR,k);
if(k == 1)
*ans = ARG(0,*ans);
err = flag;
goto out;
}
else
{ *ans = mid;
err = flag;
goto out;
}
}
if(f== MULTIPLICITY)
{ err = safe_solve(depthflag+1,ARG(0,u),ans); /* ignoring multiplicities */
goto out;
}
if(f == '=' &&
(FUNCTOR(ARG(0,u)) == SIN && FUNCTOR(ARG(1,u)) == COS && equals(ARG(0,ARG(0,u)),ARG(0,ARG(1,u)))) ||
(FUNCTOR(ARG(1,u)) == SIN && FUNCTOR(ARG(0,u)) == COS && equals(ARG(0,ARG(0,u)),ARG(0,ARG(1,u))))
)
{ /* sin x = cos x iff tan x = 1 */
term v = equation(tan1(ARG(0,ARG(0,u))),one);
err = safe_solve(depthflag+1,v,ans);
goto out;
}
if(interval_as_and(u))
{ if(solved(u,x))
{ err = 0;
*ans = u;
goto out;
}
/* Find an operation that will work on both sides */
found = 0;
for(i=0;i<NINEQ;i++)
{ SETFUNCTOR(arg,ILLEGAL,0);
err = (*ineq_preops[i])(ARG(0,u),arg,&mid,localbuf);
if(!err)
{ err = (*ineq_preops[i])(ARG(1,u),arg,&p,localbuf);
if(!err)
{ found = 1;
break;
}
}
}
if(!found)
{ solve_ineq(ARG(0,u),0,o,&nops);
SETFUNCTOR(arg,ILLEGAL,0);
for(i=0;i<nops;i++)
{ if(inhibited(*o[i]))
continue;
err = (*o[i])(ARG(0,u),arg,&mid,localbuf);
if(err)
continue;
err = (*o[i])(ARG(1,u),arg,&p,localbuf);
if(err)
continue;
if((void *)(*o[i]) == alltoleft && (FUNCTOR(ARG(0,mid)) == '+' || FUNCTOR(ARG(1,mid)) == '+'))
/* factor if possible and desirable */
{ v = FUNCTOR(ARG(0,mid)) == '+' ? ARG(0,mid) : ARG(1,mid);
set_trigflag(v,&tflag);
trigcount = tflag ? nbits(tflag) : 0;
if(FUNCTOR(v) == '+' && !trig_suppress_factoring(trigcount,v))
{ factor(v,&temp);
ARGREP(mid, FUNCTOR(ARG(0,mid)) == '+' ? 0 : 1, temp);
}
}
if((void *)(*o[i]) == alltoleft && (FUNCTOR(ARG(0,p)) == '+' || FUNCTOR(ARG(1,p)) == '+'))
{ v = FUNCTOR(ARG(0,p)) == '+' ? ARG(0,p) : ARG(1,p);
set_trigflag(v,&tflag);
trigcount = tflag ? nbits(tflag) : 0;
if(FUNCTOR(v) == '+' && !trig_suppress_factoring(trigcount,v))
{ factor(v,&temp);
ARGREP(p, FUNCTOR(ARG(0,p)) == '+' ? 0 : 1, temp);
}
}
found = 1;
break;
}
}
if(found)
{ mid = and(mid,p);
err = safe_solve(depthflag+1,mid,ans);
goto out;
}
post_ops(u,&arg,o,&nops);
for(i=0;i<nops;i++)
{ if(inhibited(*o[i]))
continue;
err = (*o[i])(u,arg,&mid,localbuf);
if(!err)
{ err = safe_solve(depthflag+1,mid,ans);
goto out;
}
}
set_problemtype(saveproblemtype);
set_currenttopic(savetopic);
set_trigexpandflag(save_trigexpandflag);
set_mathmode(savemode);
set_checksolutionsflag(save_checksolutionsflag);
set_noassumptions(save_noassumptions);
return 2;
}
if(!INEQUALITY(f))
{ set_problemtype(saveproblemtype);
set_currenttopic(savetopic);
set_trigexpandflag(save_trigexpandflag);
set_mathmode(savemode);
set_checksolutionsflag(save_checksolutionsflag);
set_noassumptions(save_noassumptions);
return 2;
}
if(ISZERO(ARG(1,u)) && FUNCTOR(ARG(0,u)) == '+' && contains(ARG(0,u),'^'))
zeroflag = 1;
else if(ISZERO(ARG(0,u)) && FUNCTOR(ARG(1,u)) == '+' && contains(ARG(1,u),'^'))
zeroflag = -1;
tflag = 0; /* initialize before calling set_trigflag */
if(zeroflag)
{ v = zeroflag == 1 ? ARG(0,u) : ARG(1,u);
set_trigflag(v,&tflag);
trigcount = tflag ? nbits(tflag) : 0;
}
else
trigcount = 0;
if(zeroflag && !trig_suppress_factoring(trigcount,v))
{ display_off();
savenode = heapmax();
err = 1;
if(trigcount)
{ SETFUNCTOR(arg,ILLEGAL,0); /* avoid a warning message that arg hasn't been initialized */
err = reversedoublecos1(v,arg,&mid,localbuf);
if(err)
err = reversedoublecos2(v,arg,&mid,localbuf);
if(err)
err = reversedoublecos3(v,arg,&mid,localbuf);
}
if(err)
{ err = factor(v,&mid);
if(err)
{ clear_error_buffer();
/* factor leaves an inappropriate error message there */
reset_heap(savenode); /* factor might use up a lot of memory */
temp = u; /* to be used if loopcheck exposes a loop below */
}
}
if(!err)
{ save_and_reset(mid,savenode,&mid);
temp = make_term(f,2);
if(zeroflag == 1)
{ ARGREP(temp,0,mid);
ARGREP(temp,1,zero);
}
else
{ ARGREP(temp,1,mid);
ARGREP(temp,0,zero);
}
if(loopcheck(temp))
{ *ans = temp;
err = 1;
goto out;
}
err = safe_solve(depthflag+1,temp,ans);
goto out;
}
}
set_mathmode(AUTOMODE);
display_off();
determine_trigexpandflag(u);
/* problemtype has already been set to solve_equation */
SETFUNCTOR(arg,ILLEGAL,0);
if(FUNCTOR(u) == '=' && !ALREADY(u))
{ polyval(u,&mid);
u = mid; /* and proceed */
}
else if (INEQUALITY(FUNCTOR(u)) && (!ALREADY(ARG(0,u)) || !ALREADY(ARG(1,u))))
{ polyval(u,&mid);
u = mid; /* and proceed; inequalities themselves are not marked ALREADY by polyval */
}
if(solved(u,x))
{ err = 0;
*ans = u;
goto out;
}
if(!contains(u,FUNCTOR(x)))
{ err = infer(u);
if(!err)
{ *ans = true;
err = 0;
goto out;
}
err = refute(u);
if(!err)
{ *ans = false;
err = 0;
goto out;
}
else
{ *ans = u;
err = 0;
goto out;
}
}
found = 0;
savenode = heapmax();
if(f == '=')
{ pre_equation(u,solveops,&nsolveops);
for(i=0;i<nsolveops && !found;i++)
{ err = (*solveops[i])(u,arg,&mid,localbuf);
if(!err)
found = 1;
}
}
else /* inequalities */
{ for(i=0;i<NINEQ && !found;i++)
{ err = (*ineq_preops[i])(u,arg,&mid,localbuf);
if(!err)
found = 1;
}
}
if(found)
{ polyval(mid,&v);
save_and_reset(v,savenode,&mid);
if(loopcheck(mid))
{ err = 1;
*ans = mid;
goto out;
}
savenode = heapmax(); /* keep the term 'mid' that you just stored in loopcheck */
if(solved(mid,x))
{ err = 0;
*ans = mid;
goto out;
}
err = safe_solve(depthflag+1,mid,ans);
if(err==2)
{ /* the attempt to solve mid was a total failure */
/* but we did make SOME progress already in finding mid. */
*ans = mid;
err = 1;
}
goto out;
}
reset_heap(savenode);
/* example : cos^2 x - sin^2 x = 0. Polyval does not do any
trig simplification. */
if(ZERO(ARG(1,u)) && FUNCTOR(ARG(0,u)) == '+')
{ int save_pathlength = get_pathlength();
unsigned short *path = get_path();
unsigned short saveit = path[0];
/* path is not set up except when autosimp is working. However
autosum checks values of path. Since we are going to call
autosum we'd better set the pathlength to 1 and put '+' in
there as if this were a toplevel sum. */
set_pathlength(1);
path[0] = '+';
autosum(ARG(0,u),o,&nops);
path[0] = saveit;
set_pathlength(save_pathlength);
for(i=0;i<nops;i++)
{ err = (*o[i])(ARG(0,u),arg,&mid,localbuf);
if(!err)
{ if(FRACTION(mid) && !get_polyvaldomainflag())
{ if(FUNCTOR(u) == '=' || obviously_positive(ARG(1,mid)))
mid = ARG(0,mid); /* discard the denominator */
}
polyval(mid,&temp);
temp2 = make_term(FUNCTOR(u),2);
ARGREP(temp2,0,temp);
ARGREP(temp2,1,zero);
save_and_reset(temp,savenode,&temp);
if(loopcheck(temp))
{ *ans = temp;
err = 1;
goto out;
}
savenode = heapmax(); /* keep the term just stored in loopcheck */
err = safe_solve(depthflag+1,equation(temp,zero),ans); /* 1.21.06 */
set_problemtype(saveproblemtype);
set_currenttopic(savetopic);
goto out;
}
}
}
reset_heap(savenode);
if(f == '=')
solve_equation(u,0,o,&nops);
else
solve_ineq(u,0,o,&nops);
SETFUNCTOR(arg,ILLEGAL,0);
for(i=0;i<nops;i++)
{ if(inhibited(*o[i]))
continue;
if((void *) (*o[i]) == (void *) computediscriminant ||
(void *) (*o[i]) == (void *) showcallingcubic
)
continue;
err = (*o[i])(u,arg,&mid,localbuf);
if(!err)
{ if((void *)(*o[i]) == completethesquare)
release(alltoleft);
if((void *)(*o[i]) == alltoleft ||(void *)(*o[i]) == completethesquare)
/* factor if possible and desirable */
{ v = FUNCTOR(ARG(0,mid)) == '+' ? ARG(0,mid) : ARG(1,mid);
set_trigflag(v,&tflag);
trigcount = tflag ? nbits(tflag) : 0;
if(FUNCTOR(v) == '+' && !trig_suppress_factoring(trigcount,v))
{ factor(v,&temp);
ARGREP(mid, FUNCTOR(ARG(0,mid)) == '+' ? 0 : 1, temp);
}
}
save_and_reset(mid,savenode,&mid);
if(loopcheck(mid))
{ *ans = mid;
err = 1;
goto out;
}
savenode = heapmax();
err = safe_solve(depthflag+1,mid,ans);
goto out;
}
}
reset_heap(savenode);
/* if we get here nothing has worked; this equation (or inequality or
disjunction thereof) can't be solved or even simplified. */
err = 2; /* failure */
out: /* exit, successful if err = 0 or 1 */
set_status(completethesquare,st);
set_mathmode(savemode);
if(savedisplay)
display_on();
if(err >= 2)
/* *ans can be garbage, so don't enter the code below */
{ set_eigenvariable(saveeigenvariable);
set_factorflag(savefactorflag);
set_trigexpandflag(save_trigexpandflag);
set_problemtype(saveproblemtype);
set_currenttopic(savetopic);
set_checksolutionsflag(save_checksolutionsflag);
return err;
}
set_factorflag(savefactorflag);
set_trigexpandflag(save_trigexpandflag);
if(FUNCTOR(*ans) == OR && contains(*ans,FALSEFUNCTOR))
{ /* get rid of any 'false' arguments */
int kk=0;
temp = *ans;
*ans = make_term(OR,ARITY(*ans));
for(i=0;i<ARITY(*ans);i++)
{ if(!equals(ARG(i,temp),false))
{ ARGREP(*ans,kk,ARG(i,temp));
++kk;
}
}
SETFUNCTOR(*ans,OR,kk);
if(kk == 0)
{ RELEASE(*ans);
*ans = false;
}
else if(kk == 1)
{ temp = ARG(0,*ans);
RELEASE(*ans);
*ans = temp;
}
}
if(FUNCTOR(u) == '=' && !err && ISATOM(x) &&
!contains(u,DIFF) && !contains(u,INTEGRAL) && !contains(u,LIMIT) &&
equals(get_eigenvariable(),x) && /* when we've made a substitution, the eigenvariable has
changed, and we may have u of the form f(x)=0 and temp of the form newvar = ...,
and we don't want to check this numerically. */
!contains_existentials(ARG(1,u)) /* you can't reject a parametrized solution because it fails for
some values of the parameter */
)
/* ISATOM(x) prevents trying to check it numerically when
we're solving for du/dx in implicit differentiation */
{ unsigned short f = FUNCTOR(*ans);
if(INEQUALITY(f) || f == MULTIPLICITY || f == OR)
/* It could also be true or false for example,
which will cause trouble in check_numerically */
{ temp = *ans;
if(get_checksolutionsflag())
check_numerically(u,temp,ans);
if(FUNCTOR(*ans) == '=')
SETCHECKED(*ans);
else if(FUNCTOR(*ans) == OR)
{ for(i=0;i<ARITY(*ans);i++)
SETCHECKED(ARG(i,*ans));
}
}
set_problemtype(saveproblemtype);
set_currenttopic(savetopic);
set_checksolutionsflag(save_checksolutionsflag);
return 0;
}
set_problemtype(saveproblemtype);
set_currenttopic(savetopic);
set_checksolutionsflag(save_checksolutionsflag);
set_noassumptions(save_noassumptions);
return err;
}
/*___________________________________________________________________*/
MEXPORT_AUTOMODE int ssolveop(term t,term arg,term *next, char *reason)
/* solve, or do the best Mathpert can to solve,
an equation or disjunction of equations in one step.
(It can also be applied to an inequality.)
Fail if Mathpert can't make any progress at all.
arg passes the variable or term to be solved for; if
it's ILLEGAL, it's set to the unique variable in t if there is only one,
else to the non-eigenvariable if there are two variables
and no derivatives; else the operator fails.
ssolve can solve an equation producing a solution x = c when
x !=c already is in the list of assumptions, e.g. abs(x)/x = 0
will produce x=0, ONLY if x != 0 is already assumed. So ssolveop
checks that the answer can't be refuted, and if it can, it
generates an error message and fails.
*/
{ int err,i,count=0,countintvars=0,whichvar=-1,whichvar2,param;
term temp;
unsigned short f = FUNCTOR(t);
if(!INEQUALITY(f) && f != OR) /* INEQUALITY includes '=' */
return 1;
if(FUNCTOR(arg)==ILLEGAL)
{ int nvariables = get_nvariables();
term *varlist = get_varlist();
varinf *varinfo = get_varinfo();
if(contains(t,INTEGRAL))
return 1; /* don't use this in integration by parts */
for(i=0;i<nvariables;i++)
{ if(contains(t,FUNCTOR(varlist[i])))
{ ++count;
if(varinfo[i].type == INTEGER)
{ ++countintvars;
param = i;
}
else if(whichvar >= 0)
whichvar2 = i;
else
whichvar = i;
}
}
if(contains(t,DIFF))
{ /* identify the derivative subterm */
err = derivative_subterm(t,&arg);
if(err)
return 1;
}
else if(count - countintvars == 1)
/* Only one non-integer variable, solve for that one */
arg = varlist[whichvar];
else if(count==countintvars)
/* nothing but integer variables, solve for one of them */
arg = varlist[param];
else
/* Two or more non-integer variables, solve for the non-eigenvariable */
arg = whichvar == get_eigenindex() ? varlist[whichvar2] : varlist[whichvar];
}
err = ssolve(t,arg,&temp);
if(err==2)
return 1; /* can't do a thing */
if(!err && equals(temp,false))
{ strcpy(reason, english(371)); /* Impossible equation */
*next = false;
return 0;
}
checksolutions(temp,next);
if(equals(t,*next))
return 1; /* already solved */
if(FUNCTOR(t) == OR && (FUNCTOR(*next) != OR || ARITY(*next) < ARITY(t)))
/* an equation was eliminated as impossible */
commentbuf(0, english(0)); /* drop an impossibility */
strcpy(reason, english(372)); /* Solve equation */
SETCOLOR(*next,YELLOW);
return 0;
}
/*___________________________________________________________________*/
static void check_numerically(term original, term t, term *ans)
/* Original is an equation. Ssolve has been called on it
to produce t, an equation or an OR of equations, or a term with
functor MULTIPLICITY, whose arg is an equation. Try to refute
t (or its members if it's an OR) numerically by substituting back
in the original equation. Return in *ans the list t with refuted
members deleted, or false if they are all refuted. */
{ int err,i;
unsigned short n,k;
double z,l,r,saveit;
term temp;
assert(FUNCTOR(original) == '=');
/* don't need to require it to be seminumerical as all the
variables will have SOME value; zero denominators can
thus be discovered even when there are symbolic constants.
The numerical values of the variables are initialized to weird
numbers so it is probability zero that some denominator
is accidentally zero. */
if(FUNCTOR(t) == MULTIPLICITY)
{ check_numerically(original,ARG(0,t),&temp);
if(equals(temp,false))
{ *ans = false;
return;
}
else
{ *ans = t;
return;
}
}
if(FUNCTOR(t) == OR)
{ n = ARITY(t);
k = 0;
*ans = make_term(OR,n);
for(i=0;i<n;i++)
{ if(equals(ARG(i,t),false))
continue;
check_numerically(original,ARG(i,t),&temp);
if(equals(temp,false))
continue;
ARGREP(*ans,k,ARG(i,t));
k++;
}
if(k==0)
{ RELEASE(*ans);
*ans = false;
return;
}
if(k==1)
{ temp = ARG(0,*ans);
RELEASE(*ans);
*ans = temp;
return;
}
SETFUNCTOR(*ans,OR,k);
return;
}
if(ISATOM(t) && (equals(t,true) || equals(t,false)))
{ *ans = t;
return;
}
if(FUNCTOR(t) != '=' || !ISATOM(ARG(0,t)))
{ *ans = t;
return;
}
err = deval(ARG(1,t),&z);
if(err)
{ *ans = false;
return;
}
saveit = VALUE(ARG(0,t));
SETVALUE(ARG(0,t),z);
if(deval(ARG(0,original),&l) || deval(ARG(1,original),&r))
{ *ans = false;
SETVALUE(ARG(0,t),saveit);
return;
}
if(fabs(l-r) > 1.0e-10) /* leave a lot of room for roundoff error,
so as not to wrongly reject some solution */
/* bad example : sqrt( cx) = -x, solutions
that get here are x = 0, x=c, but x=c
has to be rejected. If c is small enough
it won't be. But only a pervert would
type in sqrt(0.000000000001 x) = -x */
/* another bad example: solve 0.781234567 = x + 2^27;
we find of course x = 0.781234567 - 2^27, but this
number has only a few digits significant to the
right of the decimal point, so when deval is applied
on the right, the value of x + 2^27 is not close enough
to 0.781234567. In this case, since the equation is
linear, checksolutionsflag hasn't been set, but of
course the same thing could happen in a nonlinear
equation.
*/
*ans = false;
else
*ans = t;
SETVALUE(ARG(0,t),saveit);
return;
}
/*___________________________________________________________________*/
static void checksolutions(term t, term *next)
/* t is an equation or an OR of equations. Try to refute these
equations, using the list of current assumptions.
Return in *next the original list with refuted members
deleted, or false if they are all refuted. */
{ int err,i;
term temp;
unsigned short n,k;
if(FUNCTOR(t) == '=')
{ err = refute(t);
if(!err)
{ *next = false;
commentbuf(0, english(1035));
/* Reject solutions which contradict assumptions */
}
else
*next = t;
return;
}
if(FUNCTOR(t) != OR)
{ *next = t;
return;
}
n = ARITY(t);
*next = make_term(OR,n);
k=0;
for(i=0;i<n;i++)
{ checksolutions(ARG(i,t), &temp);
if(!equals(temp,false))
{ ARGREP(*next,k,temp);
++k;
}
}
if(k==0)
{ RELEASE(*next);
*next = false;
return;
}
if(k==1)
{ temp = ARG(0,*next);
RELEASE(*next);
*next = temp;
return;
}
SETFUNCTOR(*next,OR,k);
}
/*___________________________________________________________________*/
MEXPORT_AUTOMODE int solved(term t,term x)
/* return 1 if t is a solved equation or inequality (solved for x that is)
or an OR of solved equations or inequalities */
{ int i;
unsigned short n;
unsigned short f = FUNCTOR(t);
int problemtype;
if(f == OR || f == VECTOR)
{ n = ARITY(t);
for(i=0;i<n;i++)
{ if(!solved(ARG(i,t),x))
break;
}
if(i<n)
return 0;
return 1;
}
if(f ==MULTIPLICITY)
return solved(ARG(0,t),x);
if(equals(t,true))
return 1;
if(equals(t,false))
return 1;
if(f == '=')
{ problemtype = get_problemtype();
if(problemtype == IMPLICIT_DIFF ||
problemtype == RELATED_RATES
)
{ if(FUNCTOR(ARG(0,t)) == DIFF && !contains(ARG(1,t),DIFF))
return 1;
return 0;
}
if(!equals(ARG(0,t),x))
return 0;
if(!econstant(ARG(1,t)))
return 0;
return 1;
}
else if(f == '<' || f == LE || f == '>' || f == GE ||f == NE)
/* Note, NE can arise from 'explicitdomain' ("use assumptions"),
e.g. x/x > 0 becomes 1 > 0 becomes 'true' becomes x != 0,
which we do want to count as solved. */
{ term left = ARG(0,t);
term right = ARG(1,t);
if(econstant(right) && equals(left,x))
return 1;
if(econstant(left) && equals(right,x))
return 1;
#if 0
if(FUNCTOR(left) == ABS && equals(ARG(0,left),x) &&
econstant(right) /* accept |x| < 3 for example */
)
return 1;
#endif
return 0;
}
else if (FUNCTOR(t) == AND) /* accept an interval a < x < b for example */
{ if(ARITY(t) != 2)
return 0;
if(econstant(ARG(0,ARG(0,t))) &&
econstant(ARG(1,ARG(1,t))) &&
equals(ARG(1,ARG(0,t)),x) &&
equals(ARG(0,ARG(1,t)),x)
)
return 1;
else
return 0;
}
return 0; /* any other functor or case not covered */
}
/*_______________________________________________________________________*/
static int loopcheck(term t)
/* return 1 if ssolve is caught in a loop, 0 if not.
Add t to the list of terms, equality to one of which
counts as being in a loop.
*/
{ static term past[LOOPLIMIT]; /* valid entries are 0 ... npast */
int i;
static int nextpast;
for(i=0;i<npast;i++)
{ if(equals(t,past[i]))
return 1;
}
if(npast == 0)
nextpast = 0;
if(npast < LOOPLIMIT)
{ past[npast] = t;
++nextpast;
++npast;
assert(nextpast == npast);
if(npast == LOOPLIMIT)
nextpast = 0;
return 0;
}
past[nextpast] = t;
++nextpast;
if(nextpast == LOOPLIMIT)
nextpast = 0;
return 0;
}
/*_______________________________________________________________________*/
static void set_polyval(int flag)
/* If flag is zero, save the current polyval flags and set them
to values for use in safe_solve. If flag is nonzero, restore the
saved values.
*/
{ static int savefactorflag, savefactorflag2, savecomdenomflag,
savefractexpflag, savenegexpflag, savelogflag, savegcdflag,
savefunctionflag, savetrigsqflag;
if(flag == 0)
{ savefactorflag = get_polyvalfactorflag();
savefactorflag2 = get_polyvalfactorflag2();
savecomdenomflag = get_polyvalcomdenomflag();
savenegexpflag = get_polyvalnegexpflag();
savefractexpflag = get_polyvalfractexpflag();
savelogflag = get_polyvallogflag();
savegcdflag = get_polyvalgcdflag();
savefunctionflag = get_polyvalfunctionflag();
savetrigsqflag = get_polyvaltrigsqflag();
set_polyvalfactorflag(0);
set_polyvalfactorflag2(0);
set_polyvalcomdenomflag(0); /* maybe it should be 1? */
set_polyvalnegexpflag(0);
set_polyvalfractexpflag(0);
set_polyvallogflag(1);
set_polyvalfunctionflag(1);
set_polyvalgcdflag(1);
set_polyvaltrigsqflag(1);
return;
}
set_polyvalfactorflag(savefactorflag);
set_polyvalfactorflag2(savefactorflag2);
set_polyvalcomdenomflag(savecomdenomflag);
set_polyvalfractexpflag(savefractexpflag);
set_polyvalnegexpflag(savenegexpflag);
set_polyvallogflag(savelogflag);
set_polyvalfunctionflag(savefunctionflag);
set_polyvalgcdflag(savegcdflag);
set_polyvaltrigsqflag(savetrigsqflag);
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists