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
8.28.07 modified rectangulartopolar at dated lines
9.4.07 modified complexform
6.4.13 modified recipofi to handle i^(-1)
7.13.13 changed reason strings to avoid OEM characters, using mostly displayed formulas instead.
10.23.24 eliminated OEM for \theta
5.7.24 display math in more reason strings
12.8.24 added sortargs to complexsin and complexcos
1.3.25 corrected rectangular_to_polar
2.26.25 removed unused vars in explicitparams
*/
#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 "complex4.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 */
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;
}
/*_______________________________________________________________*/
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;
}
/*_________________________________________________________________*/
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;
}
/*________________________________________________________________*/
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;
}
/*________________________________________________________________*/
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;
}
/*_______________________________________________________________*/
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,"$\\sqrt(-1) = i$");
HIGHLIGHT(*next);
return 0;
}
/*_______________________________________________________________*/
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 = check1(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)); /* $\\sqrt (-a) = i\\sqrt a$ if $a\\ge 0$ */
HIGHLIGHT(*next);
return 0;
}
/*_______________________________________________________________*/
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 = check1(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;
}
/*_______________________________________________________________*/
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_term,complexi)));
HIGHLIGHT(*next);
strcpy(reason, "$$-a = ae^( pi i)$$");
return 0;
}
/*_______________________________________________________________*/
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_term),theta),le(theta,pi_term)));
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;
x = tnegate(t); // two lines added 8.28.07
y = zero;
}
}
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_term;
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 = check1(lessthan(zero,ARG(0,y)));
if(!err)
{ signy = -1;
commentbuf(0,english(2374));
/* !Assuming that the radius is positive. */
}
}
else
{ err = check1(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_term,two);
else
theta = tnegate(make_fraction(pi_term,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_term,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_term);
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_term,two));
else if(st > LEARNING)
{ err = polyval(r,&temp);
if(!err)
r = temp;
polyval(make_fraction(y,x),&temp);
theta = atan1(temp);
err = evalarctan(theta,arg,&temp,localbuf);
if(!err)
theta = temp;
if(signx < 0 && signy < 0)
{ polyval(sum(theta,tnegate(pi_term)),&u);
theta = u;
}
if(signx < 0 && signy > 0)
{ polyval(sum(pi_term,tnegate(theta)),&u);
theta = u;
}
}
else
{ theta = atan1(make_fraction(y,x));
if(signx < 0 && signy < 0)
theta = sum(theta,tnegate(pi_term));
else if(signx < 0 && signy > 0)
theta = sum(theta,pi_term);
}
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;
}
/*_______________________________________________________________*/
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 theta) = r (cos theta + i sin theta)$$");
return 0;
}
/*_______________________________________________________________*/
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 \\theta)| = 1$");
*next = one;
HIGHLIGHT(*next);
return 0;
}
err = infer(nonnegative(r));
if(!err)
{ strcpy(reason,"$|Re^(i \theta)|=R$ ($R>=0$)");
*next = r;
HIGHLIGHT(*next);
return 0;
}
strcpy(reason,"$|Re^(i \theta)| = |R|$");
*next = abs1(r);
HIGHLIGHT(*next);
return 0;
}
/*_______________________________________________________________*/
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)) != ABSFUNCTOR)
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_term 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_term);
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_term);
*theta = sum(chi,tnegate(u));
}
return 0;
}
return 1;
}
/*_______________________________________________________________*/
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;
}
/*_______________________________________________________________*/
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);
sortargs(u);
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;
}
/*_______________________________________________________________*/
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);
sortargs(u);
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;
}
/*_______________________________________________________________*/
int complexln(term t, term arg, term *next, char *reason)
/* ln(re^(it))=ln r+it (-pi < t <= pi_term) */
/* 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 = check1(lessthan(zero,ARG(0,r)));
sign = -1;
}
else
{ err = check1(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 = check1(lessthan(theta,pi_term));
if(!err)
*next = sum(ln1(tnegate(r)), product(sum(theta,pi_term),complexi));
else
*next = sum(ln1(tnegate(r)), product(sum(theta,tnegate(pi_term)),complexi));
}
}
HIGHLIGHT(*next);
strcpy(reason,"$$ln(re^(i theta))=ln r+i theta$$"); /* restriction on theta left off */
return 0;
}
/*_______________________________________________________________*/
int complexlntopolarform(term t, term arg, term *next, char *reason)
/* ln(u+iv) = ln(re^(i\theta )) */
{ 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;
}
/*_______________________________________________________________*/
int complexsqrt(term t, term arg, term *next, char *reason)
/* sqrt(re^(it))=sqrt r e^(i t/2) (-pi <= t< pi_term) */
{ 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 $\sqrt$ 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,"$$sqrt(re^(i theta))= sqrt(r) e^(i theta/2)$$"); /* (-pi < theta <= 2pi) omitted */
return 0;
}
/*_______________________________________________________________*/
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) */
{ 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 ^n\sqrt 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,"$$ root(n,re^(i theta)) = root(n,r)e^(i theta/n)$$");
return 0;
}
/*_______________________________________________________________*/
int rootofunity(term m, term *ans)
/* produce e^(2\pi 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 = check1(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_term);
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;
}
/*__________________________________________________________*/
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;
}
/*__________________________________________________________*/
int recipofi(term t, term arg, term *next, char *reason)
/* 1/i = -i; a/i = -ai */
{ term denom, num;
if(FUNCTOR(t) == '^' && equals(ARG(0,t),complexi) && equals(ARG(1,t),minusone))
goto out;
if(FUNCTOR(t) != '/')
return 1;
num = ARG(0,t);
denom = ARG(1,t);
if(!ONE(num) || !equals(denom,complexi))
return 1;
out:
tneg(complexi,next);
strcpy(reason,"1/i = -i");
HIGHLIGHT(*next);
return 0;
}
/*__________________________________________________________*/
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;
}
/*__________________________________________________________*/
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;
}
/*__________________________________________________________________*/
int complexabs(term t, term arg, term *next, char *reason)
{ term u,v,temp;
int err;
if(FUNCTOR(t) != ABSFUNCTOR)
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,"$$abs(u + vi) = sqrt (u^2+v^2)$$");
return 0;
}
/*_______________________________________________________________*/
int complexform(term t, term arg, term *next, char *reason)
/* put t in the form x + yi if possible.
This is called in postops on quotients such as (3+2i)/5.
However, it should be x + iy if y is a SQRT, ROOT, or PREFIX functor, or PI.
*/
{ term x,y,p;
unsigned short f;
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;
}
f = FUNCTOR(y);
if(f == PI_ATOM || f == ROOT || f == SQRT || PREFIX(f))
p = signedproduct(complexi,y);
else
p = signedproduct(y,complexi);
*next = sum(x,p);
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;
}
/*_______________________________________________________________*/
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;
}
/*____________________________________________________________________*/
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 theta)=cos theta + i sin theta$$");
return 0;
}
/*____________________________________________________________________*/
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;
}
/*____________________________________________________________________*/
int etotheipi(term t, term arg, term *next, char *reason)
/* e^(i pi_term) = -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_term))
return 1;
*next = minusone;
HIGHLIGHT(*next);
strcpy(reason, "$$e^(i pi) = -1$$");
return 0;
}
/*____________________________________________________________________*/
int etotheminusipi(term t, term arg, term *next, char *reason)
/* e^(-i pi_term) = -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_term))
return 1;
*next = minusone;
HIGHLIGHT(*next);
strcpy(reason, "$$e^(-i pi) = -1$$");
return 0;
}
/*____________________________________________________________________*/
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_term,&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 pi i) = 1$$");
return 0;
}
/*____________________________________________________________________*/
int etothecoterminal(term t, term arg, term *next, char *reason)
/* e^((2n pi + theta )i) = e^(i theta) */
{ 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 pi + theta)i) = e^(i theta)$$");
return 0;
}
/*______________________________________________________________*/
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);
}
/*______________________________________________________________*/
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_term,complexi),index));
*next = product(efactor,make_root(index2,a));
HIGHLIGHT(*next);
strcpy(reason,"$$root(n,-a) = e^(pi i/n) root(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);
}
/*___________________________________________________________________*/
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;
}
/*_______________________________________________________________________*/
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);
}
/*_______________________________________________________________________*/
int factorbydemoivre(term t, term arg, term *next, char *reason)
/* x^n - 1 becomes prod e^(2 k pi i)/n,k,0,n-1); */
{ if(!get_complex())
return 1;
if(FUNCTOR(t) != '+' || ARITY(t) != 2 || FUNCTOR(ARG(0,t)) != '^' || !equals(ARG(1,t),minusone))
return 1;
term n = ARG(1,ARG(0,t));
term k = getindexvar(t, "kmjmpq");
term m;
term numerator;
polyval(product(product(two,pi_term),product(k,complexi)),&numerator);
term right = make_power(eulere,make_fraction(numerator,n));
polyval(sum(n,minusone),&m);
term x = ARG(0,ARG(0,t));
*next = indexedproduct(sum(x,tnegate(right)),k,zero,m);
strcpy(reason, english(166)); /* de Moivre's theorem */
return 0;
}
/*________________________________________________________________________*/
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;
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 */
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_term))
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_term))
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_term))
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_term))
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;
}
/*_______________________________________________________________*/
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;
}
/*_______________________________________________________________*/
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;
}
/*_______________________________________________________________*/
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;
}
/*_______________________________________________________________*/
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;
}
/*_______________________________________________________________*/
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;
}
/*_______________________________________________________________*/
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;
}
/*_______________________________________________________________*/
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;
}
/*_______________________________________________________________*/
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;
}
/*_______________________________________________________________*/
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;
}
/*_______________________________________________________________*/
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;
}
/*_______________________________________________________________*/
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;
}
/*_______________________________________________________________*/
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;
}
/*_______________________________________________________________*/
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;
}
/*_______________________________________________________________*/
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;
}
/*__________________________________________________________________*/
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;
}
/*__________________________________________________________________*/
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;
}
/*__________________________________________________________________*/
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;
}
/*__________________________________________________________________*/
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