Sindbad~EG File Manager
/* several linear equations */
/* M. Beeson, several linear equations, for MathXpert
Original date 1.8.91
10.24.99 modified linearform, and lines with "too long" comment
4.28.00 removed #pragma argsused
4.28.00 modified addtwoeqns and subtwoeqns and diveqns to compensate for
possible missing spaces in translated strings.
4.28.00 changed strlen to mstrlen in addmuleqns, submuleqns, muleqns, and diveqns.
5.8.00 changed 386 to 2426 in diveqns.c
*/
#define ALGEBRA_DLL
#include <string.h>
#include <assert.h>
#include <search.h>
#include <math.h> /* fabs, used in ISZERO */
char *ltoa(long, char *, int);
char *itoa(int, char *,int);
#include "globals.h"
#include "ops.h"
#include "probtype.h"
#include "order.h"
#include "simpsums.h"
#include "cancel.h"
#include "simpprod.h"
#include "algaux.h"
#include "getprob.h" /* initialize_parameter */
#include "prover.h"
#include "display.h"
#include "display1.h" /* lineupflag */
#include "symbols.h"
#include "solvelin.h" /* solve_linear_ineq_for */
#include "islinear.h" /* is_linear_in */
#include "errbuf.h"
#include "autosimp.h" /* set_pathtail etc. */
#include "fsubst.h" /* free_subst */
#include "pvalaux.h" /* strongnegate */
#include "mstring.h" /* mstring */
#include "dispfunc.h" /* atom_string */
static term linearform(term t);
term distrib_and_polyval(term c, term t);
/*_______________________________________________________________*/
static int vleftaux(term t, term *ans)
/* t is an equation or inequality. Bring all variables to the left,
combining like terms and putting them in order, and bring all
constants to the right. */
/* Return value is zero for nothing done, bit 0 set when variable is
moved left, bit 1 set when constant is moved right */
{ unsigned short n,m,p;
unsigned short kleft=0;
unsigned short kright=0;
term ll,rr;
int i,err;
int r=0; /* set bit 0 when a variable is moved left;
set bit 1 when a constant is moved right; */
term left,right,u,v;
u = ARG(0,t);
v = ARG(1,t);
if(FUNCTOR(u) == '+')
n = ARITY(u);
else
n = 1;
/* n = (FUNCTOR(u) == '+' ? ARITY(u) : 1); provokes a warning in Win32 */
if(FUNCTOR(v)=='+')
m = ARITY(v);
else
m = 1;
p = (unsigned short)(n + m);
left = make_term('+',p);
right = make_term('+',p);
if(n==1) /* only one term on left originally */
{ if(constant(u) && !ZERO(u)) /* if the equation is 0=rhs, don't try to move the 0 */
{ ARGREP(right,0,tnegate(u));
++kright;
r |= 2;
}
else if(!ZERO(u))
{ ARGREP(left,0,u);
++kleft;
}
}
if(m==1) /* only one term on right originally */
{ if(constant(v) && !ZERO(v))
{ ARGREP(right,kright,v);
++kright;
}
else if(!ZERO(v))
{ ARGREP(left,kleft,tnegate(v));
++kleft;
r |= 1;
}
}
if(n>1) /* put all terms in u to left or right as is appropriate */
{ for(i=0;i<n;i++)
{ if(constant(ARG(i,u)))
{ ARGREP(right,kright,tnegate(ARG(i,u)));
++kright;
r |= 2;
}
else
{ ARGREP(left,kleft,ARG(i,u));
++kleft;
}
}
}
if(m>1) /* put all terms in v to left or right as is appropriate */
{ for(i=0;i<m;i++)
{ if(constant(ARG(i,v)))
{ ARGREP(right,kright,ARG(i,v));
++kright;
}
else
{ ARGREP(left,kleft,tnegate(ARG(i,v)));
++kleft;
r |= 1;
}
}
}
/* Has anything been done? If not stop now. */
if(r==0)
{ RELEASE(left);
RELEASE(right);
*ans = t;
return 0;
}
/* Now adjust the arity of left and right */
if(kleft > 1)
SETFUNCTOR(left,'+',kleft);
else if(kleft == 0)
{ RELEASE(left);
left = zero;
}
else if(kleft == 1)
{ term temp;
temp = ARG(0,left);
RELEASE(left);
left = temp;
}
if(kright > 1)
SETFUNCTOR(right,'+',kright);
else if(kright == 0)
{ RELEASE(right);
right = zero;
}
else if(kright == 1)
{ term temp;
temp = ARG(0,right);
RELEASE(right);
right = temp;
}
/* Now left contains the variables, right contains the constants. But
they aren't sorted and combined */
if(status(varsleft)==LEARNING) /* Then sort but don't combine */
{if(FUNCTOR(left) == '+')
additive_sortargs(left);
if(FUNCTOR(right) == '+')
additive_sortargs(right);
*ans = make_term(FUNCTOR(t),2);
ARGREP(*ans,0,left);
ARGREP(*ans,1,right);
return r;
}
if(FUNCTOR(left) != '+')
ll = left;
else
{ err = collect(left,&ll); /* zero is nothing done */
if(err==0)
ll = left;
else RELEASE(left);
}
if(FUNCTOR(right) != '+')
rr = right;
else
{ err = collect(right,&rr);
if(err==0)
rr = right;
else RELEASE(right);
}
*ans = make_term(FUNCTOR(t),2);
if(FUNCTOR(ll) == '+')
additive_sortargs(ll);
if(FUNCTOR(rr) == '+')
additive_sortargs(rr);
ARGREP(*ans,0,ll);
ARGREP(*ans,1,rr);
return r;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int varsleft(term t, term arg, term *next, char *reason)
/* Put all the variables on the left, in order, and
all the constants on the right */
{ int i;
unsigned short n = ARITY(t);
term u;
int r,rr;
if(FUNCTOR(t) != AND)
return 1;
if(LINEUP(t))
return 1; /* fail immediately if variables are already lined up */
*next = make_term(AND,n);
r = 0; /* record results of work on each equation separately */
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(FUNCTOR(u) != '=')
continue; /* maybe u could be 'false' or 'true' */
rr = vleftaux(ARG(i,t),ARGPTR(*next) + i);
if(rr)
HIGHLIGHT(ARG(i,*next));
r |= rr; /* set bit 0 when a variable is moved left;
set bit 1 when a constant is moved right; */
}
if(r==0)
{ RELEASE(*next);
return 1;
}
if(r==0)
return 1; /* nothing done */
else if(r==3)
strcpy(reason,english(375)); /* transfer terms */
else if(r==2)
strcpy(reason,english(374)); /* constants to right */
else if(r==1)
strcpy(reason,english(373)); /* variables to left */
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int lineupvars(term t, term arg, term *next, char *reason)
/* t is an AND of linear equations, with all variables on the left
and all constants on the right. Insert `void terms' (which
do not display) so that each equation has n summands on the left,
in order) */
/* Assumes the varlist is in alphabetical order with the first n
variables the actual variables and the
parameters, if any,
coming after the variables */
{ int k; /* number of equations */
term lhs,u,v;
int *scratchpad; /* bookkeeping space */
term num,con;
int nvariables;
term *varlist;
int i,j,m,p;
if(FUNCTOR(t) != AND)
{ errbuf(0, english(376));
/* That operator works only on systems of linear equations. */
return 1;
}
if(LINEUP(t)) /* variables already lined up */
{ errbuf(0, english(377));
return 1;
}
k = ARITY(t);
/* Check if all entries are equations, with constant right sides */
for(i=0;i<k;i++)
{ if(FUNCTOR(ARG(i,t)) != '=')
{ errbuf(0,english(376));
return 1;
}
if(!constant(ARG(1,ARG(i,t))))
return 1;
}
/* Now check if the left side contains only linear terms,
and no constant terms, and only one term for each variable */
nvariables = get_nvariables();
varlist = get_varlist();
scratchpad = (int *) callocate(nvariables,sizeof(int));
if(scratchpad == NULL)
{ nospace();
return 1;
}
for(i=0;i<k;i++)
{ lhs = ARG(0,ARG(i,t)); /* left-hand side */
m = (FUNCTOR(lhs) == '+' ? ARITY(lhs) : 1);
/* leave out ')' after lhs and before ';' and you crash the compiler */
if(i>0) /* re-initialize scratchpad */
memset(scratchpad, 0, nvariables *sizeof(int));
/* even if some of the variables are parameters
scratchpad has to be big enough to check all of them */
for(j=0;j<m;j++)
{ u = (m==1 ? lhs : ARG(j,lhs));
ncs(u,&num,&con,&v);
if(constant(v)) /* constant on left */
{ errbuf(0, english(378));
/* First move constants to the right side */
free2(scratchpad);
return 1;
}
if(!ISATOM(v))
/* nonlinear term (or linear term not yet simplified to linear form) */
{ free2(scratchpad);
return 1;
}
for(p=0;p<nvariables;p++) /* find out which variable v is */
{ if(equals(varlist[p],v))
break;
}
assert(p<nvariables); /* you'd better find it! */
if(scratchpad[p]) /* already had a term with this variable */
{ errbuf(0, english(379));
/* Before lining up the variables, collect terms. */
free2(scratchpad);
return 1;
}
else
scratchpad[p] = 1;
}
}
*next = t; /* operator actually does nothing to the term */
free2(scratchpad);
strcpy(reason, english(380)); /* line up variables */
HIGHLIGHT(*next);
SET_LINEUP(*next); /* set a bit in the .info field to specify 'line up variables' */
return 0;
}
/*_______________________________________________________________*/
/* like collectall, but will ONLY work on an AND */
MEXPORT_ALGEBRA int eqnscollectall(term t, term arg, term *next, char *reason)
{ if(FUNCTOR(t) != AND)
return 1;
return collectall(t,arg,next,reason);
}
/*_______________________________________________________________*/
/* arg is AND(i,j); add row i to row j */
MEXPORT_ALGEBRA int addtwoeqns(term t, term arg, term *next, char *reason)
{ term left,right,ll, rr, eqn1,eqn2,temp;
int i,j,m,k,err;
unsigned short path[3];
unsigned short n = ARITY(t);
const char *to;
if(FUNCTOR(t) != AND)
return 1;
*next = make_term(AND,n);
assert(ARITY(arg)==2);
assert(ISINTEGER(ARG(0,arg)));
assert(ISINTEGER(ARG(1,arg)));
i = (int) INTDATA(ARG(0,arg));
j = (int) INTDATA(ARG(1,arg));
assert(i>0 && i <= n);
assert(j>0 && j <= n);
strcpy(reason, english(381)); /* Add eqn */
m = strlen(reason);
/* length of "Add eqn" or its translation in the current language */
if(reason[m-1] != 32)
{ strcat(reason," "); /* in case the translator didn't leave the space */
++m;
}
itoa(i,reason+m,10);
m = strlen(reason);
to = english(382); /* to eqn (with space at beginning and end) */
if(to[0] != 32)
strcat(reason, " "); /* supply space omitted by translator */
strcat(reason,to);
m = strlen(reason);
if(reason[m-1] != 32)
{ strcat(reason, " "); /* in case the translator omitted the space */
++m;
}
itoa(j,reason + m,10);
--i; /* adjust to zero-based indices for use with ARG */
--j;
/* i == j is ok, if somewhat odd */
eqn1 = ARG(i,t);
eqn2 = ARG(j,t);
assert(ARITY(eqn1)==2);
assert(ARITY(eqn2)==2);
at(ARG(0,eqn1),ARG(0,eqn2),&ll);
at(ARG(1,eqn1),ARG(1,eqn2),&rr);
collect(ll,&left);
collect(rr,&right);
err = value(left,&temp);
if(err==0 || err==2)
left = temp;
err = value(right,&temp);
if(err==0 || err==2)
right = temp;
if(FUNCTOR(left)=='+')
additive_sortargs(left);
if(FUNCTOR(right)=='+')
additive_sortargs(right);
ARGREP(*next,j,equation(left,right));
HIGHLIGHT(ARG(j,*next));
for(k=0;k<n;k++)
{ if(k!=j)
ARGREP(*next,k,ARG(k,t));
}
if(LINEUP(t))
SET_LINEUP(*next);
path[0] = AND;
path[1] = (unsigned short)(i+1);
path[2] = 0;
set_pathtail(path);
return 0;
}
/*_______________________________________________________________*/
/* arg is AND(i,j); subtract row i from row j */
MEXPORT_ALGEBRA int subtwoeqns(term t, term arg, term *next, char *reason)
{ term left,right,ll, rr, eqn1,eqn2,temp;
const char *from;
int err,i,j,k,m;
unsigned short path[3];
unsigned short n = ARITY(t);
if(FUNCTOR(t) != AND)
return 1;
*next = make_term(AND,n);
assert(ARITY(arg)==2);
assert(ISINTEGER(ARG(0,arg)));
assert(ISINTEGER(ARG(1,arg)));
i = (int) INTDATA(ARG(0,arg));
j = (int) INTDATA(ARG(1,arg));
assert(i>0 && i <= n);
assert(j>0 && j <= n);
strcpy(reason, english(383)); /* Sub eqn, with a space at the end hopefully */
m = strlen(reason);
/* length of "Sub eqn " or its translation in the current language */
if(reason[m-1] != 32)
{ strcat(reason," "); /* in case the translator didn't leave the space at the end */
++m;
}
itoa(i,reason+m,10);
m = strlen(reason);
from = english(384); /* from eqn (with space at the beginning and the end) */
if(from[0] != 32)
strcat(reason, " "); /* supply space omitted by translator */
strcat(reason, from);
m = strlen(reason);
if(reason[m-1] != 32)
{ strcat(reason, " "); /* in case the translator omitted the space */
++m;
}
itoa(j,reason + m,10);
--i; /* adjust to zero-based indices for use with ARG */
--j;
/* i == j is ok, if somewhat odd */
eqn1 = ARG(i,t);
eqn2 = ARG(j,t);
assert(ARITY(eqn1)==2);
assert(ARITY(eqn2)==2);
at(strongnegate(ARG(0,eqn1)),ARG(0,eqn2),&left);
at(strongnegate(ARG(1,eqn1)),ARG(1,eqn2),&right);
err = summands(left,&ll);
if(err)
ll = left;
err = summands(right,&rr);
if(err)
rr = right;
collect(ll,&left);
collect(rr,&right);
err = value(left,&temp);
if(err==0 || err==2)
left = temp;
err = value(right,&temp);
if(err==0 || err==2)
right = temp;
if(FUNCTOR(left)=='+')
additive_sortargs(left);
if(FUNCTOR(right)=='+')
additive_sortargs(right);
ARGREP(*next,j,equation(left,right));
HIGHLIGHT(ARG(j,*next));
for(k=0;k<n;k++)
{ if(k!=j)
ARGREP(*next,k,ARG(k,t));
}
if(LINEUP(t))
SET_LINEUP(*next);
path[0] = AND;
path[1] = (unsigned short)(i+1);
path[2] = 0;
set_pathtail(path);
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int muleqns(term t,term arg, term *next, char *reason)
/* Multiply equation number ARG(0,arg) by ARG(1,arg) */
{ term left,right,ll,rr,eqn;
int i,k,err;
term c; /* the constant to multiply by */
char localbuf[82];
unsigned short n = ARITY(t);
unsigned short path[3];
if(FUNCTOR(t) != AND)
return 1;
*next = make_term(AND,n);
assert(ARITY(arg)==2);
assert(ISINTEGER(ARG(0,arg)));
c = ARG(1,arg);
if(!constant(c))
assert(0);
err = infer(nonzero(c));
if(err)
{ errbuf(0, english(1726));
/* You are not allowed to multiply by zero. */
return 1;
}
i = (int) INTDATA(ARG(0,arg));
if(!(i>0 && i <= n))
assert(0);
strcpy(reason, english(385)); /* Multiply eqn */
itoa(i,localbuf,10);
strcat(reason,localbuf);
strcat(reason, english(386)); /* by */
err = mstring(c,localbuf);
if(err || mstrlen(localbuf) > 5) /* multiple too long for this line; 5 counts two $ and 3 printing characters */
strcat(reason," "); /* throw it onto the next line */
if(!err && mstrlen(localbuf) <= 21)
strcat(reason,localbuf);
else
strcat(reason, english(387) ); /* constant */
/* that completes the reason string */
--i; /* adjust to zero-based indices for use with ARG */
eqn = ARG(i,t);
assert(ARITY(eqn)==2);
ll = ARG(0,eqn);
rr = ARG(1,eqn);
left = distrib_and_polyval(c,ll);
polyval(product(c,rr),&right);
if(FUNCTOR(left)=='+')
left = linearform(left);
if(FUNCTOR(right)=='+')
additive_sortargs(right);
ARGREP(*next,i,equation(left,right));
HIGHLIGHT(ARG(i,*next));
for(k=0;k<n;k++)
{ if(k!=i)
ARGREP(*next,k,ARG(k,t));
}
if(LINEUP(t))
SET_LINEUP(*next);
path[0] = AND;
path[1] = (unsigned short)(i+1);
path[2] = 0;
set_pathtail(path);
return 0;
}
/*_______________________________________________________________*/
static void diveqns_aux(term t, term c, term *ans)
/* divide t by c, using apartandcancel if t is a sum, and put the
final answer in a form so that each summand is coef * variable,
i.e. the fractions go in the coef, so we see (1/2)x instead of x/2 */
{ unsigned short n = ARITY(t);
int i,err;
term temp,u,a,b,s,coef;
if(FUNCTOR(t) == '+')
{ *ans = make_term('+',n);
for(i=0;i<n;i++)
diveqns_aux(ARG(i,t),c,ARGPTR(*ans) + i);
return;
}
if(FUNCTOR(t) == '-' && FUNCTOR(c) == '-')
{ diveqns_aux(ARG(0,t),ARG(0,c),ans);
return;
}
if(FUNCTOR(t) == '-')
{ diveqns_aux(ARG(0,t),c,&temp);
tneg(temp,ans);
return;
}
if(FUNCTOR(c) == '-')
{ diveqns_aux(t,ARG(0,c),&temp);
tneg(temp,ans);
return;
}
ncs(t,&a,&b,&s);
u = product(a,b);
err = cancel(u,c,&temp,&coef);
if(err)
coef = make_fraction(u,c);
*ans = product(coef,s);
return;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int diveqns(term t, term arg, term *next, char *reason)
/* divide equation number ARG(0,arg) by ARG(1,arg) */
{ term left,right,ll,rr,eqn,temp;
int i,k,err,m;
const char *by;
term c; /* the constant to multiply by */
char localbuf[82];
unsigned short n = ARITY(t);
unsigned short path[3];
if(FUNCTOR(t) != AND)
return 1;
*next = make_term(AND,n);
assert(ARITY(arg)==2);
assert(ISINTEGER(ARG(0,arg)));
c = ARG(1,arg);
assert(constant(c));
i = (int) INTDATA(ARG(0,arg));
assert(i>0 && i <= n);
strcpy(reason, english(388)); /* Divide eqn */
m = strlen(reason);
if(reason[m-1] != 32)
{ strcat(reason, " "); /* supply space omitted by translator */
++m;
}
itoa(i,localbuf,10);
strcat(reason,localbuf);
by = english(2426); /* by (with space before and after) */
if(by[0] != 32)
strcat(reason, " "); /* supply space omitted by translator */
strcat(reason,by);
m = strlen(reason);
if(reason[m-1] != 32)
{ strcat(reason, " "); /* supply space omitted by translator */
++m;
}
err = mstring(c,localbuf);
if(err || mstrlen(localbuf) > 5) /* multiple too long for this line */
strcat(reason," "); /* throw it onto the next line */
if(!err && mstrlen(localbuf) <= 21)
strcat(reason,localbuf);
else
strcat(reason, english(387) ); /* constant */
/* that completes the reason string */
--i; /* adjust to zero-based indices for use with ARG */
eqn = ARG(i,t);
assert(ARITY(eqn)==2);
ll = ARG(0,eqn);
rr = ARG(1,eqn);
diveqns_aux(ll,c,&left);
diveqns_aux(rr,c,&right);
err = value(left,&temp);
if(err==0 || err==2)
left = temp;
err = value(right,&temp);
if(err==0 || err==2)
right = temp;
ARGREP(*next,i,equation(left,right));
HIGHLIGHT(ARG(i,*next));
for(k=0;k<n;k++)
{ if(k!=i)
ARGREP(*next,k,ARG(k,t));
}
if(LINEUP(t))
SET_LINEUP(*next);
path[0] = AND;
path[1] = (unsigned short)(i+1);
path[2] = 0;
set_pathtail(path);
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int addmuleqns(term t, term arg, term *next, char *reason)
/* Add ARG(0,arg) times equation number ARG(1,arg) to eqn number ARG(2,ARG)*/
{ term left,right,ll, rr, eqn1,eqn2,temp;
int err,i,j,k;
unsigned short n = ARITY(t);
term c; /* the constant to multiply by */
term u,v; /* c times left and right sides of eqn 1 respectively */
unsigned short path[3];
char localbuf[82];
c = ARG(0,arg);
assert(constant(c));
if(FUNCTOR(t) != AND)
return 1;
*next = make_term(AND,n);
assert(ARITY(arg)==3);
assert(ISINTEGER(ARG(1,arg)));
assert(ISINTEGER(ARG(2,arg)));
i = (int) INTDATA(ARG(1,arg));
j = (int) INTDATA(ARG(2,arg));
assert(i>0 && i <= n);
assert(j>0 && j <= n);
strcpy(reason, english(389)); /* Add */
err = mstring(c,localbuf);
if(err || mstrlen(localbuf) > MAXREASONSTRING-7) /* multiple too long */
strcat(reason, english(387)); /* constant */
else
strcat(reason,localbuf);
strcat(reason, english(390)); /* " times " */
strcat(reason, english(391)); /* eqn, with space before and after */
itoa(i,localbuf,10);
strcat(reason,localbuf);
strcat(reason, english(382)); /* to eqn */
itoa(j,localbuf,10);
strcat(reason,localbuf);
--i; /* adjust to zero-based indices for use with ARG */
--j;
/* i == j is ok, if somewhat odd */
eqn1 = ARG(i,t);
eqn2 = ARG(j,t);
assert(ARITY(eqn1)==2);
assert(ARITY(eqn2)==2);
ll = ARG(0,eqn1);
rr = ARG(1,eqn1);
mvpolymult(c,ll,&u);
mvpolymult(c,rr,&v);
at(u,ARG(0,eqn2),&ll);
at(v,ARG(1,eqn2),&rr);
collect(ll,&left);
collect(rr,&right);
err = value(left,&temp);
if(err==0 || err==2)
left = temp;
err = value(right,&temp);
if(err==0 || err==2)
right = temp;
if(FUNCTOR(left)=='+')
left = linearform(left);
if(FUNCTOR(right)=='+')
additive_sortargs(right);
ARGREP(*next,j,equation(left,right));
HIGHLIGHT(ARG(j,*next));
for(k=0;k<n;k++)
if(k!=j) ARGREP(*next,k,ARG(k,t));
if(LINEUP(t))
SET_LINEUP(*next);
path[0] = AND;
path[1] = (unsigned short)(i+1);
path[2] = 0;
set_pathtail(path);
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int submuleqns(term t, term arg, term *next, char *reason)
/* Subtract ARG(0,arg) times equation number ARG(1,arg) from eqn number ARG(2,ARG)*/
{ term left,right,ll,rr,eqn1,eqn2,temp;
int err,i,j,k;
unsigned short n = ARITY(t);
unsigned short path[3];
term c; /* the constant to multiply by */
term u,v; /* c times left and right sides of eqn 1 respectively */
char localbuf[82];
c = ARG(0,arg);
assert(constant(c));
if(FUNCTOR(t) != AND)
return 1;
*next = make_term(AND,n);
assert(ARITY(arg)==3);
assert(ISINTEGER(ARG(1,arg)));
assert(ISINTEGER(ARG(2,arg)));
i = (int) INTDATA(ARG(1,arg));
j = (int) INTDATA(ARG(2,arg));
assert(i>0 && i <= n);
assert(j>0 && j <= n);
strcpy(reason, english(392)); /* Subtract */
err = mstring(c,localbuf);
if(err || mstrlen(localbuf) > MAXREASONSTRING - 12) /* multiple too long */
strcat(reason, english(387)); /* constant */
else
strcat(reason,localbuf);
strcat(reason, english(390)); /* " times " */
strcat(reason, english(391)); /* eqn, with space before and after */
itoa(i,localbuf,10);
strcat(reason,localbuf);
strcat(reason, english(384)); /* from eqn */
itoa(j,localbuf,10);
strcat(reason,localbuf);
--i; /* adjust to zero-based indices for use with ARG */
--j;
/* i == j is ok, if somewhat odd */
eqn1 = ARG(i,t);
eqn2 = ARG(j,t);
assert(ARITY(eqn1)==2);
assert(ARITY(eqn2)==2);
ll = ARG(0,eqn1);
rr = ARG(1,eqn1);
mvpolymult(c,ll,&u);
mvpolymult(c,rr,&v);
at(strongnegate(u),ARG(0,eqn2),&ll);
at(strongnegate(v),ARG(1,eqn2),&rr);
collect(ll,&left);
collect(rr,&right);
err = value(left,&temp);
if(err==0 || err==2)
left = temp;
err = value(right,&temp);
if(err==0 || err==2)
right = temp;
if(FUNCTOR(left)=='+')
left = linearform(left);
if(FUNCTOR(right)=='+')
additive_sortargs(right);
ARGREP(*next,j,equation(left,right));
HIGHLIGHT(ARG(j,*next));
for(k=0;k<n;k++)
if(k!=j) ARGREP(*next,k,ARG(k,t));
if(LINEUP(t))
SET_LINEUP(*next);
path[0] = AND;
path[1] = (unsigned short)(i+1);
path[2] = 0;
set_pathtail(path);
return 0;
}
/*_______________________________________________________________*/
static term linearform(term t)
/* t is a linear function of several variables; if t is a sum
of terms each containing only one variable, present it explicitly
as a linear function. Example: (ax + bx + cy) becomes (a+b)x + y even
if a and b do not combine numerically, e.g. if they involve roots.
If however t is more complicated, just return t, e.g.
t = 4(x+y) + 3(x-y).
*/
{ term *atomlist;
int natoms;
term ans;
unsigned short n,k,p;
int *scratch;
int i,j;
term u,temp;
if(FUNCTOR(t) != '+')
return t;
n = ARITY(t);
natoms = variablesin(t,&atomlist);
if(natoms == 0)
{ free2(atomlist);
return t;
}
scratch = callocate(n,sizeof(int));
ans = make_term('+',(unsigned short)(natoms + n));
p = 0;
for(i=0;i<natoms;i++)
{ /* collect all terms containing atomlist[i] */
k = 0;
u = make_term('+',n);
for(j=0;j<n;j++)
{ if(scratch[j])
continue;
if(contains(ARG(j,t),'+'))
continue; /* don't work on (x+y)/4 for example */
if(contains(ARG(j,t),FUNCTOR(atomlist[i])))
{ polyval(make_fraction(ARG(j,t),atomlist[i]),&temp);
if(is_linear(temp) == 0)
{ ARGREP(u,k,temp);
scratch[j] = 1;
++k;
}
else
continue;
}
}
if(k==0)
RELEASE(u);
else if(k==1)
{ temp = ARG(0,u);
RELEASE(u);
u = temp;
ARGREP(ans,p,product(u,atomlist[i]));
++p;
}
else
{ SETFUNCTOR(u,'+',k);
polyval(u,&temp);
u = product(temp,atomlist[i]);
ARGREP(ans,p,u);
++p;
}
}
/* throw in any constant terms */
for(j=0;j<n;j++)
{ if(!scratch[j])
{ ARGREP(ans,p,ARG(j,t));
++p;
}
}
SETFUNCTOR(ans,'+',p);
assert(p >= 1);
if(p == 1)
{ temp = ARG(0,ans);
RELEASE(ans);
ans = temp;
}
free2(scratch);
return ans;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int substforvar(term t, term arg, term *next, char *reason)
/* if one of the equations is of the form x=c, we can substitute
c for x in the other equations. */
/* arg is the variable to be substituted for */
/* In Term Selection mode, it works on ALL the equations. */
{ int i,j,err;
term u,v,eqn;
int problemtype = get_problemtype();
unsigned short n = ARITY(t);
if(FUNCTOR(t) != AND)
return 1;
if(FUNCTOR(arg) == ILLEGAL)
{ /* as happens in RELATED_RATES */
for(i=0;i<n;i++)
{ eqn = ARG(i,t);
if(FUNCTOR(eqn) == '=' && ISATOM(ARG(0,eqn)))
{ arg = ARG(0,eqn);
err = substforvar(t,arg,next,reason);
if(!err)
return 0;
}
}
return 1;
}
if(!ISATOM(arg))
return 1; /* assert(0); but it failed when the operation is
invoked from the Operations menu while there is a selected term.
I fixed that, but no need to crash the program if it fails again. */
for(i=0;i<n;i++)
{ eqn = ARG(i,t);
if(ARITY(eqn) != 2)
return 1;
u = ARG(0,eqn);
v = ARG(1,eqn);
if(equals(u,arg) && FUNCTOR(eqn) == '=' && !contains(v,FUNCTOR(u)))
break; /* found the definition */
}
if(i==n)
return 1; /* can't find the definition */
*next = make_term(AND,n);
HIGHLIGHT(v);
ARGREP(*next,i,ARG(i,t));
if(contains(t,DIFF))
{ for(j=0;j<n;j++)
{ if(problemtype == RELATED_RATES && PROTECTED(ARG(j,t)))
{ ARGREP(*next,j,ARG(j,t));
continue;
}
if(j!=i)
free_subst(v,u,ARG(j,t),ARGPTR(*next)+j);
}
}
else
{ for(j=0;j<n;j++)
{ if(j!=i)
subst(v,u,ARG(j,t),ARGPTR(*next)+j);
}
}
if(equals(t,*next))
return 1;
if(! ZERO(v))
UNLINEUP(*next); /* because now there are constants on the left */
strcpy(reason, english(393)); /* Substitute for */
strcat(reason, atom_string(arg));
SetShowStepArg(arg);
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int swapeqns(term t, term arg, term *next, char *reason)
/* arg is AND(i,j) or OR(i,j) where equations i and j should be swapped */
{ int i,j,k;
unsigned short n = ARITY(t);
if(FUNCTOR(t) != AND)
return 1;
if(FUNCTOR(arg) == ILLEGAL)
arg = and(one,two); /* e.g. if there are two equations only */
assert(ARITY(arg)==2);
assert(ISINTEGER(ARG(0,arg)));
assert(ISINTEGER(ARG(1,arg)));
i = (int) INTDATA(ARG(0,arg));
j = (int) INTDATA(ARG(1,arg));
assert(i>0 && i<=n && j>0 && j <=n);
*next = make_term(AND,n);
for(k=0;k<n;k++)
{ if(k!=i-1 && k!=j-1)
ARGREP(*next,k,ARG(k,t));
if(k==i-1)
ARGREP(*next,k,ARG(j-1,t));
if(k==j-1)
ARGREP(*next,k,ARG(i-1,t));
}
HIGHLIGHT(ARG(i-1,*next));
HIGHLIGHT(ARG(j-1,*next));
strcpy(reason, english(395)); /* swap equations */
if(LINEUP(t))
SET_LINEUP(*next);
return 0;
}
/*_______________________________________________________________*/
static int ordereqns_aux(const void *aptr, const void *bptr)
/* for use in qsort, sort equations according to the left side */
{ return addcompare(((term *) aptr)->args, ((term *) bptr)->args);
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int ordereqns(term t, term arg, term *next, char *reason)
/* permute the args of t so as to place them in correct
order, as determined by the additive order of the first
summand on the left side.
Usually used only after the equations are solved. */
{ int cnt=0; /* count the non-equations in t */
int i;
unsigned short n = ARITY(t);
if(FUNCTOR(t) != AND)
return 1;
for(i=0;i<n;i++)
{ if(ARITY(ARG(i,t)) != 2)
return 1;
if(FUNCTOR(ARG(i,t)) != '=')
++cnt;
if(!ISATOM(ARG(0,ARG(i,t))))
{ errbuf(0, english(396));
/* That operator is only for use after the */
errbuf(1, english(397));
/* equations are already all solved. */
return 1;
}
}
*next = make_term(AND,n);
for(i=0;i<n;i++)
ARGREP(*next,i,ARG(i,t)); /* copy to level 1 */
qsort(ARGPTR(*next),n,sizeof(term),ordereqns_aux);
if(equals(*next,t))
{ RELEASE(*next);
return 1;
}
if(cnt==0)
strcpy(reason, english(398)); /* rearrange equations */
else
strcpy(reason, english(399)); /* rearrange */
if(LINEUP(t))
SET_LINEUP(*next);
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int dropeqn(term t, term arg, term *next, char *reason)
/* drop any (or all) equations of the form u=u */
{ int i,k;
unsigned short n = ARITY(t);
unsigned short cnt = 0; /* count the terms not to be dropped */
int *scratchpad;
scratchpad = (int *) callocate(n,sizeof(int));
if(FUNCTOR(t) != AND)
return 1;
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,t)) == '=' && equals(ARG(0,ARG(i,t)),ARG(1,ARG(i,t))))
scratchpad[i] = 1; /* mark the terms to be dropped */
else
++cnt;
}
if(cnt == n) /* nothing to do */
{ free2(scratchpad);
return 1;
}
if(cnt == 1) /* all terms but one are being dropped */
{ for(i=0;i<n;i++)
{ if(scratchpad[i]==0)
{ *next = ARG(i,t);
if(n==2)
strcpy(reason, english(400)); /* drop identity */
else
strcpy(reason, english(401)); /* drop identities */
free2(scratchpad);
return 0;
}
}
assert(0); /* you must find the term to be dropped */
}
*next = make_term(AND,cnt);
k=0;
for(i=0;i<n;i++)
{ if(scratchpad[i]==0)
{ assert(k<cnt);
ARGREP(*next,k,ARG(i,t));
++k;
}
}
assert(k==cnt);
if(n-cnt == 1)
strcpy(reason, english(400)); /* drop identity */
else
strcpy(reason, english(401)); /* drop identities */
free2(scratchpad);
if(LINEUP(t))
SET_LINEUP(*next);
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int regardvarasconst(term t, term arg, term *next, char *reason)
/* arg is a variable, to be treated as a parameter */
/* in case treating arg as a constant creates a constant equation,
that equation will be 'checked' */
{ int err,i,j,k;
unsigned short n;
char tempbuf[128];
int cnt;
int *scratchpad;
term tt;
int nvariables,nvars,nparameters;
term *varlist, *atomlist;
term u;
parameter *parameters;
unsigned short f = FUNCTOR(t);
if(f != '=' && f != AND)
return 1;
if(f != AND && get_problemtype() == LINEAR_EQUATIONS)
return 1; /* you can't apply this to a single equation in a linear system */
nvariables = get_nvariables();
parameters = get_parameters();
nparameters = get_nparameters();
varlist = get_varlist();
if(FUNCTOR(arg) == ILLEGAL || !ISATOM(arg))
/* Not just FUNCTOR(arg) == ILLEGAL, because in automode
autoeqns can set *arg to other things than ILLEGAL. */
{ if(f == AND)
{ n = ARITY(t);
u = ARG(n-1,t);
}
else
u = t;
nvars = variablesin(u,&atomlist);
if(nvars <= 1)
{ free2(atomlist);
return 1;
}
/* don't just select atomlist[nvars-1] as the parameter as
for example the last line could be officially z-y although
as a linear system it will print as -y + z. So we need to
get the member of atomlist which comes last in varlist. */
for(i=nvariables-1;i>=0;i--)
{ for(j=0;j<nvars; j++)
{ if(FUNCTOR(atomlist[j])==FUNCTOR(varlist[i]))
break;
}
if(j < nvars)
break;
}
assert(i >= 0);
arg = varlist[i];
free2(atomlist);
}
else
{ for(i=0;i<nvariables;i++)
{ if(equals(varlist[i],arg))
break;
}
assert(i<nvariables); /* you must find it*/
}
/* Now arg is varlist[i] however we got here */
for(j=0;j<nparameters;j++)
{ if(parameters[j].index == i)
{ char temp[128];
strcpy(temp,atom_string(arg));
strcat(temp, english(402));
/* is already treated is constant. */
errbuf(0,temp);
return 1;
}
}
initialize_parameter(i,get_currentline()+1);
if(f == '=')
{ strcpy(tempbuf, english(408)); /* OK, from now on */
strcat(tempbuf, atom_string(arg));
strcat(tempbuf, english(409)); /* is constant. */
errbuf(0,tempbuf);
return 2; /* no visible result, so operator should fail; but it has
had its side effect. */
}
/* Now check to see if a constant equation has been created */
scratchpad = (int *) callocate(n,sizeof(int));
if(scratchpad == NULL)
{ nospace();
return 1;
}
cnt = 0;
for(j=0;j<n;j++)
{ if(constant(ARG(j,t)))
{ err = check(ARG(j,t));
if(err)
{ *next = false;
strcpy(tempbuf, english(403));
/* Equation */
itoa(j+1,tempbuf + 9,10);
strcat(tempbuf, english(404));
/* is not solvable. */
commentbuf(0,tempbuf);
free2(scratchpad);
return 0;
}
scratchpad[j] = 1; /* mark the indices of constant equations */
++cnt;
}
}
if(cnt) /* yes, there were constant equations created */
{ if(cnt == n)
{ free2(scratchpad);
errbuf(0, english(405));
/* That would make all the equations constant */
return 1;
}
if( cnt == n-1)
{ for(j=0;j<n;j++)
{ if(!scratchpad[j])
{ tt = ARG(j,t);
break;
}
}
}
else
{ tt = make_term(AND,(unsigned short)(n-cnt));
k = 0;
for(j=0;j<n;j++)
{ if(scratchpad[j] == 0)
{ ARGREP(tt,k,ARG(j,t));
++k;
}
}
}
}
else tt = t;
if(n-cnt > 1)
{ int saveit = LINEUP(tt);
UNLINEUP(tt); /* varsleft will fail immediately if LINEUP(tt) */
err = varsleft(tt,arg,next,reason);
if(saveit)
SET_LINEUP(*next);
}
else
{ vleftaux(tt,next);
err = equals(tt,*next);
}
if(!err)
{ strcpy(reason, english(406)); /* Regard */
strcat(reason,atom_string(arg));
strcat(reason, english(407)); /* as constant */
if(LINEUP(t))
SET_LINEUP(*next);
return 0;
}
/* if we get here, the variable in question only occurred on the right
in t, so there's no visible result. */
strcpy(tempbuf, english(408)); /* !From now on */
strcat(tempbuf, atom_string(arg));
strcat(tempbuf, english(409)); /* is constant. */
errbuf(0,tempbuf);
SetShowStepArg(arg);
SetShowStepOperation(regardvarasconst);
return 2; /* no visible result, so operator should fail; but it has
had its side effect. */
}
/*_______________________________________________________________*/
static int zero_vector(term a)
/* return 1 if a is a vector whose entries are all zero, or
floating-point numbers very close to zero; otherwise return 0.
*/
{ unsigned short n;
int i;
if(FUNCTOR(a) != VECTOR)
return 0;
n = ARITY(a);
for(i=0;i<n;i++)
{ if(!ISZERO(ARG(i,a)))
return 0;
}
return 1;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int dropzerocolumn(term t, term arg, term *next, char *reason)
/* t is a matrix equation. If there is a zero j-th column in the matrix
on the left side, drop it, producing a matrix equation with one less
column. The j-th variable thus disappears. The number of rows does
not change on the right side. */
{ unsigned short n,m;
term a,b,c,newb,newa,u;
int i,j,k,p;
if(FUNCTOR(t) != '=')
return 1;
if(FUNCTOR(ARG(0,t)) != '*' || ARITY(ARG(0,t)) != 2)
return 1;
a = ARG(0,ARG(0,t));
if(FUNCTOR(a) != MATRIX)
return 1;
n = ARITY(a); /* number of rows */
m = ARITY(ARG(0,a)); /* number of columns */
for(j=0;j<m;j++)
{ for(i=0;i<n;i++)
{ if(!ISZERO(ENTRY(i,j,a)))
break;
}
if(i==n)
{ /* the j-th column is zero */
break;
}
}
if(j==m)
return 1; /* did not find a zero column */
/* Now the j-th column is zero. Compute the answer */
b = ARG(1,ARG(0,t));
c = ARG(1,t);
assert(FUNCTOR(b)== VECTOR && ARITY(b) == m);
newb = make_term(VECTOR,(unsigned short)(m-1));
for(k=0;k<m-1;k++)
ARGREP(newb,k, k<j? ARG(k,b) : ARG(k+1,b)); /* skip the j-th arg */
newa = make_term(MATRIX,n);
for(k=0;k<n;k++)
{ u = make_term(VECTOR,(unsigned short)(m-1));
for(p=0;p<m-1;p++)
ARGREP(u,p,p<j? ENTRY(k,p,a) : ENTRY(k,p+1,a));
ARGREP(newa,k,u);
}
*next = equation(product(newa,newb),c);
strcpy(reason, english(1351)); /* drop zero column */
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int dropzerorow(term t, term arg, term *next, char *reason)
/* t is a matrix equation. If there is a zero i-th row in the matrix
on the left side, and the i-th row in the vector on the right is
also zero, drop the i-th row, producing a matrix equation with one
less row. */
{ unsigned short n,m;
term a,b,c,u,v,newa,newc;
int i,j,k;
if(FUNCTOR(t) != '=')
return 1;
if(FUNCTOR(ARG(0,t))==VECTOR && FUNCTOR(ARG(1,t)) == VECTOR)
{ a = ARG(0,t);
b = ARG(1,t);
n = ARITY(a);
assert(n == ARITY(b));
for(i=0;i<n;i++)
{ u = ARG(i,a);
v = ARG(i,b);
if(ISZERO(u) && ISZERO(v))
break;
}
if(i==n)
return 1; /* no zero row */
if(n==2)
{ *next = i ? equation(ARG(0,a),ARG(0,b)) : equation(ARG(1,a),ARG(1,b));
strcpy(reason,english(1352)); /* drop zero row */
return 0;
}
u = make_term(VECTOR,(unsigned short)(n-1));
v = make_term(VECTOR,(unsigned short)(n-1));
for(j=0;j<n-1;j++)
{ k = j < i ? j : j+1;
ARGREP(u,j,ARG(k,a));
ARGREP(v,j,ARG(k,b));
}
*next = equation(u,v);
strcpy(reason,english(1352)); /* drop zero row */
return 0;
}
if(FUNCTOR(ARG(0,t)) != '*' || ARITY(ARG(0,t)) != 2)
return 1;
a = ARG(0,ARG(0,t));
if(FUNCTOR(a) != MATRIX)
return 1;
n = ARITY(a); /* number of rows */
m = ARITY(ARG(0,a)); /* number of columns */
c = ARG(1,t);
b = ARG(1,ARG(0,t));
if(FUNCTOR(c) != VECTOR)
return 1;
/* Now search for a zero row */
for(i=0;i<n;i++)
{ if(ISZERO(ARG(i,c)))
{ for(j=0;j<m;j++)
{ if(!ISZERO(ENTRY(i,j,a)))
break;
}
if(j==m)
break; /* i-th row is zero */
}
}
if(i==n)
return 1; /* zero row not found */
newa = make_term(MATRIX,(unsigned short)(n-1));
if(n==2) /* create only a scalar on the right, not a dimension-1 vector;
but we do create a one-rowed matrix on the left, not a vector */
{ newc = i ? ARG(0,c) : ARG(1,c);
ARGREP(newa,0, i ? ARG(0,a) : ARG(1,a));
}
else
{ newc = make_term(VECTOR,(unsigned short)(n-1));
for(k=0;k<n-1;k++)
{ ARGREP(newa,k, k<i ? ARG(k,a) : ARG(k+1,a));
ARGREP(newc,k, k<i ? ARG(k,c) : ARG(k+1,c));
}
}
*next = equation(product(newa,b),newc);
strcpy(reason,english(1352)); /* drop zero row */
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int dropduplicaterow(term t, term arg, term *next, char *reason)
/* t is a matrix equation. If there are two identical rows i and q
(identical on both left and right), then drop the second one, producing
a matrix equation with one less row. */
{ unsigned short n,m;
term a,b,c,newa,newc;
int i,j,k,q;
if(FUNCTOR(t) != '=')
return 1;
if(FUNCTOR(ARG(0,t)) != '*' || ARITY(ARG(0,t)) != 2)
return 1;
a = ARG(0,ARG(0,t));
if(FUNCTOR(a) != MATRIX)
return 1;
n = ARITY(a); /* number of rows */
m = ARITY(ARG(0,a)); /* number of columns */
c = ARG(1,t);
if(FUNCTOR(c) != VECTOR)
return 1;
/* Now search for a duplicate row */
for(i=0;i<n;i++)
{ for(q = i+1; q <n; q++)
{ for(j=0;j<m;j++)
{ if(!equals(ENTRY(i,j,a), ENTRY(q,j,a)))
break;
}
if(j==m)
goto success; /* rows i and q are identical */
}
}
return 1;
success:
b = ARG(1,ARG(0,t));
newa = make_term(MATRIX,(unsigned short)(n-1));
if(n==2) /* create only a scalar on the right, not a dimension-1 vector;
but we do create a one-rowed matrix on the left, not a vector */
{ newc = i ? ARG(0,c) : ARG(1,c);
ARGREP(newa,0, i ? ARG(0,a) : ARG(1,a));
}
else
{ newc = make_term(VECTOR,(unsigned short)(n-1));
for(k=0;k<n-1;k++)
{ ARGREP(newa,k, k<q ? ARG(k,a) : ARG(k+1,a));
ARGREP(newc,k, k<q ? ARG(k,c) : ARG(k+1,c));
}
}
if(FUNCTOR(b) != VECTOR)
assert(0);
*next = equation(product(newa,b),newc);
strcpy(reason,english(1353)); /* drop duplicate row */
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int impossibleeqns(term t, term arg, term *next, char *reason)
/* check the current equations (or inequalities)
for a refutable equation or pair of equations.
Works when t is an AND of equations, or a single equation,
or a matrix equation AX = C or AX = BC
*/
{ int i,j,err;
term a,c,u,v,q;
unsigned short n = ARITY(t);
if(FUNCTOR(t) == '=' &&
FUNCTOR(ARG(0,t)) == VECTOR &&
FUNCTOR(ARG(1,t)) == VECTOR
)
{ a = ARG(0,t);
c = ARG(1,t);
n = ARITY(a);
assert(ARITY(c) == n);
for(i=0;i<n;i++)
{ u = ARG(i,a);
v = ARG(i,c);
if(NUMBER(u) && NUMBER(v) && !equals(u,v))
{ *next = false; /* but this PRINTS as "No solution" */
HIGHLIGHT(*next);
strcpy(reason, english(410)); /* contradiction */
return 0; /* success */
}
}
return 1;
}
if(FUNCTOR(t)== '=' && /* matrix equation AX = C */
FUNCTOR(ARG(0,t)) == '*' &&
ARITY(ARG(0,t)) == 2 &&
FUNCTOR(ARG(0,ARG(0,t))) == MATRIX
)
/* Check for a row of zeros on the left and a nonzero number on the
right in the corresponding row */
{ a = ARG(0,ARG(0,t)); /* the matrix */
c = ARG(1,t); /* the vector on the right */
n = ARITY(ARG(1,t)); /* number of rows */
if(FUNCTOR(c) == VECTOR)
{ for(i=0;i<n;i++)
{ if(zero_vector(ARG(i,a)) && !ISZERO(ARG(i,c)))
{ *next = false; /* but this PRINTS as "No solution" */
HIGHLIGHT(*next);
strcpy(reason, english(410)); /* contradiction */
return 0; /* success */
}
}
return 1;
}
return 1; /* here you can later deal with a matrix product on the right */
}
if(FUNCTOR(t) == '=')
{ err = refute(t);
if(err)
return 1;
}
else if(FUNCTOR(t) == AND)
{ for(i=0;i<n;i++)
{ q = ARG(i,t);
if(FUNCTOR(q) == '=' && NUMBER(ARG(0,q)) && NUMBER(ARG(1,q)))
err = equals(ARG(0,q),ARG(1,q)) ? 1 : 0;
else
{ UNSET_ALREADY(t); /* in case it somehow got set; if the
ALREADY bit is set, lpt won't work */
err = refute(q);
}
if(!err) /* refuted the i-th equation */
break;
}
if(i==n) /* none of the equations standing alone is refutable */
{ for(i=0;i<n;i++)
{ for(j=i+1;j<n;j++)
{ u = and(ARG(i,t),ARG(j,t));
err = refute(u);
RELEASE(u);
if(!err)
break;
}
if(j<n)
break;
}
}
if(i==n)
return 1; /* no refutation */
}
else
return 1; /* functors other than '=' or AND */
*next = false; /* but this PRINTS as "No solution" */
HIGHLIGHT(*next);
strcpy(reason, english(410)); /* contradiction */
return 0;
}
/*________________________________________________________________________*/
MEXPORT_ALGEBRA int solveone(term t, term arg, term *next, char *reason)
/* t is an AND, a system of linear equations. Arg is and(i,x),
where i is the equation number to solve (starting from one) and
x is the variable to solve for. Solve the indicated equation for
the indicated variable. */
{ int k,i,err;
term kk,x,u,v;
unsigned short n;
unsigned short path[5];
if(FUNCTOR(t) != AND)
return 1; /* only works on a system */
n = ARITY(t);
assert(FUNCTOR(arg) == AND); /* even in auto mode, arg is pre-set */
kk = ARG(0,arg);
assert(ISINTEGER(kk));
k = (int) INTDATA(kk); /* which equation to solve */
assert(k > 0);
--k; /* change to zero-origin numbering */
assert(k < n); /* enforced by get_arg */
x = ARG(1,arg);
if(!ISATOM(x))
{ errbuf(0, english(1316)); /* Can only solve for a variable. */
return 1;
}
u = ARG(k,t);
if(FUNCTOR(u) != '=')
return 1;
if(equals(ARG(0,u),x) && !contains(ARG(1,u),FUNCTOR(x)))
{ /* Equation ? is already solved for ? */
char buffer[32];
char temp[128];
strcpy(temp, english(1317)); /* Equation */
strcat(temp, itoa(k+1,buffer,10)); /* the number */
strcat(temp, english(1318)); /* is already solved for */
strcat(temp, atom_string(x));
errbuf(0,temp);
return 1;
}
err = solve_linear_ineq_for(u,x,&v);
if(err)
return 1;
HIGHLIGHT(v);
*next = make_term(AND,n);
for(i=0;i<n;i++)
ARGREP(*next,i, i==k ? v : ARG(i,t));
strcpy(reason, english(1453)); /* solve for */
strcat(reason,atom_string(x)); /* x */
path[0] = AND;
path[1] =(unsigned short)(k+1);
path[2] = 0;
set_pathtail(path);
SetShowStepOperation(solveselectedeqn);
return 0;
}
/*________________________________________________________________________*/
MEXPORT_ALGEBRA int solvelinearfor(term t, term arg, term *next, char *reason)
/* t is an equation. Arg is a variable. If the equation is linear
in arg, solve it for arg. Otherwise fail.
On the linear equations menus as "solve for ?"
*/
{ assert(ISATOM(arg));
assert(FUNCTOR(t) == '=');
if(!is_linear_in(t,arg))
{ errbuf(0, english(1452));
/* Equation is not linear in the selected variable. */
return 1;
}
solve_linear_ineq_for(t,arg,next);
strcpy(reason, english(1453)); /* solve for */
strcat(reason, atom_string(arg)); /* solve for x */
HIGHLIGHT(*next);
return 0;
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int eqnscancelterm(term t, term arg, term *next, char *reason)
/* cancel term from both sides (of all equations where it's possible) */
{ char buffer[128];
unsigned short n;
int i,err,count;
term u;
if(FUNCTOR(t) != AND)
return 1;
n = ARITY(t);
SETFUNCTOR(arg,ILLEGAL,0);
/* just to be sure an ILLEGAL goes to cancelterm */
*next = make_term(AND,n);
count = 0;
for(i=0;i<n;i++)
{ err = cancelterm(ARG(i,t),arg,&u,buffer);
if(err)
ARGREP(*next,i,ARG(i,t));
else
{ ARGREP(*next,i,u);
++count;
}
}
if(count == 0)
{ RELEASE(*next);
return 1;
}
if(count == 1)
strcpy(reason,buffer);
else
strcpy(reason,english(1324)); /* cancel term from both sides */
return 0;
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int eqnsaddterm(term t, term arg, term *next, char *reason)
/* Add ? to both sides of equation ? */
{ int k; /* add it to this equation, numbered from 1 */
term u; /* the thing to add */
unsigned short n;
int i,err;
term eqn; /* the equation to add it to */
term v; /* the result of adding it */
if(FUNCTOR(t) != AND)
return 1; /* it works on a system of linear equations */
n = ARITY(t);
assert(FUNCTOR(arg) == AND && ARITY(arg) == 2);
u = ARG(0,arg);
assert(ISINTEGER(ARG(1,arg)));
k = (int) INTDATA(ARG(1,arg));
assert(k > 0 && k <= ARITY(t));
eqn = ARG(k-1,t);
if(FUNCTOR(eqn) != '=')
return 1;
err = addeqn(eqn,u,&v,reason);
assert(!err);
*next = make_term(AND,n);
for(i=0;i<n;i++)
{ if(i+1==k)
ARGREP(*next,i,v);
else
ARGREP(*next,i,ARG(i,t));
}
return 0;
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int eqnssubterm(term t, term arg, term *next, char *reason)
/* Subtract ? from both sides of equation ? */
{ int k; /* subtract it from this equation, numbered from 1 */
term u; /* the thing to subtract */
int i,err;
unsigned short n;
term eqn; /* the equation to subtract it from */
term v; /* the result of the subtraction */
if(FUNCTOR(t) != AND)
return 1; /* it works on a system of linear equations */
n = ARITY(t);
assert(FUNCTOR(arg) == AND && ARITY(arg) == 2);
u = ARG(0,arg);
assert(ISINTEGER(ARG(1,arg)));
k = (int) INTDATA(ARG(1,arg));
assert(k > 0 && k <= ARITY(t));
eqn = ARG(k-1,t);
if(FUNCTOR(eqn) != '=')
return 1;
err = subeqn(eqn,u,&v,reason);
assert(!err);
*next = make_term(AND,n);
for(i=0;i<n;i++)
{ if(i+1==k)
ARGREP(*next,i,v);
else
ARGREP(*next,i,ARG(i,t));
}
return 0;
}
/*_______________________________________________________________*/
term distrib_and_polyval(term c, term t)
/* return something equal to ct after
distributing (if t is a sum) and simplifying each summand;
but don't polyval the whole sum lest it get contentfactored.
*/
{ term ans;
unsigned short n;
int i;
if(FUNCTOR(t) != '+')
{ polyval(product(c,t),&ans);
return ans;
}
n = ARITY(t);
ans = make_term('+',n);
for(i=0;i<n;i++)
polyval(product(c,ARG(i,t)),ARGPTR(ans) + i);
return ans;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists