Sindbad~EG File Manager
/* M. Beeson, for MathXpert */
/* classical formulas and methods for solving cubic equations */
/*
2.13.95 Original date
2.27.98 modified
1.7.00 modified viete
9.5.04 added checks for failure of getnewvar
3.17.06 polynoms was included twice, so I removed one.
5.20.13 added third argument to initialize_parameter call.
5.6.24 altered viete to not choose y if possible, because later
when you press the Graph button, it wants to choose "y",
which might be confusing.
7.24.24 changed reason string in viete to use $$
*/
#include <string.h>
#include <assert.h>
#include "globals.h"
#include "graphstr.h"
#include "cflags.h"
#include "deval.h"
#include "polynoms.h" /* makepoly */
#include "ops.h" /* makesubstitution */
#include "operator.h" /* cubic_equations */
#include "errbuf.h" /* errbuf */
#include "cflags.h" /* pushpending */
#include "pvalaux.h" /* square2 */
#include "factor.h" /* sqrt_aux */
#include "mstring.h" /* mstring */
#include "pstring.h" /* pstring */
#include "psubst.h" /* psubst */
#include "order.h" /* iscomplex */
#include "dispfunc.h" /* atom_string */
#include "mpmem.h" /* permcopy */
#include "prover.h" /* infer */
#include "mpdoc.h" /* controldata */
static int discriminant_line(term *D, term *d, term *eqn);
/*___________________________________________________________________*/
int eliminatequadraticterm(term t, term arg, term *next, char *reason)
/* Make the substitution x = u - p/3 where p is the
coefficient of the quadratic term, when the cubic term has coefficient 1.
When the equation is ax^3 + bx^2 + cx + d, the correct substitution is
u = x + b/3a */
{ int err;
POLYnomial q;
term r,x,p,s,u,a,poverthree;
int savenvariables;
int savefactorflag, savecomdenomflag;
if(FUNCTOR(t) != '=')
return 1;
if(!ZERO(ARG(1,t)))
return 1;
r = ARG(0,t);
if(FUNCTOR(r) != '+')
return 1;
savenvariables = get_nvariables();
x = get_eigenvariable();
err = makepoly(r,x,&q);
if(err)
return 1;
if(ARITY(q) != 4)
{ errbuf(0, english(1356));
/* Polynomial is not cubic */
return 1;
}
p = ARG(2,q);
if(ZERO(p))
{ errbuf(0, english(1355)); /* This polynomial has no quadratic term */
return 1;
}
u = getnewvar(r,"uvpqrst");
if(FUNCTOR(u) == ILLEGAL)
{ errbuf(0,english(551)); /* MathXpert can't handle any more variables! */
return 1;
}
a = ARG(3,q);
if(FRACTION(p))
poverthree = make_fraction(ARG(0,p),product3(three,a,ARG(1,p)));
else if(NEGATIVE(p) && FRACTION(ARG(0,p)))
poverthree = tnegate(signedfraction(ARG(0,ARG(0,p)),product3(three,a,ARG(1,ARG(0,p)))));
else
poverthree = signedfraction(p,product(three,a));
savefactorflag = get_polyvalfactorflag();
savecomdenomflag = get_polyvalcomdenomflag();
set_polyvalfactorflag(0);
set_polyvalcomdenomflag(0);
polyval(equation(x,sum(u,tnegate(poverthree))),&s);
set_polyvalfactorflag(savefactorflag);
set_polyvalcomdenomflag(savecomdenomflag);
err = reversesub(t,s,next,reason);
if(err)
/* reversesub shouldn't fail, but it does have a failure clause if
it can't verify that s is linear in x */
{ set_nvariables(savenvariables);
return 1;
}
inhibit(maximalsub); /* or it may get undone immediately */
return 0;
}
/*___________________________________________________________________*/
int computediscriminant(term t, term arg, term *next, char *reason)
/* Set D = b^2/4 + a^3/27 when t is an equation
in the form x^3 + ax + b = 0; or more generally set
D = (b/c)^2/4c + (a/c)^3/27
= b^2/4c^3 + a^3/27c^3
when t is an equation
of the form cx^3 + ax + b. This operator just displays
the definition of D; it is thus a 'specialop' in that
the active line will be the preceding one. Oops, user may
well want to simplify the discriminant, so maybe better
NOT make it a specialop.
*/
{ int err;
POLYnomial q;
term r,x,p,D,a,b,c,d,leftcopy,rightcopy;
int i,currentline;
if(FUNCTOR(t) != '=')
return 1;
if(!ZERO(ARG(1,t)))
return 1;
r = ARG(0,t);
if(FUNCTOR(r) != '+')
return 1;
i = discriminant_line(&a,&b,&c);
if(i >= 0)
{ errbuf(0, english(1360));
/* You have already computed the discriminant */
return 1;
}
x = get_eigenvariable();
err = makepoly(r,x,&q);
if(err)
return 1;
if(ARITY(q) != 4)
{ errbuf(0, english(1356));
/* Polynomial is not cubic */
return 1;
}
p = ARG(2,q);
if(!ZERO(p))
{ errbuf(0, english(1357));
/* First eliminate the quadratic term by u = x + b/3 */
return 1;
}
a = ARG(1,q);
b = ARG(0,q);
c = ARG(3,q);
d = sum(
make_fraction(make_power(b,two), ONE(c) ? four : product(four, make_power(c,two))),
make_fraction(make_power(a,three),ONE(c) ? make_int(27L) : product(make_int(27L),make_power(c,three)))
);
D = getnewvar(r,"DdCcAaBb");
permcopy(D,&leftcopy);
permcopy(d,&rightcopy);
let_permanent(leftcopy,rightcopy); /* don't change the eigenvariable, and don't
unwind this definition in auto mode */
set_valuepointers(&D);
initialize_parameter(get_nvariables()-1, get_currentline() + 1, 1.0); /* make sure D satisfies 'constant' */
SETDEPENDENT(D);
*next = equation(D,d);
HIGHLIGHT(*next);
strcpy(reason, english(1367)); /* compute discriminant */
currentline = get_currentline();
pushpending(history(currentline),currentline); /* so showcallingcubic can recall it */
return 0;
}
/*___________________________________________________________________*/
static int discriminant_line(term *D, term *d, term *eqn)
/* go back over the solution till you come to a line
where computediscrimant was used. If you don't find it,
return -1. If you do find it, get the letter used for
the discriminant and the expression for the discriminant
in *D and *d, and the equation itself in *eqn, and return
the line number containing the equation, just before
computediscriminant was used. */
{ int nextdefn = get_nextdefn();
int i;
int currentline;
controldata p;
if(nextdefn == 0)
return -1; /* computeddiscriminant leaves a definition */
currentline = get_currentline();
get_controldata(&p);
for(i=currentline; i > 0; i--)
{ if(p.opseq[i].men == cubic_equations &&
p.opseq[i].choice == 2
)
break;
}
if(i == 0)
return -1;
assert(i > 0);
*D = ARG(0,history(i));
*d = ARG(1,history(i));
*eqn = history(i-1);
return i-1;
}
/*____________________________________________________________________*/
int showcallingcubic(term t, term arg, term *next, char *reason)
/* show the cubic equation again after simplifying the discriminant. */
{ int err = poppending(next);
if(err)
return 1;
strcpy(reason, english(3)); /* show equation again */
return 0;
}
/*___________________________________________________________________*/
int realcardan(term t, term arg, term *next, char *reason)
/* This is a duplicate of cardan, but it's used when complex numbers
are off, so it gets a different status line help. */
{ return cardan(t,arg,next,reason);
}
/*___________________________________________________________________*/
int cardan(term t, term arg, term *next, char *reason)
/* This formula is used in automode only when the
discriminant is positive. In that case there will be
one real and two conjugate complex roots.
The formula as it is in books involves a cube root. Because
the meaning of the cube root of a negative quantity depends on
whether complex roots are being used or not (at least in MathXpert),
we have to make sure we only put a positive quantity under the
cube root sign. (Otherwise if complex roots are used, the "roots"
given by the formula are not correct.)
*/
{ term d,D,Dsq,x,r,A,B,minusbover2c, minusbover2c2,realpart,imagpart;
term a,b,bsq,c,ccube;
int err,signb,signa,signB;
if(FUNCTOR(t) != '=')
return 1;
if(!ZERO(ARG(1,t)))
return 1;
x = get_eigenvariable();
err = makepoly(ARG(0,t),x,&r);
if(err)
return 1;
if(ARITY(r) != 4)
return 1;
if(!ZERO(ARG(2,r)))
{ errbuf(0,english(4)); /* Coefficient of x^2 must be zero. */
return 1;
}
c = ARG(3,r);
b = ARG(0,r);
a = ARG(1,r);
err = infer(le(zero,c));
if(err)
{ err = infer(le(c,zero));
if(err)
{ errbuf(0,english(1566));
/* Cannot determine the sign of the cubic term. */
return 1;
}
c = tnegate(c);
b = tnegate(b);
a = tnegate(a);
}
if(!infer(le(zero,b)))
signb = 1;
else if(!infer(le(b,zero)))
signb = -1;
else
{ errbuf(0,english(74));
/* Cannot determine the sign of the constant term. */
return 1;
}
if(!infer(le(zero,a)))
signa = 1;
else if(!infer(le(a,zero)))
signa = -1;
else
{ errbuf(0, english(1565));
/* Cannot determine the sign of the linear term. */
return 1;
}
/* Now to determine the sign of -b/2 - sqrt(D) where D = b^2/4c^2 + a^3/27c^3 */
if(signb == 1 || signa == 1)
signB = -1;
else /* b and a both negative */
signB = 1;
polyval(tnegate(signedfraction(b,product(two,c))),&minusbover2c);
copy(minusbover2c,&minusbover2c2); /* avoid DAGs */
ccube = ONE(c) ? make_int(27L) : product(make_int(27L),make_power(c,three));
bsq = ONE(c) ? four : product(four,square2(c));
d = sum(
make_fraction(square2(b), bsq),
make_fraction(make_power(a,three),ccube)
);
polyval(d,&Dsq);
err = infer(le(zero,Dsq));
if(err)
{ errbuf(0, english(1563)); /* Discriminant must be non-negative */
return 1;
}
err = sqrt_aux(Dsq,&D);
if(err)
D = make_sqrt(Dsq);
A = make_root(three,sum(minusbover2c, D));
if(signB == 1)
B = make_root(three,sum(minusbover2c,tnegate(D)));
else
B = tnegate(make_root(three,sum(tnegate(minusbover2c),D)));
if(!get_complex())
{ *next = equation(x,sum(A,B)); /* only one real root */
HIGHLIGHT(*next);
strcpy(reason,english(1568)); /* cubic formula */
return 0;
}
*next = make_term(OR,3);
ARGREP(*next,0, equation(x,sum(A,B)));
realpart = tnegate(product(make_fraction(one,two),sum(A,B)));
imagpart = product3(signedfraction(make_sqrt(three),two),sum(A,tnegate(B)), complexi);
ARGREP(*next,1, equation(x,sum(realpart,imagpart)));
ARGREP(*next,2, equation(x,sum(realpart, tnegate(imagpart))));
HIGHLIGHT(*next);
strcpy(reason, english(1568)); /* cubic formula */
return 0;
}
/*___________________________________________________________________*/
int cardan2(term t, term arg, term *next, char *reason)
/* Introduce theta by cos theta = -b/(2sqrt(-a^3/27)); when
the discriminant is negative, the quantity on the right is between
-1 and 1. This operator makes that definition and solves the
equation in terms of theta.
*/
{ term d,Dsq,x,r,minusbover2c, minusbover2c2;
term a,minusa,b,bsq,c,ccube,theta,p;
int err;
x = get_eigenvariable();
if(FUNCTOR(t) != '=')
return 1;
if(!ZERO(ARG(1,t)))
return 1;
err = makepoly(ARG(0,t),x,&r);
if(err)
return 1;
if(ARITY(r) != 4)
return 1;
if(!ZERO(ARG(2,r)))
{ errbuf(0,english(4)); /* Coefficient of x^2 must be zero. */
return 1;
}
c = ARG(3,r);
b = ARG(0,r);
a = ARG(1,r);
if(NEGATIVE(c))
{ c = tnegate(c);
b = tnegate(b);
minusa = a;
a = tnegate(a);
}
else
minusa = tnegate(a);
polyval(tnegate(signedfraction(b,product(two,c))),&minusbover2c);
copy(minusbover2c,&minusbover2c2); /* avoid DAGs */
ccube = ONE(c) ? make_int(27L) : product(make_int(27L),make_power(c,three));
bsq = ONE(c) ? four : product(four,square2(c));
d = sum(
make_fraction(square2(b), bsq),
make_fraction(make_power(a,three),ccube)
);
polyval(d,&Dsq);
err = infer(lessthan(Dsq,zero));
if(err)
{ errbuf(0,english(1564)); /* Discriminant must be negative */
return 1;
}
theta = getnewvar(t,"theta");
if(FUNCTOR(theta) == ILLEGAL)
{ errbuf(0,english(551)); /* MathXpert can't handle any more variables! */
return 1;
}
polyval(product(tnegate(signedfraction(b,two)),
make_sqrt(make_fraction(product(make_int(27L),c),make_power(minusa,three)))
),
&r
);
permcopy(acos1(r),&p);
let_permanent(theta,p);
*next = make_term(OR,3);
ARGREP(*next,0, equation(x,product3(two,make_sqrt(make_fraction(minusa,three)),cos1(make_fraction(theta,three)))));
ARGREP(*next,1, equation(x,product3(two,make_sqrt(make_fraction(minusa,three)),cos1(make_fraction(sum(theta,product(two,pi_term)),three)))));
ARGREP(*next,2, equation(x,product3(two,make_sqrt(make_fraction(minusa,three)),cos1(make_fraction(sum(theta,product(four,pi_term)),three)))));
HIGHLIGHT(*next);
strcpy(reason, english(1568)); /* cubic formula */
strcat(reason, ", ");
strcat(reason, english(2219)); /* "where cos */
strcat(reason, atom_string(theta));
strcat(reason, "$ = -b/2\\sqrt(27c/a^3)$");
strcat(reason, " ");
strcat(reason, english(2220)); /* in */
strcat(reason, " ");
strcat(reason, "cx^3-ax+b=0");
return 0;
}
/*____________________________________________________________________*/
int viete(term t, term arg, term *next, char *reason)
/* Make the substitution x = y - a/(3cy) in a cubic cx^3 + ax + b = 0.
This substitution was discovered by Viete in 1592. It will result in
an equation quadratic in y^3, yielding two real roots for y if
the quadratic has a real root. Both roots for y give the same
real root for x, although the equality of the roots is usually
not obvious.
*/
{ term x,a,c,y,u,uperm;
POLYnomial p;
int err;
if(FUNCTOR(t) != '=')
return 1;
if(!ZERO(ARG(1,t)))
{ errbuf(0,english(1582));
/* Right side of equation must be zero. */
return 1;
}
x = get_eigenvariable();
err = makepoly(ARG(0,t),x,&p);
if(err || ARITY(p) != 4 || !ZERO(ARG(2,p)))
{ errbuf(0,english(1580));
/* Equation must be a cubic with no quadratic term. */
return 1;
}
a = ARG(1,p);
if(ZERO(a))
return 1; /* don't apply this operation when there's no linear term. */
c = ARG(3,p);
y = getnewvar(t,"xztuvpqrsy");
if(ONE(c))
u = sum(y, tnegate(signedfraction(a,product(three,y))));
else
u = sum(y, tnegate(signedfraction(a,product3(three,c,y))));
HIGHLIGHT(u);
PROTECT(u); /* so common denoms etc aren't used before cubing it out */
permcopy(u,&uperm);
reverse_let(x,uperm);
/* the new variable becomes the eigenvariable, but not till AFTER
reverse_let, so that the .oldeigen field in the definition is
correctly set. If not, undo will crash.
*/
set_eigenvariable(get_nvariables()-1);
psubst(u,x,t,next);
strcpy(reason,"$$");
pstring(equation(x,u),reason+2,DIMREASONBUFFER); // 9.24.25 changed from MAXREASONSTRING
// if it's too short, pstring produces a truncated, hence unparseable, string,
// and that causes an assertion faile. DIMREASONBUFFER is 300, should be long enough.
// MAXREASONSTRING is still just 21.
strcat(reason,"$$");
/*
char buf[128];
strcpy(reason, atom_string(x));
strcat(reason, " = ");
mstring(u,buf);
strcat(reason,buf);
*/
release(maximalsub); /* in case eliminatequadraticterm inhibited it */
inhibit(commondenom);
inhibit(commondenom2);
inhibit(commondenomandsimp);
inhibit(commondenomandsimp2);
return 0;
}
/*______________________________________________________________*/
/* In cubic equations, we arrive at a line like
x = r e^((2k+1)pi i/3) + se^-(2k+1)pi i/3)
x = s e^((2n+1)pi i/3) + re^-(2n+1)pi i/3)
In fact these two "solutions" each represent the
same three numbers, as can be seen by setting
(2k+1)pi i/3 = -(2n+1)pi i/3 and solving for n to get
n = 1-k.
We want to show this in MathXpert by having the
next line show two copies of the first equation,
with the second one highlighted and the
justification n = 1-k. After that the duplicate
equation will be dropped, of course.
In general, one existential integer variable
n can be replaced by n = f(n) provided f is a
exist(n, P(n)) is equivalent to exists(k, P(f(k)),
which will be true if the range of f includes all integers.
Certainly the most common functions onto Z are linear
functions of the form f(k) = k+a or f(k) = a-k; these
operations will be provided.
*/
/*_____________________________________________________________*/
int translatevar(term t, term arg, term *next, char *reason)
/* n = ? - k */
/* arg will be such an equation. But checkarg only checks that
it has the form n = f(k), not that k is one-one
*/
{ term m,def,temp;
term *varlist;
int nvariables,i,j,retval,err;
term u,v;
term nn,kk;
term a[2][2];
term c[2][2];
term *atomlist;
int nvars;
if(FUNCTOR(arg) == ILLEGAL)
{ /* called in auto mode on complex cubic equations */
if(FUNCTOR(t) != OR)
return 1;
if(ARITY(t) != 2)
return 1;
for(i=0;i<2;i++)
{ if(!ISATOM(ARG(0,ARG(i,t))))
return 1;
u = ARG(1,ARG(i,t));
if(FUNCTOR(u) != '+' || ARITY(u) != 2)
return 1;
for(j=0;j<2;j++)
{ v = ARG(j,u);
if(FUNCTOR(v) != '*' || !seminumerical(ARG(0,v)) ||
FUNCTOR(ARG(1,v)) != '^' ||
!equals(ARG(0,ARG(1,v)),eulere) ||
!iscomplex(ARG(1,ARG(1,v)))
)
return 1;
a[i][j] = ARG(1,ARG(1,v));
c[i][j] = ARG(0,v);
}
}
if(!equals(c[0][0],c[1][1]))
return 1;
if(!equals(c[0][1],c[1][0]))
return 1;
/* Now get the two numerical variables in question */
nvars = variablesin(a[0][0],&atomlist);
nn = atomlist[0];
free2(atomlist);
if(nvars != 1)
return 1;
nvars = variablesin(a[1][0],&atomlist);
kk = atomlist[0];
free2(atomlist);
if(nvars != 1)
return 1;
if(equals(nn,kk))
return 1;
for(j=0;j<2;j++)
{ subst(kk,nn,a[0][j],&temp);
if(!equals(temp,a[1][j]))
return 1;
}
arg = equation(nn,sum(minusone,tnegate(kk)));
}
if(FUNCTOR(arg) != '=')
return 1; /* assert(0) */
m = ARG(0,arg);
def = ARG(1,arg);
if(!ISATOM(m))
return 1;
/* m should be an integer existential variable, but at the moment
it has zero .info field, having just been read by getarg.
However, it's supposed to be in the varlist already. Let's
find it there. */
varlist = get_varlist();
nvariables = get_nvariables();
for(i=0;i<nvariables;i++)
{ if(equals(varlist[i],m))
break;
}
if(i==nvariables)
return 1; /* assert(0); checkarg has checked that this variable is already present */
m = varlist[i]; /* thus setting the info field. */
if(TYPE(m) != INTEGER)
return 1;
if(!ISEXISTENTIALVAR(m))
return 1;
if(FUNCTOR(def) == '-' && ISATOM(ARG(0,def)))
goto out;
if(FUNCTOR(def) == '+' && ARITY(def) == 2 &&
isinteger(ARG(0,def)) &&
NEGATIVE(ARG(1,def)) && ISATOM(ARG(0,ARG(1,def)))
)
goto out;
if(FUNCTOR(def) == '+' && ARITY(def) == 2 &&
isinteger(ARG(1,def)) &&
NEGATIVE(ARG(0,def)) && ISATOM(ARG(0,ARG(0,def)))
)
goto out;
if(FUNCTOR(def) == '+' && ARITY(def) == 2 &&
ISATOM(ARG(0,def)) && isinteger(ARG(1,def))
)
goto out;
return 1;
out:
retval = 1;
*next = make_term(OR,2);
for(i=0;i<2;i++)
{ err = reversesub(ARG(i,t),arg,ARGPTR(*next)+i,reason);
if(err)
ARGREP(*next,i,ARG(i,t));
else
retval = 0;
}
return retval;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists