Sindbad~EG File Manager
/*
M. Beeson, for MathXpert
modified 3.30.99
1.4.00 corrected reason string of isinh
1.3.00 added four new operators, itanh, icoth, tanhi, cothi
operators for complex numbers and functions
1.15.00 added code to exponential_subterm and to explicitparams
2.3.00 added code to complexform to make it fail if it does nothing
6.20.04 modified rectangulartopolar
9.5.04 added checks for failure of getnewvar
*/
#define ALGEBRA_DLL
#include <string.h>
#include <assert.h>
#include <math.h>
#include "globals.h"
#include "ops.h"
#include "cancel.h"
#include "prover.h"
#include "checkarg.h"
#include "complex.h"
#include "algaux.h"
#include "order.h"
#include "deval.h"
#include "simpprod.h"
#include "trig.h"
#include "pvalaux.h" /* complexparts */
#include "symbols.h"
#include "errbuf.h"
#include "cancel.h" /* cancel */
#include "autosimp.h" /* SetShowStepOperation */
#include "psubst.h"
#include "autotrig.h"
#include "dcomplex.h" /* ceval needs it */
#include "ceval.h" /* complexnumerical */
#include "calc.h"
#include "pathtail.h" /* set_pathtail */
static void real_and_complex_factors(term t, term *r, term *c);
static int exponential_subterm(term t, term k, term *u, long *N);
static int ispolarform(term u, term *r, term *theta);
static int contains_badi(term t);
/*_______________________________________________________________*/
/* i^2 = -1 */
MEXPORT_ALGEBRA int defnofi(term t, term arg, term *next, char *reason)
{ if(FUNCTOR(t) != '^')
return 1;
if(!equals(ARG(0,t),complexi))
return 1;
if(!equals(ARG(1,t),two))
return 1;
*next = minusone;
HIGHLIGHT(*next);
strcpy(reason,"$i^2 = -1$");
release(cancelop); /* possibly inhibited by cleardenomofi */
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int powersofi0(term t, term arg, term *next, char *reason)
/* i^(4n) = 1 */
{ int err;
term n,cancelled,m;
if(FUNCTOR(t) != '^')
return 1;
if(!equals(ARG(0,t),complexi))
return 1;
n = ARG(1,t);
if(!isinteger(n))
return 1; /* don't bother with 'infer' */
err = cancel(n,four,&cancelled,&m);
if(err || !equals(cancelled,four))
return 1;
if(equals(n,four))
strcpy(reason,"i^4 = 1");
else
strcpy(reason,"i^(4k) = 1");
*next = one;
HIGHLIGHT(*next);
return 0;
}
/*_________________________________________________________________*/
MEXPORT_ALGEBRA int powersofi1(term t, term arg, term *next, char *reason)
/*i^(4n+1) = i */
{ int err;
term n,cancelled,m,temp;
if(FUNCTOR(t) != '^')
return 1;
if(!equals(ARG(0,t),complexi))
return 1;
n = ARG(1,t);
if(!isinteger(n))
return 1; /* don't bother with 'infer' */
err = polyval(sum(n,minusone),&temp);
if(err)
{ destroy_term(temp);
return 1;
}
err = cancel(temp,four,&cancelled,&m);
if(err || !equals(cancelled,four))
return 1;
strcpy(reason,"i^(4n+1) = i");
*next = complexi;
HIGHLIGHT(*next);
return 0;
}
/*________________________________________________________________*/
MEXPORT_ALGEBRA int powersofi3(term t, term arg, term *next, char *reason)
/* i^(4n+3) = -i */
{ int err;
term n,cancelled,m,temp;
if(FUNCTOR(t) != '^')
return 1;
if(!equals(ARG(0,t),complexi))
return 1;
n = ARG(1,t);
if(!isinteger(n))
return 1; /* don't bother with 'infer' */
err = polyval(sum(n,one),&temp);
if(err)
{ destroy_term(temp);
return 1;
}
err = cancel(temp,four,&cancelled,&m);
if(err || !equals(cancelled,four))
return 1;
if(equals(n,three))
strcpy(reason, "i^3 = -i");
else
strcpy(reason, "i^(4n+3) = -i");
tneg(complexi,next);
HIGHLIGHT(*next);
return 0;
}
/*________________________________________________________________*/
MEXPORT_ALGEBRA int powersofi2(term t, term arg, term *next, char *reason)
/* i^(4n+2) = -1 */
{ int err;
term n,cancelled,m,temp;
if(FUNCTOR(t) != '^')
return 1;
if(!equals(ARG(0,t),complexi))
return 1;
n = ARG(1,t);
if(!isinteger(n))
return 1; /* don't bother with 'infer' */
err = polyval(sum(n,two),&temp);
if(err)
{ destroy_term(temp);
return 1;
}
err = cancel(temp,four,&cancelled,&m);
if(err || !equals(cancelled,four))
return 1;
copy(minusone,next);
if(equals(n,two))
strcpy(reason, "i^2 = -1");
else
strcpy(reason, "i^(4n+2) = -1");
HIGHLIGHT(*next);
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int sqrtofminus1(term t, term arg, term *next, char *reason)
{ if(FUNCTOR(t) != SQRT)
return 1;
if(!equals(ARG(0,t),minusone))
return 1;
*next = complexi;
strcpy(reason,"$�(-1) = i$");
HIGHLIGHT(*next);
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int sqrtofneg(term t, term arg, term *next, char *reason)
{ term u; /* works on sqrt(-u) */
int err;
if(FUNCTOR(t) != SQRT)
return 1;
if(contains(t,LIMIT))
{ errbuf(0, english(1958));
/* First evaluate the limit. */
return 1;
}
if(FUNCTOR(ARG(0,t)) == '-')
{ u = ARG(0,ARG(0,t));
if(iscomplex(u))
return 1;
err = check(nonnegative(u));
if(err)
return 1;
}
else if(iscomplex(ARG(0,t)))
return 1;
else if(obviously_negative(ARG(0,t)))
u = strongnegate(ARG(0,t));
else
return 1;
*next= product(complexi,make_sqrt(u));
strcpy(reason, english(2182)); /* $�(-a) = i�a$ if $a�0$ */
HIGHLIGHT(*next);
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int cleardenomofi(term t, term arg, term *next, char *reason)
/* a/b => a/b * conjugate(b)/conjugate(b) */
/* On the menus, "clear denominator of i" */
{ term b,bstar,temp,cancelled;
int err;
if(FUNCTOR(t) != '/')
return 1;
b = ARG(1,t);
if(!iscomplex(b))
return 1; /* without further ado */
if(FUNCTOR(b) == '*')
{ err = cancel(b,complexi,&cancelled,&temp);
if(!err && !contains(temp,'i'))
{ bstar = complexi;
err = 0;
}
else
{ term c,s;
real_and_complex_factors(b,&c,&s);
err = complex_conjugate(s,&bstar);
}
}
else if(equals(b,complexi))
{ bstar = complexi;
err = 0;
}
else
err = complex_conjugate(b,&bstar);
if(err)
return 1;
if(!equals(bstar,complexi))
{ err = check(nonzero(bstar));
if(err)
return 1;
}
else if(get_mathmode() == AUTOMODE)
return 1; /* use a/bi = -ai/b instead */
temp = make_fraction(bstar,bstar);
HIGHLIGHT(temp);
*next = product(t,make_fraction(bstar,bstar));
HIGHLIGHT(*next);
inhibit(cancelop); /* or we get an immediate loop */
inhibit(sumofsquares); /* which factors a^2+b^2=(a-bi)(a+bi), resulting in a loop */
strcpy(reason, english(1326)); /* clear denom of i */
return 0;
}
/*_______________________________________________________________*/
static int get_sign(term x, int *sign)
/* Determine the sign of x if possible, returning it in *sign:
1 for positive, -1 for negative, 0 for zero.
Return value is 0 for success, 1 for failure to infer the sign.
*/
{ double z;
long kk;
int err;
if(seminumerical(x))
{ deval(x,&z);
if(z==BADVAL)
return 1;
if(nearint(z,&kk) && kk==0)
{ *sign = 0;
return 0;
}
*sign = z > 0.0 ? 1 : -1;
return 0;
}
if(obviously_positive(x))
return 1;
if(obviously_negative(x))
return -1;
err = infer(lessthan(zero,x));
if(!err)
{ *sign = 1;
return 0;
}
err = infer(lessthan(x,zero));
if(!err)
{ *sign = -1;
return 0;
}
err = infer(equation(zero,x));
if(!err)
{ *sign = 0;
return 0;
}
return 1;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int minustopolar(term t, term arg, term *next, char *reason)
/* -a = ae^(pi i) */
{ term a;
if(!NEGATIVE(t) && !obviously_negative(t))
return 1;
if(NEGATIVE(t))
a = ARG(0,t);
else if(FUNCTOR(t) == '+')
a = strongnegate(t);
else
a = tnegate(t);
*next = product(a,make_power(eulere,product(pi,complexi)));
HIGHLIGHT(*next);
strcpy(reason, "$-a = ae^(�i)$");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int rectangulartopolar(term t, term arg, term *next, char *reason)
/* Convert a complex number to polar form.
The argument is between -pi and pi.
Don't do anything if t is real and positive.
In the case of a pure imaginary like xi, it will assume x > 0
if it can't prove or refute it.
*/
{ term x,y,r,theta,temp,u,c,a,b,cancelled;
int err,st,signx,signy;
unsigned short path[5];
char localbuf[DIMREASONBUFFER];
if(FUNCTOR(t) == '^' && equals(ARG(0,t),complexi))
{ rectangulartopolar(complexi,arg,&temp,reason);
*next = make_power(temp,ARG(1,t));
path[0] = '^';
path[1] = 1;
path[2] = 0;
set_pathtail(path);
return 0;
}
if(ISATOM(t) && TYPE(t) == DCOMPLEX)
{ // we must invent new variables r and theta
r = getnewvar(t,"r");
theta = getnewvar(t,"theta");
if(FUNCTOR(r) == ILLEGAL || FUNCTOR(theta) == ILLEGAL)
{ errbuf(0,english(551)); /* MathXpert can't handle any more variables */
return 1;
}
assume(le(zero,r));
assume(and(lessthan(tnegate(pi),theta),le(theta,pi)));
SETTYPE(r,R);
SETTYPE(theta,R);
*next = product(r,make_power(eulere, product(complexi,theta)));
reversesub(t,equation(t,*next),next,reason);
strcpy(reason,english(1588)); /* polar form */
HIGHLIGHT(*next);
return 0;
}
if(!iscomplex(t))
{ if(obviously_positive(t))
return 1;
signy = 0;
if(NEGATIVE(t) && obviously_positive(ARG(0,t)))
{ x = t;
y = zero;
signx = -1;
err = 0;
}
else
{ err = get_sign(t,&signx);
if(err || signx > 0)
return 1;
}
}
else
{ err = complexparts(t,&x,&y);
if(err)
return 1;
}
if(ZERO(y))
{ /* real input, but it may be negative */
if(obviously_nonnegative(x))
{ errbuf(0,english(1820));
/* That nonnegative expression is already in polar form. */
return 1;
}
if(obviously_negative(x))
{ theta = pi;
r = strongnegate(x);
c = one;
goto out;
}
return 1; /* don't mess around with infer */
}
if(ZERO(x))
/* a pure imaginary number */
{ err = get_sign(y,&signy);
if(err)
{ if(NEGATIVE(y))
{ err = check(lessthan(zero,ARG(0,y)));
if(!err)
{ signy = -1;
commentbuf(0,english(2374));
/* !Assuming that the radius is positive. */
}
}
else
{ err = check(lessthan(zero,y));
if(!err)
{ signy = 1;
commentbuf(0,english(2374));
/* !Assuming that the radius is positive. */
}
}
}
if(err)
{ errbuf(0, english(1361));
/* Can't determine which quadrant this number lies in. */
return 1;
}
if(signy > 0)
theta = make_fraction(pi,two);
else
theta = tnegate(make_fraction(pi,two));
r = signy > 0 ? y : tnegate(y);
c = one;
goto out;
}
st = status(rectangulartopolar);
naive_gcd(x,y,&c);
if(!ONE(c))
{ if(!cancel(x,c,&cancelled,&a) && !cancel(y,c,&cancelled,&b))
/* supposedly the naive_gcd must always cancel out, so the
'else' clause should be unnecessary, but let's be defensive. */
{ x = a;
y = b;
}
else
c = one;
}
if(FUNCTOR(y) == SIN && FUNCTOR(x) == COS && equals(ARG(0,x),ARG(0,y)))
{ r = one;
theta = ARG(0,x);
goto out;
}
if(NEGATIVE(x) && FUNCTOR(ARG(0,x)) == COS && FUNCTOR(y) == SIN &&
equals(ARG(0,ARG(0,x)),ARG(0,y))
) /* - cos u + sin u */
{ r = one;
theta = sum(pi,tnegate(ARG(0,y)));
goto out;
}
if(NEGATIVE(y) && FUNCTOR(ARG(0,y)) == SIN && FUNCTOR(x) == COS &&
equals(ARG(0,ARG(0,y)),ARG(0,x))
) /* cos u - sin u */
{ r = one;
theta = tnegate(ARG(0,x));
goto out;
}
if(NEGATIVE(x) && NEGATIVE(y) && FUNCTOR(ARG(0,x)) == COS &&
FUNCTOR(ARG(0,y)) == SIN && equals(ARG(0,ARG(0,x)),ARG(0,ARG(0,y)))
) /* -cos u - sin u */
{ r = one;
theta = sum(ARG(0,ARG(0,x)),pi);
goto out;
}
r = make_sqrt(sum(square(x),square(y)));
/* Now we have to determine the sign of the real part */
if( get_sign(x,&signx) || get_sign(y,&signy))
{ errbuf(0, english(1361));
/* Can't determine which quadrant this number lies in. */
return 1;
}
if(signx == 0)
/* a pure imaginary number */
theta = signy > 0 ? piover2 : tnegate(make_fraction(pi,two));
else if(st > LEARNING)
{ err = polyval(r,&temp);
if(!err)
r = temp;
polyval(make_fraction(y,x),&temp);
if(NEGATIVE(temp))
{ theta = tnegate(atan1(temp));
err = evalarctan(ARG(0,theta),arg,&temp,localbuf);
if(!err)
{ RELEASE(theta);
theta = tnegate(temp);
}
}
else
{ theta = atan1(temp);
err = evalarctan(theta,arg,&temp,localbuf);
if(!err)
theta = temp;
}
if(signx < 0 && signy < 0)
{ polyval(sum(theta,tnegate(pi)),&u);
theta = u;
}
if(signx < 0 && signy > 0)
{ polyval(sum(pi,tnegate(theta)),&u);
theta = u;
}
}
else
{ theta = atan1(make_fraction(y,x));
if(signx < 0 && signy < 0)
theta = sum(theta,tnegate(pi));
else if(signx < 0 && signy > 0)
theta = sum(theta,pi);
}
out:
if(!ONE(c))
polyval(product(c,r),&r);
if(FRACTION(theta))
{ mfracts(theta,complexi,&u);
if(FUNCTOR(u) == '*')
sortargs(u);
if(FRACTION(u))
{ if(FUNCTOR(ARG(0,u)) == '*')
sortargs(ARG(0,u));
}
}
else if(NEGATIVE(theta) && FRACTION(ARG(0,theta)))
{ term v;
mfracts(ARG(0,theta),complexi,&v);
if(FUNCTOR(v) == '*')
sortargs(v);
if(FRACTION(v))
{ if(FUNCTOR(ARG(0,v)) == '*')
sortargs(ARG(0,v));
}
u = tnegate(v);
}
else
{ u = product(theta, complexi);
if(FUNCTOR(u) == '*')
sortargs(u);
}
if(ONE(r))
*next = make_power(eulere,u);
else
*next = product(r,make_power(eulere,u));
strcpy(reason,english(1588)); /* polar form */
HIGHLIGHT(*next);
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int polartorectangular(term t, term arg, term *next, char *reason)
{ int err;
term r,theta;
err = polarform(t,&r,&theta);
if(err)
return 1;
*next = product(r,sum(cos1(theta),product(complexi,sin1(theta))));
HIGHLIGHT(*next);
strcpy(reason,"$r exp(i�)$ = $r (cos � + i sin �)$");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int absofpolar(term t, term arg, term *next, char *reason)
{ term r,theta;
int err;
err = polarform(t,&r,&theta);
if(err)
return 1;
if(ONE(r))
{ strcpy(reason,"$|e^(i�)| = 1$");
*next = one;
HIGHLIGHT(*next);
return 0;
}
err = infer(nonnegative(r));
if(!err)
{ strcpy(reason,"$|Re^(i�)|=R$ ($R�0$)");
*next = r;
HIGHLIGHT(*next);
return 0;
}
strcpy(reason,"$|Re^(i�)| = |R|$");
*next = abs1(r);
HIGHLIGHT(*next);
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int squareofabs(term t, term arg, term *next, char *reason)
{ term u,v,temp;
int err;
if(FUNCTOR(t) != '^')
return 1;
if(!equals(ARG(1,t),two))
return 1;
if(FUNCTOR(ARG(0,t)) != ABS)
return 1;
err = complexparts(ARG(0,ARG(0,t)),&u,&v);
if(err)
return 1;
temp = sum(square(u),square(v));
if(status(squareofabs) <= LEARNING)
*next = temp;
else
{ err = arith(temp,next,get_arithflag());
if(err!=0 && err != 2)
*next = temp;
}
HIGHLIGHT(*next);
strcpy(reason,"$|u + vi|^2 = u^2 + v^2$");
return 0;
}
/*_______________________________________________________________*/
static int polarform2(term z, term *r, term *theta)
/* write z = re^i theta with -pi < theta <= pi if you can;
return 0 for success */
{ int err;
long k;
term chi;
double q;
int exponent;
term u;
err = polarform(z,r,&chi);
if(err)
return 1;
if(seminumerical(chi))
{u = sum(chi,pi);
err = deval(u,&q);
if(err)
return 1;
RELEASE(u);
k = (long) floor(q/(2*PI_DECIMAL));
frexp(k,&exponent);
if(exponent > 31 -1 )
return 1; /* double overflows long */
if(k==0)
*theta = chi;
else
{ u = product3(two,make_int(k),pi);
*theta = sum(chi,tnegate(u));
}
return 0;
}
return 1;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int complex_conjugate(term a, term * astar)
/* compute the complex conjugate of a, returning zero for success,
if a isn't too far from x + yi form already */
/* Handles e^it */
{ int i,err;
term x,y,z,u;
unsigned short n;
if(!iscomplex(a))
{ *astar = a;
return 0;
}
if(FUNCTOR(a)== '*')
{ n = ARITY(a);
*astar = make_term('*',n);
for(i= 0;i<n;i++)
{ err = complex_conjugate(ARG(i,a),&u);
if(err)
{ RELEASE(*astar);
return 1;
}
ARGREP(*astar,i,u);
}
return 0;
}
if(FUNCTOR(a) == '^' && !iscomplex(ARG(1,a)))
{ err = complex_conjugate(ARG(0,a),&u);
if(err)
return 1;
*astar = make_power(u,ARG(1,a));
return 0;
}
if(FUNCTOR(a) == '^' && !iscomplex(ARG(0,a)))
{ err = complex_conjugate(ARG(1,a),&u);
if(err)
return 1;
*astar = make_power(ARG(0,a),u);
return 0;
}
err = complexparts(a,&x,&y);
if(err)
return 1;
tneg(y,&z);
*astar = sum(x,signedproduct(z,complexi));
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int complexcos(term t, term arg, term *next, char *reason)
/* cos t=[e^(it)+e^(-it)]/2 */
{ term u,v;
if(FUNCTOR(t) != COS)
return 1;
u = product(ARG(0,t),complexi);
tneg(u,&v);
*next = make_fraction(sum(make_power(eulere,u),make_power(eulere,v)),two);
HIGHLIGHT(*next);
strcpy(reason,"$$cos theta = (e^(i theta) + e^(- i theta))/2$$");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int complexsin(term t, term arg, term *next, char *reason)
/* sin t=[e^(it)-e^(-it)]/(2i) */
{ term u,v;
if(FUNCTOR(t) != SIN)
return 1;
u = product(ARG(0,t),complexi);
tneg(u,&v);
*next = make_fraction(sum(make_power(eulere,u),tnegate(make_power(eulere,v))),product(two,complexi));
HIGHLIGHT(*next);
strcpy(reason, "$$sin theta = (e^(i theta) - e^(- i theta))/(2i)$$");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int complexln(term t, term arg, term *next, char *reason)
/* ln(re^(it))=ln r+it (-pi < t <= pi) */
/* Note, it isn't 0 <= t < 2 pi as I thought, see Abramowitz p. 67 */
{ term r,theta;
int sign,err;
if(FUNCTOR(t) != LN)
return 1;
if(!ispolarform(ARG(0,t),&r,&theta))
{ errbuf(0, english(2183));
/* Number inside ln must be in polar form. */
return 1;
}
if(ONE(r))
*next = product(theta,complexi);
else
{ err = get_sign(r,&sign);
if(err)
{ if(NEGATIVE(r))
{ err = check(lessthan(zero,ARG(0,r)));
sign = -1;
}
else
{ err = check(lessthan(zero,r));
sign = 1;
}
if(err)
return 1;
commentbuf(0, english(2374));
/* !Assuming the radius is positive */
}
if(sign > 0)
*next = sum(ln1(r),product(theta,complexi));
else
{ err = check(lessthan(theta,pi));
if(!err)
*next = sum(ln1(tnegate(r)), product(sum(theta,pi),complexi));
else
*next = sum(ln1(tnegate(r)), product(sum(theta,tnegate(pi)),complexi));
}
}
HIGHLIGHT(*next);
strcpy(reason,"$ln(re^(i�))=ln r+i�$"); /* restriction on theta left off */
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int complexlntopolarform(term t, term arg, term *next, char *reason)
/* ln(u+iv) = ln(re^(i�)) */
{ term u,r,theta;
unsigned short path[5];
int err;
if(FUNCTOR(t) != LN)
return 1;
u = ARG(0,t);
err = polarform2(u,&r,&theta);
if(err)
return 1;
*next = ln1(product(r,make_power(eulere,make_imag(theta))));
SETORDERED(ARG(0,*next));
HIGHLIGHT(*next);
path[0] = LN;
path[1] = 1;
path[2] = 0;
set_pathtail(path);
SetShowStepOperation(rectangulartopolar);
strcpy(reason, english(1588)); /* polar form */
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int complexsqrt(term t, term arg, term *next, char *reason)
/* sqrt(re^(it))=sqrt r e^(i t/2) (-pi <= t< pi) */
{ term u,r,theta;
int err;
if(FUNCTOR(t) != SQRT)
return 1;
err = polarform(ARG(0,t),&r,&theta);
if(err)
{ errbuf(0, english(2184));
/* Number inside $�$ must be in polar form. */
return 1;
}
u = make_power(eulere, make_fraction(product(theta,complexi),two));
if(ONE(r))
*next = u;
else
*next = product(sqrt1(r),u);
HIGHLIGHT(*next);
strcpy(reason,"$�(re^(i�))=�re^(i�/2)$"); /* (-pi < theta <= 2pi) omitted */
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int complexroot( term t, term arg, term *next, char *reason)
/* root(n,re^(it))=root(n,r) e^(it/n) (0 <= t < 2 pi) */
{ term u,r,theta,n;
int err;
if(FUNCTOR(t) != ROOT)
return 1;
n = ARG(0,t);
err = polarform(ARG(1,t),&r,&theta);
if(err)
{ errbuf(0, english(2185));
/* Number inside �� must be in polar form. */
return 1;
}
u = make_power(eulere, make_fraction(product(theta,complexi),n));
if(ONE(r))
*next = u;
else
*next = product(make_root(n,r),u);
HIGHLIGHT(*next);
strcpy(reason,"$��(re^(i�))$ = $��re^(i�/n) (0��<2�)$");
return 0;
}
/*_______________________________________________________________*/
int rootofunity(term m, term *ans)
/* produce e^(2�ki/m) with assumption 0 <= k < m */
/* return 0 for success; fail if can refute m: INTEGER */
/* assume m: INTEGER if can't infer it */
{ term k; /* new integer variable */
term num;
int err;
err = check(type(m,INTEGER));
if(err)
return 1;
k = getnewintvar1(history(get_currentline()),"knmjpq");
if(FUNCTOR(k) == ILLEGAL)
{ errbuf(0, english(1448));
/* Too many subscripted variables, can't make more. */
return 1;
}
num = make_term('*',4);
ARGREP(num,0,two);
ARGREP(num,1,k);
ARGREP(num,2,pi);
ARGREP(num,3,complexi);
sortargs(num); /* be sure it comes out the way orderfactors wants it */
*ans = make_power(eulere,make_fraction(num,m));
return 0;
}
/*_____________________________________________________________*/
static int mcc_aux(term mid, term *next)
/* find a subterm of mid equal to -i^2,
or of the form -(ai)^2,
or of the form -ai^2;
replace it by 1, a^2, or a and remove any double negations.
Return 0 for success. Return 1 for failure, in which case *next
is garbage.
*/
{ term p,q,a,r;
int i,mark,k=0,err,err2;
if(ATOMIC(mid))
{ *next = mid;
return 1;
}
if(FUNCTOR(mid) == '-')
{ p = ARG(0,mid);
if(FUNCTOR(p) == '^' && equals(ARG(1,p),two))
{ q = ARG(0,p);
if(equals(q,complexi))
{ *next = one;
return 0;
}
if(FUNCTOR(q) == '*')
{ /* determine if q contains a factor of i, and just one */
for(i=0;i<ARITY(q);i++)
{ if(equals(ARG(i,q),complexi))
{ mark = i;
++k;
}
}
if(k != 1)
{ *next = mid;
return 1;
}
if(ARITY(q)==2)
{ a = ARG(mark ? 0 : 1,q);
*next = square(a);
return 0;
}
a = make_term('*',(unsigned short)(ARITY(q)-1));
for(i=0;i<mark;i++)
ARGREP(a,i,ARG(i,q));
for(i=mark;i<ARITY(q)-1;i++)
ARGREP(a,i,ARG(i+1,q));
*next = square(a);
return 0;
}
}
if(FUNCTOR(p) == '*') /* as in -4i^2 */
{ err = cancel(p,make_power(complexi,two),&r,next);
if(!err && !iscomplex(*next))
return 0;
}
}
*next = make_term(FUNCTOR(mid),ARITY(mid));
err = 1;
for(i=0;i<ARITY(mid);i++)
{ err2 = mcc_aux(ARG(i,mid),ARGPTR(*next)+i);
if(!err2)
err = 0;
}
return err;
}
/*__________________________________________________________*/
MEXPORT_ALGEBRA int multiplycomplexconjugates(term t, term arg, term *next, char *reason)
/* (a-bi)(a+bi)=a^2+b^2 */
{ int err;
term mid;
if(FUNCTOR(t) != '*')
return 1;
if(!iscomplex(t))
return 1;
err = difofsquares(t,arg,&mid,reason);
if(err)
return 1;
err = mcc_aux(mid,next);
if(err == 1)
return 1;
strcpy(reason, "$(a-bi)(a+bi) = a^2+b^2$");
release(cancelop); /* if inhibited for example by cleardenomofi */
HIGHLIGHT(*next);
return 0;
}
/*__________________________________________________________*/
MEXPORT_ALGEBRA int recipofi(term t, term arg, term *next, char *reason)
/* 1/i = -i; a/i = -ai */
{ term denom, num;
if(FUNCTOR(t) != '/')
return 1;
num = ARG(0,t);
denom = ARG(1,t);
if(!ONE(num) || !equals(denom,complexi))
return 1;
tneg(complexi,next);
strcpy(reason,"1/i = -i");
HIGHLIGHT(*next);
return 0;
}
/*__________________________________________________________*/
MEXPORT_ALGEBRA int recipofi3(term t, term arg, term *next, char *reason)
/* 1/i = -i; a/i = -ai */
/* also a/bi = ai/b */
{ term denom,num,temp,newdenom;
int i,j;
unsigned short n;
if(FUNCTOR(t) != '/')
return 1;
num = ARG(0,t);
denom = ARG(1,t);
if(FUNCTOR(denom) != '*')
return 1;
n = ARITY(denom);
for(i=0;i<n;i++)
{ if(equals(ARG(i,denom),complexi))
break;
}
if(i==n)
return 1;
if(n==2)
newdenom = ARG(i ? 0 : 1,denom);
else
{ newdenom = make_term('*',(unsigned short)(n-1));
for(j=0;j<n-1;j++)
ARGREP(newdenom,j, ARG(j < i ? j : j+1,denom));
}
temp = product(complexi,num);
if(FUNCTOR(temp) == '*')
sortargs(temp);
*next = tnegate(make_fraction(temp,newdenom));
strcpy(reason,"$$a/(bi) = -ai/b$$");
HIGHLIGHT(*next);
return 0;
}
/*__________________________________________________________*/
MEXPORT_ALGEBRA int recipofi2(term t, term arg, term *next, char *reason)
/* a/i = -ai */
{ term denom, num;
if(FUNCTOR(t) != '/')
return 1;
num = ARG(0,t);
denom = ARG(1,t);
if(ONE(num) && equals(denom,complexi))
{ tneg(complexi,next);
strcpy(reason,"1/i = -i");
HIGHLIGHT(*next);
SetShowStepOperation(recipofi);
return 0;
}
if(equals(denom,complexi))
{ *next = tnegate(product(num,complexi));
HIGHLIGHT(*next);
strcpy(reason,"a/i = -ai");
return 0;
}
if(iscomplex(denom))
errbuf(0, english(2186));
/* Use \"clear denom of i\" instead */
return 1;
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int complexabs(term t, term arg, term *next, char *reason)
{ term u,v,temp;
int err;
if(FUNCTOR(t) != ABS)
return 1;
err = complexparts(ARG(0,t),&u,&v);
if(err)
return 1;
temp = make_sqrt(sum(square(u),square(v)));
if(status(complexabs) <= LEARNING)
*next = temp;
else
{ err = value(temp,next);
if(err!=0 && err != 2)
*next = temp;
}
HIGHLIGHT(*next);
strcpy(reason,"$|u + vi| = �(u^2+v^2)$");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int complexform(term t, term arg, term *next, char *reason)
/* put t in the form x + yi if possible */
/* called in postops on quotients such as (3+2i)/5 */
{ term x,y;
int err;
if(!contains(t,'i'))
return 1; /* without further ado */
err = complexparts(t,&x,&y);
if(err)
{ errbuf(0,english(1136));
/* Expression too complicated, simplify it first */
return 1;
}
*next = sum(x,signedproduct(y,complexi));
HIGHLIGHT(*next);
if(equals(t,*next))
{ errbuf(0, english(2401)); /* That expression is already in the form $u+iv$. */
return 1;
}
strcpy(reason, english(1135));
/* write in form x+yi */
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int complexapart(term t, term arg, term *next, char *reason)
/* (u+vi)/w = u/w + (v/w)i */
/* called in postops on quotients such as (3+2i)/5 */
{ term x,y,u,v;
int i,err;
int nvariables = get_nvariables();
varinf *varinfo = get_varinfo();
term *varlist = get_varlist();
if(!FRACTION(t))
return 1;
u = ARG(0,t);
v = ARG(1,t);
/* is the denominator real? */
if(contains(v,'i'))
return 1; /* this function doesn't deal with complex denoms */
for(i=0;i<nvariables;i++)
{ if(varinfo[i].type == DCOMPLEX && contains(v,FUNCTOR(varlist[i])))
return 1;
}
err = complexparts(u,&x,&y);
if(err || ZERO(y) || ZERO(x))
return 1;
x = signedfraction(x,v);
y = signedfraction(y,v);
*next = sum(x,signedproduct(y,complexi));
HIGHLIGHT(*next);
strcpy(reason,"(u+vi)/w = u/w+(v/w)i");
return 0;
}
/*____________________________________________________________________*/
MEXPORT_ALGEBRA int complexexponential(term t, term arg, term *next, char *reason)
/* e^(i theta) = cos theta + i sin theta */
{ term u,v;
int err;
if(FUNCTOR(t) != '^' || !equals(ARG(0,t),eulere))
return 1;
err = complexparts(ARG(1,t),&u,&v);
if(err)
return 1;
if(!ZERO(u))
return 1;
*next = sum(cos1(v),product(complexi, sin1(v)));
SETORDERED(ARG(1,*next));
HIGHLIGHT(*next);
strcpy(reason,"$e^(i�)=cos � + i sin �$");
/* 22 chars but the parens won't show so it will fit */
return 0;
}
/*____________________________________________________________________*/
MEXPORT_ALGEBRA int complexexponential2(term t, term arg, term *next, char *reason)
/* e^(x+iy) = e^x cos y + i e^x sin y */
{ term u,v;
int err;
if(FUNCTOR(t) != '^' || !equals(ARG(0,t),eulere))
return 1;
err = complexparts(ARG(1,t),&u,&v);
if(err)
return 1;
*next = sum(product(make_power(eulere,u),cos1(v)), product3(make_power(eulere,u),complexi, sin1(v)));
SETORDERED(ARG(1,*next));
HIGHLIGHT(*next);
strcpy(reason,"e^(x+iy) = e^x cos y+i e^x sin y");
return 0;
}
/*____________________________________________________________________*/
MEXPORT_ALGEBRA int etotheipi(term t, term arg, term *next, char *reason)
/* e^(i pi) = -1 */
{ term u,v;
int err;
if(FUNCTOR(t) != '^' || !equals(ARG(0,t),eulere))
return 1;
err = complexparts(ARG(1,t),&u,&v);
if(err)
return 1;
if(!ZERO(u))
return 1;
if(!equals(v,pi))
return 1;
*next = minusone;
HIGHLIGHT(*next);
strcpy(reason, "$e^(i�) = -1$");
return 0;
}
/*____________________________________________________________________*/
MEXPORT_ALGEBRA int etotheminusipi(term t, term arg, term *next, char *reason)
/* e^(-i pi) = -1 */
{ term u,v;
int err;
if(FUNCTOR(t) != '^' || !equals(ARG(0,t),eulere))
return 1;
err = complexparts(ARG(1,t),&u,&v);
if(err)
return 1;
if(!ZERO(u))
return 1;
if(!NEGATIVE(v))
return 1;
if(!equals(ARG(0,v),pi))
return 1;
*next = minusone;
HIGHLIGHT(*next);
strcpy(reason, "$e^(-i�) = -1$");
return 0;
}
/*____________________________________________________________________*/
MEXPORT_ALGEBRA int etothei2npi(term t, term arg, term *next, char *reason)
/* e^(2npi i) = 1 */
{ term u,v,cancelled,w,power;
int err;
unsigned short path[5];
if(FUNCTOR(t) != '^' || !equals(ARG(0,t),eulere))
return 1;
power = ARG(1,t);
if(FRACTION(power) && !cancelop(power,arg,&v,reason))
{ *next = make_power(eulere,v);
path[0] = '^';
path[1] = 2;
path[2] = 0;
set_pathtail(path);
SetShowStepOperation(cancelop);
return 0;
}
err = complexparts(ARG(1,t),&u,&v);
if(err)
return 1;
if(!ZERO(u))
return 1;
err = cancel(v,pi,&cancelled,&w);
if(err)
return 1;
if(NEGATIVE(w))
w = ARG(0,w);
err = infer(type(w,INTEGER));
if(err)
return 1;
err = infer(even(w));
if(err)
return 1;
*next = one;
HIGHLIGHT(*next);
strcpy(reason, "$e^(2n�i) = 1$");
return 0;
}
/*____________________________________________________________________*/
MEXPORT_ALGEBRA int etothecoterminal(term t, term arg, term *next, char *reason)
/* e^((2n� + �)i) = e^(i�) */
{ term u,cancelled,v,a,b,q;
int sign = 1, err;
if(FUNCTOR(t) != '^' || !equals(ARG(0,t),eulere))
return 1;
v = ARG(1,t);
if(!iscomplex(v))
return 1; /* quickly */
if(NEGATIVE(v))
{ sign = -1;
v = ARG(0,v);
}
if(FUNCTOR(v) != '*' && FUNCTOR(v) != '+')
return 1;
err = cancel(v,complexi,&cancelled,&u);
if(err)
return 1;
err = decompose(u,&a,&b);
if(err)
return 1;
/* Now u = a+b pi with b an integer */
if(NEGATIVE(b))
b = ARG(0,b);
err = infer(even(b));
if(err || ZERO(b))
return 1;
q = product(complexi,a);
if(FUNCTOR(q)== '*')
sortargs(q);
*next = make_power(eulere, sign > 0 ? q : tnegate(q));
HIGHLIGHT(*next);
strcpy(reason, "$e^((2n� + �)i) = e^(i�)$");
return 0;
}
/*______________________________________________________________*/
MEXPORT_ALGEBRA int is_polar_complex(term t)
/* return 1 if t is a complex number in polar form, 0 if not */
/* real variables are accepted too; thus re^(it) is OK */
/* As it stands, it accepts any variable in the exponent, type complex or not */
{ int err;
term u,a,b;
unsigned short n;
if(OBJECT(t))
return 1;
if(ISATOM(t))
return COMPLEX(t) ? 0 : 1;
if(NEGATIVE(t))
return 0; /* -re^it is NOT in polar form */
if(FUNCTOR(t) == '^' && equals(ARG(0,t),eulere))
{ u = ARG(1,t);
if(NEGATIVE(u))
u = ARG(0,u);
if(FRACTION(u))
{ if(iscomplex(ARG(1,u)))
return 0;
u = ARG(0,u);
}
err = cancel(u,complexi,&a,&b);
if(err || iscomplex(b))
return 0;
return 1;
}
if(FUNCTOR(t) != '*')
return 0;
/* Last factor must be e^... */
n = ARITY(t);
u = ARG(n-1,t);
if(FUNCTOR(u) == '^' && equals(ARG(0,u),eulere))
{ if(!is_polar_complex(u))
return 0;
if(n > 2)
SETFUNCTOR(t,'*',(unsigned short)(n-1));
else
t = ARG(0,t);
}
return !iscomplex(t);
}
/*______________________________________________________________*/
MEXPORT_ALGEBRA int complexrootminus(term t, term arg, term *next, char *reason)
/* root(n,-a) = e^pi i /n root(n,a) if a >= 0*/
{ term index, index2,a, efactor;
double z;
int i,err;
term u;
if(FUNCTOR(t) != ROOT)
return 1;
u = ARG(1,t);
if(iscomplex(u))
{ errbuf(0, english(1926));
/* This law is not generally valid; what is under the root must be real.*/
return 1;
}
if(seminumerical(ARG(1,t)))
{ deval(ARG(1,t),&z);
if(z == BADVAL || z >= 0)
return 1;
a = strongnegate(ARG(1,t));
}
else if(NEGATIVE(u))
{ a = ARG(0,u);
err = infer(le(zero,a));
if(err)
{ errbuf(0, english(1927));
/* What is under the root must be negative. */
return 1;
}
}
else if(FUNCTOR(u) == '+')
{ for(i=0;i<ARITY(u);i++)
{ if(!NEGATIVE(ARG(i,u)))
return 1;
}
a = strongnegate(ARG(1,t));
err = infer(le(zero,a));
if(err)
{ errbuf(0, english(1927));
/* What is under the root must be negative. */
return 1;
}
}
else
return 1;
if(!get_complex())
{ errbuf(0, english(1897));
errbuf(1, english(1898));
/* Complex numbers are not in use.
This law is not valid for real roots. */
return 1;
}
index = ARG(0,t);
copy(ARG(0,t),&index2);
efactor = make_power(eulere, make_fraction(product(pi,complexi),index));
*next = product(efactor,make_root(index2,a));
HIGHLIGHT(*next);
strcpy(reason,"$��(-a) = e^(�i/n) ��a$");
return 0;
}
/*________________________________________________________________________*/
static void real_and_complex_factors(term t, term *r, term *c)
/* t is presumed to be a product. Put the real factors in *r,
the complex factors in *c, so that t = product(*r, *c).
*/
{ unsigned short n = ARITY(t);
unsigned short i,j,k, count;
int flag;
if(!iscomplex(t))
{ *r = t;
*c = one;
return;
}
if(FUNCTOR(t) != '*')
{ *r = one;
*c = t;
return;
}
count = flag = 0;
for(i=0;i<n;i++)
{ if(iscomplex(ARG(i,t)))
{ ++count;
flag = i;
}
}
if(count == 1)
{ *c = ARG(flag,t);
if(n == 2)
{ *r = ARG(flag ? 0 : 1, t);
return;
}
*r = make_term('*',(unsigned short)(n-1));
for(i=0;i<n-1;i++)
ARGREP(*r, i, i < flag ? ARG(i,t) : ARG(i+1,t));
return;
}
if(count == n)
{ /* all factors were complex */
*c = t;
*r = one;
return;
}
if(count == (unsigned short)(n-1))
{ /* all but one were complex. Then n != 2 since count == 1 is handled above. */
*c = make_term('*',(unsigned short)(n-1));
k = 0;
for(i=0;i<n;i++)
{ if(iscomplex(ARG(i,t)))
{ ARGREP(*c,k,ARG(i,t));
++k;
}
else
*r = ARG(i,t);
}
return;
}
/* Now some were complex and some not */
*c = make_term('*',count);
*r = make_term('*',(unsigned short)(n-count));
j = k = 0;
for(i=0;i<n;i++)
{ if(iscomplex(ARG(i,t)))
{ ARGREP(*c,k,ARG(i,t));
++k;
}
else
{ ARGREP(*r,j,ARG(i,t));
++j;
}
}
if(k != count || j != n-count)
assert(0);
}
/*___________________________________________________________________*/
MEXPORT_ALGEBRA int complexexptonum(term t, term arg, term *next, char *reason)
/* a/(ce^(ti)) = ae^(-ti)/c */
{ term num,denom,newnum,v,temp,r,s;
int i;
if(!FRACTION(t))
return 1;
denom = ARG(1,t);
num = ARG(0,t);
if(FUNCTOR(denom) == '^' &&
equals(ARG(0,denom),eulere) &&
iscomplex(ARG(1,denom))
)
{ temp = make_power(eulere, strongnegate(ARG(1,denom)));
HIGHLIGHT(temp);
*next = product(num,temp);
strcpy(reason,"a/(ce^(ti))=ae^(-ti)/c");
return 0;
}
if(FUNCTOR(denom) != '*')
return 1;
real_and_complex_factors(denom,&r,&s);
/* This operator only works if all the complex factors have
the form e^complex */
if(FUNCTOR(s) == '^' && equals(ARG(0,s),eulere))
{ temp = make_power(eulere,strongnegate(ARG(1,s)));
HIGHLIGHT(temp);
newnum = product(num,temp);
*next = make_fraction(newnum,r);
strcpy(reason,"a/(ce^(ti))=ae^(-ti)/c");
return 0;
}
if(FUNCTOR(s) != '*')
return 1;
newnum = make_term('*',(unsigned short)(1+ARITY(s)));
ARGREP(newnum,0,num);
for(i=0;i<ARITY(s);i++)
{ temp = ARG(i,s);
if(FUNCTOR(temp) == '^' && equals(ARG(0,temp),eulere))
{ v = make_power(eulere,strongnegate(ARG(1,temp)));
HIGHLIGHT(v);
ARGREP(newnum,i+1, v);
}
else
{ RELEASE(newnum);
return 1;
}
}
if(FUNCTOR(num) == '*')
newnum = topflatten(newnum);
if(ONE(r))
*next = newnum;
else
*next = make_fraction(newnum,r);
strcpy(reason,"a/(ce^(ti))=ae^(-ti)/c");
return 0;
}
/*_______________________________________________________________________*/
MEXPORT_ALGEBRA int demoivre(term t, term arg, term *next, char *reason)
/* x^n = c becomes x = e^(2 k pi i)/n root(n,c) */
{ if(!get_complex())
return 1;
return rooteqn(t,arg,next,reason);
}
/*________________________________________________________________________*/
MEXPORT_ALGEBRA int explicitparams(term t, term arg, term *next, char *reason)
/* Substitute specific integers for the integer parameter in an equation
which is parametrized by a complex exponential of the form e^(2k pi i)/n.
The result is an OR of arity n, whose args are obtained by substituting
k = 0,1,...,n-1 in t. Works also on an OR of equations, in which case the
result is a still larger OR.
This is for use after deMoivre's theorem. If t is an equation, it
only works if t contains exactly one integer parameter, and that only in
the specified form. If t is an OR of equations, it is applied separately
to each equation, so each equation may contain a different existential
parameter.
*/
{ unsigned short f = FUNCTOR(t);
term u,v,temp,temp2,p;
unsigned short n;
int nvariables;
term *varlist;
term k,twokplus1,twokminus1;
long N;
int i,flag,err;
term newvar;
if(f == OR)
{ n = ARITY(t);
u = make_term(OR,n);
flag = 0;
for(i=0;i<n;i++)
{ err = explicitparams(ARG(i,t),arg,&temp,reason);
if(!err)
{ ARGREP(u,i,temp);
flag = 1;
}
else
ARGREP(u,i,ARG(i,t));
}
if(!flag)
{ RELEASE(u);
return 1;
}
*next = topflatten(u);
return 0;
}
if(f != '=')
return 1;
/* Now t is an equation. Look for an integer existential variable
contained in t. */
varlist = get_varlist();
nvariables = get_nvariables();
for(i=0;i<nvariables;i++)
{ k = varlist[i];
if(TYPE(k) == INTEGER && ISEXISTENTIALVAR(k) && contains(t,FUNCTOR(k)))
break;
}
if(i == nvariables)
return 1;
/* Now check if k occurs in and only in subterms e^(2k pi i/N) */
err = exponential_subterm(t,k,&u,&N);
if(err)
return 1;
if(N > 8 && get_mathmode() == AUTOMODE) /* N = 6 occurs in complex_roots */
return 1;
if(N > 20)
{ errbuf(0, english(1899));
/* Too many solutions will result */
return 1;
}
/* Now check that complexi occurs ONLY in exponents and that no
roots have negative args. */
if(contains_badi(t))
return 1;
newvar = getnewvar(t,"zqpqr");
if(FUNCTOR(newvar) == ILLEGAL)
return 1; /* No use generating an error message about "too many variables" as
this would be confusing. */
vaux(newvar);
subst(newvar,u,t,&temp);
if(contains(temp,FUNCTOR(k)))
{ psubst(newvar,u,t,&temp);
/* psubst may be needed,not just subst, as in cubic equations we have
both e^... and e^-.... present, where u is e^...
On the other hand, psubst does too much sometimes and will fail
when subst can succeed! as in substituting for e^(k pi/6)i in
e^(pi i/6), it will succeed with k in the answer!
*/
if(contains(temp,FUNCTOR(k)))
{ set_nvariables(nvariables);
return 1;
}
}
/* OK, now it's going to work. Substitute 0,1,...,N-1 for k */
*next = make_term(OR,(unsigned short) N);
p = ARG(1,u); /* example, p = (2k+1)pi i */
twokplus1 = sum(product(two,k),one);
twokminus1 = sum(product(two,k),minusone);
for(i=0;i<N;i++)
{ subst(make_int(i),k,p,&temp);
polyval(temp,&temp2);
subst(temp2,p,t,&v);
ARGREP(*next,i,v);
}
HIGHLIGHT(*next);
strcpy(reason, english(1900));
/* substitute specific integers */
set_nvariables(nvariables);
return 0;
}
/*___________________________________________________________________________*/
static int exponential_subterm(term t, term k, term *ans, long *N)
/* k is presumed to be an atom. Find a subterm of t of the form
e^(2pi k i/N), or e^(2pi (k+1) i/N), where N is a specific integer,
or e^(2pi k i/N + c), where c is a constant.
Return the subterm found in *ans, and the integer denominator in *N.
Return 0 for success; return 1 if t contains no such subterm. In that case,
*ans and *N will be garbage. Will not find such terms nested in
exponents or in the bases of exponents.
*/
{ term u,v,w;
int flag[4];
int i,err;
unsigned short n;
if(ATOMIC(t))
return 1;
if(FUNCTOR(t) == '^')
{ if(!equals(ARG(0,t),eulere))
return 1;
u = ARG(1,t);
if(FUNCTOR(u) == '+' && ARITY(u) == 2 && complexnumerical(ARG(1,u)))
u = ARG(0,u);
if(FUNCTOR(u) == '*' && ARITY(u) == 2 && equals(ARG(1,u),complexi) && FRACTION(ARG(0,u)))
{ /* check for (2pi k/N) *i */
v = ARG(0,u);
if(!ISINTEGER(ARG(1,v)))
return 1;
*N = INTDATA(ARG(1,v));
v = ARG(0,v);
if(FUNCTOR(v) != '*')
return 1;
for(i=0;i<4;i++)
flag[i] = 0;
if(ARITY(v) == 2)
{ /* check for pi(2k+1) and k pi */
for(i=0;i<2;i++)
{ w = ARG(i,v);
if(equals(w,pi))
flag[1] = 1;
else if(equals(w,k) && !flag[2])
{ flag[2] = 1;
*N *= 2;
}
else if(FUNCTOR(w) == '+' && ARITY(w) == 2 && !flag[2] &&
(ONE(ARG(1,w)) || equals(ARG(1,w),minusone)) &&
FUNCTOR(ARG(0,w)) == '*' &&
ARITY(ARG(0,w)) == 2 && equals(ARG(0,ARG(0,w)),two) &&
equals(ARG(1,ARG(0,w)),k)
)
flag[2] = 1; /* w is 2k+1 or 2k-1 */
}
for(i=1;i<3;i++)
{ if(!flag[i])
return 1;
}
*ans = t;
return 0;
}
if(ARITY(v) == 3)
{ /* check for 2 pi k */
for(i=0;i<3;i++)
{ w = ARG(i,v);
if(equals(w,two))
flag[1] = 1;
else if(equals(w,pi))
flag[2] = 1;
else if(equals(w,k))
flag[3] = 1;
}
for(i=1;i<4;i++)
{ if(!flag[i])
return 1;
}
*ans = t;
return 0;
}
return 1;
}
if(FRACTION(u))
{ if(!ISINTEGER(ARG(1,u)))
return 1;
*N = INTDATA(ARG(1,u));
u = ARG(0,u);
/* check if u has the form 2 pi k i or pi (2k+1) i*/
if(FUNCTOR(u) != '*')
return 1;
for(i=0;i<4;i++)
flag[i] = 0;
if(ARITY(u) == 3)
{ /* check for pi (2k+1) i and for k pi i*/
for(i=0;i<3;i++)
{ v = ARG(i,u);
if(equals(v,complexi))
flag[0] = 1;
else if(equals(v,pi))
flag[1] = 1;
else if(equals(v,k) && !flag[2])
{ flag[2] = 1;
*N *= 2;
}
else if(FUNCTOR(v) == '+' && ARITY(v) == 2 && !flag[2] &&
(ONE(ARG(1,v)) || equals(ARG(1,v),minusone)) &&
FUNCTOR(ARG(0,v)) == '*' &&
ARITY(ARG(0,v)) == 2 && equals(ARG(0,ARG(0,v)),two) &&
equals(ARG(1,ARG(0,v)),k)
)
flag[2] = 1; /* v is 2k+1 or 2k -1*/
}
for(i=0;i<3;i++)
{ if(!flag[i])
return 1;
}
*ans = t;
return 0;
}
if(ARITY(u) == 4)
{ /* check for 2 pi k i */
for(i=0;i<4;i++)
{ v = ARG(i,u);
if(equals(v,two))
flag[0] = 1;
else if(equals(v,complexi))
flag[1] = 1;
else if(equals(v,pi))
flag[2] = 1;
else if(equals(v,k))
flag[3] = 1;
}
for(i=0;i<4;i++)
{ if(!flag[i])
return 1;
}
*ans = t;
return 0;
}
return 1;
}
return 1; /* unacceptable u */
}
n = ARITY(t);
for(i=0;i<n;i++)
{ err = exponential_subterm(ARG(i,t),k,ans,N);
if(!err)
return 0;
}
return 1;
}
/*________________________________________________________________________*/
static int ispolarform(term u, term *r, term *theta)
/* return 1 if u is already in polar form, putting the
radius and argument in *r and *theta. Return 0 if not.
Unlike polarform or polarform2, this does not try to
calculate r and theta if they aren't already explicit.
Does not count a real argument (i.e. theta = 0) as being in polar form.
*/
{ term a;
int i,j;
unsigned short n;
if(FUNCTOR(u) == '^' && equals(ARG(0,u),eulere) &&
!cancel(ARG(1,u),complexi,&a,theta) && !iscomplex(*theta) &&
!contains_complexvar(*theta)
)
{ *r = one;
return 1;
}
if(FUNCTOR(u) == '*')
{ n = ARITY(u);
for(i=0;i<n;i++)
{ if(FUNCTOR(ARG(i,u)) == '^' && ispolarform(ARG(i,u),&a,theta))
break;
}
if(i==n)
return 0;
if(n==2)
*r = ARG(i ? 0 : 1, u);
else
{ *r = make_term('*',(unsigned short)(n-1));
for(j=0;j<n-1;j++)
ARGREP(*r,j,ARG(j<i ? j : j+1,u));
}
if(iscomplex(*r))
return 0;
if(contains_complexvar(*r))
return 0;
return 1;
}
return 0;
}
/*____________________________________________________________*/
static int contains_badi(term t)
/* return 1 if t contains complexi not in an exponent */
{ unsigned short i,n;
if(equals(t,complexi))
return 1;
if(ATOMIC(t))
return 0;
if(FUNCTOR(t) == '^')
{ if(SIGNEDFRACTION(ARG(1,t)) && NEGATIVE(ARG(0,t)))
return 1;
return contains_badi(ARG(0,t));
}
if(FUNCTOR(t) == SQRT && NEGATIVE(ARG(0,t)))
return 1;
if(FUNCTOR(t) == ROOT && NEGATIVE(ARG(1,t)))
return 1; /* even if it's an odd root; bring the minus sign
out of the root first. */
n = ARITY(t);
for(i=0;i<n;i++)
{ if(contains_badi(ARG(i,t)))
return 1;
}
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int complexcosrev(term t, term arg, term *next, char *reason)
/* [e^(it) + e^(-it)]/2 = cos(it) */
{ int err;
term u;
if(!FRACTION(t))
return 1;
if(FUNCTOR(ARG(0,t)) != '+' || ARITY(ARG(0,t)) != 2)
return 1;
if(!equals(ARG(1,t),two))
return 1;
err = complexcosrev2(ARG(0,t),arg,&u,reason);
if(err)
return 1;
*next = ARG(1,u); /* because u = 2 cos(it) */
RELEASE(u);
strcpy(reason,"[e^(it)+e^(-it)]/2=cos(it)");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int complexcosrev2(term t, term arg, term *next, char *reason)
/* e^(it) + e^(-it) = 2 cos(t) */
{ term lhs,a,u,v,cancelled;
int err;
if(FUNCTOR(t) != '+')
return 1;
if(!iscomplex(t))
return 1;
lhs = sum(make_power(eulere,var0),make_power(eulere,tnegate(var0)));
err = match(t,lhs,var0,&a,&u); /* instantiate a and u */
if(err || cancel(u,complexi,&cancelled,&v))
/* cancel checks whether the arg is divisible by i */
{ destroy_term(lhs);
return 1;
}
*next = product(two,cos1(v));
HIGHLIGHT(*next);
strcpy(reason,"e^t+e^(-it) = 2 cos t");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int complexsinrev(term t, term arg, term *next, char *reason)
/* [e^(it) - e^(-it)]/(2i) = sin(it) */
{ int err;
term u,denom;
if(!FRACTION(t))
return 1;
if(FUNCTOR(ARG(0,t)) != '+' || ARITY(ARG(0,t)) != 2)
return 1;
denom = ARG(1,t);
if(FUNCTOR(denom) != '*' || ARITY(denom) != 2)
return 1;
if(!equals(ARG(0,denom),two) || !equals(ARG(1,denom),complexi))
return 1;
err = complexsinrev2(ARG(0,t),arg,&u,reason);
if(err)
return 1;
*next = ARG(2,u); /* because u = 2i sin(it) */
RELEASE(u);
strcpy(reason,"[e^(it)+e^(-it)]/2i=sin(it)");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int complexsinrev2(term t, term arg, term *next, char *reason)
/* e^(it) - e^(-it) = 2i sin(it) */
{ term lhs,a,u,v,cancelled;
int err;
if(FUNCTOR(t) != '+')
return 1;
if(!iscomplex(t))
return 1;
lhs = sum(make_power(eulere,var0),make_power(eulere,tnegate(var0)));
err = match(t,lhs,var0,&a,&u); /* instantiate a and u */
if(err || cancel(u,complexi,&cancelled,&v))
/* cancel checks whether the arg is divisible by i */
{ destroy_term(lhs);
return 1;
}
*next = product3(two,complexi,sin1(v));
HIGHLIGHT(*next);
strcpy(reason,"e^t+e^(-it) = 2i sin t");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int isinh(term t, term arg, term *next, char *reason)
/* sin(it) = i sinh t */
{ term u,v,cancelled;
if(FUNCTOR(t) != SIN)
return 1;
u = ARG(0,t);
if(FUNCTOR(u) == '*' && ARITY(u) == 2 && equals(ARG(0,u),complexi))
/* cut to the chase */
*next = product(complexi, sinh1(ARG(1,u)));
else if(!iscomplex(u))
return 1;
else if(!cancel(u,complexi,&cancelled,&v))
*next = product(complexi, sinh1(v));
else
return 1;
strcpy(reason, "sin(it) = i sinh t");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int icosh(term t, term arg, term *next, char *reason)
/* cos(it) = cosh t */
{ term u,v,cancelled;
if(FUNCTOR(t) != COS)
return 1;
u = ARG(0,t);
if(FUNCTOR(u) == '*' && ARITY(u) == 2 && equals(ARG(0,u),complexi))
/* cut to the chase */
*next = cosh1(ARG(1,u));
else if(!iscomplex(u))
return 1;
else if(!cancel(u,complexi,&cancelled,&v))
*next = cosh1(v);
else
return 1;
strcpy(reason, "cos(it) = cosh t");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int sinhi(term t, term arg, term *next, char *reason)
/* sinh(it) = i sin t */
{ term u,v,cancelled;
if(FUNCTOR(t) != SINH)
return 1;
u = ARG(0,t);
if(FUNCTOR(u) == '*' && ARITY(u) == 2 && equals(ARG(0,u),complexi))
/* cut to the chase */
*next = product(complexi, sin1(ARG(1,u)));
else if(!iscomplex(u))
return 1;
else if(!cancel(u,complexi,&cancelled,&v))
*next = product(complexi, sin1(v));
else
return 1;
strcpy(reason, "sinh(it) = i sin t");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int coshi(term t, term arg, term *next, char *reason)
/* cosh(it) = cos t */
{ term u,v,cancelled;
if(FUNCTOR(t) != COSH)
return 1;
u = ARG(0,t);
if(FUNCTOR(u) == '*' && ARITY(u) == 2 && equals(ARG(0,u),complexi))
/* cut to the chase */
*next = cos1(ARG(1,u));
else if(!iscomplex(u))
return 1;
else if(!cancel(u,complexi,&cancelled,&v))
*next = cos1(v);
else
return 1;
strcpy(reason, "cosh(it) = cos t");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int itanh(term t, term arg, term *next, char *reason)
/* tan(it) = i tanh t */
{ term u,v,cancelled;
if(FUNCTOR(t) != TAN)
return 1;
u = ARG(0,t);
if(FUNCTOR(u) == '*' && ARITY(u) == 2 && equals(ARG(0,u),complexi))
/* cut to the chase */
*next = product(complexi, tanh1(ARG(1,u)));
else if(!iscomplex(u))
return 1;
else if(!cancel(u,complexi,&cancelled,&v))
*next = product(complexi, tanh1(v));
else
return 1;
strcpy(reason, "tan(it) = i tanh t");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int icoth(term t, term arg, term *next, char *reason)
/* cot(it) = -i coth t */
{ term u,v,cancelled;
if(FUNCTOR(t) != COT)
return 1;
u = ARG(0,t);
if(FUNCTOR(u) == '*' && ARITY(u) == 2 && equals(ARG(0,u),complexi))
/* cut to the chase */
*next = tnegate(product(complexi, coth1(ARG(1,u))));
else if(!iscomplex(u))
return 1;
else if(!cancel(u,complexi,&cancelled,&v))
*next = tnegate(product(complexi, coth1(v)));
else
return 1;
strcpy(reason, "cot(it) = -i coth t");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int tanhi(term t, term arg, term *next, char *reason)
/* tanh(it) = i tan t */
{ term u,v,cancelled;
if(FUNCTOR(t) != TANH)
return 1;
u = ARG(0,t);
if(FUNCTOR(u) == '*' && ARITY(u) == 2 && equals(ARG(0,u),complexi))
/* cut to the chase */
*next = product(complexi, tan1(ARG(1,u)));
else if(!iscomplex(u))
return 1;
else if(!cancel(u,complexi,&cancelled,&v))
*next = product(complexi, tan1(v));
else
return 1;
strcpy(reason, "tanh(it) = i tan t");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int cothi(term t, term arg, term *next, char *reason)
/* coth(it) = -cot t */
{ term u,v,cancelled;
if(FUNCTOR(t) != COTH)
return 1;
u = ARG(0,t);
if(FUNCTOR(u) == '*' && ARITY(u) == 2 && equals(ARG(0,u),complexi))
/* cut to the chase */
*next = tnegate(cot1(ARG(1,u)));
else if(!iscomplex(u))
return 1;
else if(!cancel(u,complexi,&cancelled,&v))
*next = tnegate(cot1(v));
else
return 1;
strcpy(reason, "coth(it) = -cot t");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int cosisin(term t, term arg, term *next, char *reason)
/*cos t + i sin t = e^(it) */
{ term lhs,rhs,a;
int err;
if(FUNCTOR(t) != '+')
return 1;
lhs = sum(cos1(var0), product(complexi,sin1(var0)));
rhs = make_power(eulere,product(complexi,var0));
err = match(t,lhs,rhs,&a,next); /* instantiate a and *next */
if(err)
{ destroy_term(lhs);
destroy_term(rhs);
return 1;
}
HIGHLIGHT(*next);
strcpy(reason,"$cos t + i sin t = e^(it)$");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_ALGEBRA int cosminusisin(term t, term arg, term *next, char *reason)
/*cos t - i sin t = e^(-it) */
{ term lhs,rhs,a;
int err;
if(FUNCTOR(t) != '+')
return 1;
lhs = sum(cos1(var0), tnegate(product(complexi,sin1(var0))));
rhs = make_power(eulere,product(complexi,var0));
err = match(t,lhs,rhs,&a,next); /* instantiate a and *next */
if(err)
{ destroy_term(lhs);
destroy_term(rhs);
return 1;
}
HIGHLIGHT(*next);
strcpy(reason,"$cos t + i sin t =e^(-it)$");
return 0;
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int sqrtofi(term t, term arg, term *next, char *reason)
/* sqrt(bi) = (sqrt(b/2) + sqrt(b/2) i) if b >= 0 */
{ term a,b,u;
int err;
if(FUNCTOR(t) != SQRT)
return 1;
u = ARG(0,t);
if(equals(u,complexi))
{ *next = sum(make_fraction(one,sqrt1(two)), product(make_fraction(one,sqrt1(two)),complexi));
strcpy(reason, "$\\sqrt i= 1/\\sqrt 2+(1/\\sqrt 2) i$");
HIGHLIGHT(*next);
return 0;
}
err = complexparts(u,&a,&b);
if(err || !ZERO(a))
return 1;
err = infer(le(zero,b));
if(err)
return 1;
*next = sum(sqrt1(make_fraction(b,two)),product(sqrt1(make_fraction(b,two)),complexi));
HIGHLIGHT(*next);
strcpy(reason, english(2473));
// "$\\sqrt(bi)= \\sqrt(b/2)+\\sqrt(b/2)i)$ if b >= 0"
return 0;
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int sqrtofminusi(term t, term arg, term *next, char *reason)
/* sqrt(-bi) = sqrt(b/2) - sqrt(b/2) i) if b >= 0 */
{ term a,b;
int err;
if(FUNCTOR(t) != SQRT)
return 1;
err = complexparts(ARG(0,t),&a,&b);
if(err || !ZERO(a))
return 1;
b = tnegate(b);
if(ONE(b))
{ *next = sum(make_fraction(one,sqrt1(two)),tnegate(product(make_fraction(one,sqrt1(two)),complexi)));
strcpy(reason,"$\\sqrt(-i)= 1/\\sqrt 2-(1/\\sqrt 2)i$");
HIGHLIGHT(*next);
return 0;
}
err = infer(le(zero,b));
if(err)
return 1;
*next = sum(sqrt1(make_fraction(b,two)),tnegate(product(sqrt1(make_fraction(b,two)),complexi)));
HIGHLIGHT(*next);
strcpy(reason, english(2474));
// "$\\sqrt(-bi)= \\sqrt(b/2)-\\sqrt(b/2)i)$ if b >= 0"
return 0;
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int sqrtofaplusbi(term t, term arg, term *next, char *reason)
/* sqrt(a+bi) = (sqrt((c+a)/2) + sqrt((c-a)/2) i) if b >= 0, where c^2 = a^2+b^2 */
{ term a,b,c1,c2,c3,u,v;
int err;
if(FUNCTOR(t) != SQRT)
return 1;
err = complexparts(ARG(0,t),&a,&b);
if(err)
return 1;
err = infer(le(zero,b));
if(err)
return 1;
c3 = sqrt1(sum(square(a),square(b)));
err = value(c3,&c1);
if(err)
c1 = c3;
copy(c1,&c2);
u = sqrt1(make_fraction(sum(c1,a),two));
v = sqrt1(make_fraction(sum(c2,tnegate(a)),two));
*next = sum(u, product(v,complexi));
HIGHLIGHT(*next);
strcpy(reason, english(2475));
//"$\\sqrt(a+bi)= \\sqrt((a+c)/2)+\\sqrt((a-c)/2)i$ if b >= 0 and c=\\sqrt(a^2+b^2)"
return 0;
}
/*__________________________________________________________________*/
MEXPORT_ALGEBRA int sqrtofaminusbi(term t, term arg, term *next, char *reason)
/* sqrt(a-bi) = (sqrt((c+a)/2) - sqrt((c-a)/2) i) if b >= 0, where c^2 = a^2+b^2 */
{ term a,b,c1,c2,u,v,c3;
int err;
if(FUNCTOR(t) != SQRT)
return 1;
err = complexparts(ARG(0,t),&a,&b);
if(err)
return 1;
b = tnegate(b);
err = infer(le(zero,b));
if(err)
return 1;
c3 = sqrt1(sum(square(a),square(b)));
err = value(c3,&c1);
if(err)
c1 = c3;
copy(c1,&c2);
u = sqrt1(make_fraction(sum(c1,a),two));
v = sqrt1(make_fraction(sum(c2,tnegate(a)),two));
*next = sum(u, tnegate(product(v,complexi)));
HIGHLIGHT(*next);
strcpy(reason, english(2476));
// "$\\sqrt(a-bi)= \\sqrt((a+c)/2)-\\sqrt((a-c)/2)i$ if b >= 0 and c=\\sqrt(a^2+b^2)"
return 0;
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists