Sindbad~EG File Manager
/* infinite series, algebraic manipulations */
/* M. Beeson, for Mathpert */
/*
1.13.99 original date
1.21.99 last modified
9.2.04 added rhs_name argument to enter_definition calls
1.16.05 commented out AddUserItem calls
2.9.05 modified includes
*/
#include <string.h>
#include <assert.h>
#include <math.h> /* fabs */
#define SERIES_DLL
#include "globals.h"
#include "series.h"
#include "match.h"
#include "prover.h" /* getnewintvar1 */
#include "symbols.h"
#include "errbuf.h"
#include "psubst.h"
#include "pvalaux.h" /* twoparts */
#include "ssolve.h"
#include "islinear.h"
#include "userfunc.h"
#include "deval.h"
#include "graphstr.h"
#include "document.h"
#include "automode.h" /* opcommand */
#include "operator.h" /* functions_menu */
#include "dispfunc.h" /* newfunctor */
#include "mstring.h"
/* following line from opmenus.h; we don't include opmenus.h because it
mentions HMENU and we otherwise do not need windows.h in this file. */
/*_______________________________________________________________*/
MEXPORT_SERIES int addseries(term t, term arg, term *next, char *reason)
/* add two or more infinite series getting a single series */
{ unsigned short n,i;
term u,lo,hi,k,temp,v;
long flag,j,sign;
if(FUNCTOR(t) != '+')
return 1;
n = ARITY(t);
u = ARG(0,t);
if(FUNCTOR(u) != SUM)
return 1;
lo = ARG(2,u);
hi = ARG(3,u);
k = ARG(1,u);
flag = ARITY(u) == 4 ? 0 : NEGATIVE(ARG(4,u)) ? INTDATA(ARG(0,ARG(4,u))) : INTDATA(ARG(4,u));
for(i=1;i<n;i++)
{ u = ARG(i,t);
if(NEGATIVE(u))
u = ARG(0,u);
if(FUNCTOR(u) != SUM)
return 1;
if(ARITY(u) == 4)
flag = 0;
else if(flag && ISINTEGER(ARG(4,u))) /* show as many terms as are showing in any summand */
{ if(flag < 0)
flag = -flag;
if(flag < INTDATA(ARG(4,u)))
flag = INTDATA(ARG(4,u));
}
else if(flag && NEGATIVE(ARG(4,u)))
{ j = INTDATA(ARG(0,ARG(4,u)));
if(flag > 0 && j > flag)
flag = j;
else if(flag < 0 && j > -flag)
flag = j;
else if(flag < 0)
flag = -flag; /* show the general term if any summand has a general term showing */
}
if(!equals(ARG(2,u),lo))
{ errbuf(0, english(2336));
/* Lower limits of summation are not the same. */
return 1;
}
if(!equals(ARG(3,u),hi))
{ errbuf(0, english(2337));
/* Upper limits of summation are not the same. */
return 1;
}
if(!equals(ARG(1,u),k) && contains(u,FUNCTOR(k)))
{ errbuf(0, english(2338));
/* You must rename one or more of the summation variables first. */
return 1;
}
}
v = make_term('+',n);
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(NEGATIVE(u))
{ sign = -1;
u = ARG(0,u);
}
else
sign = 1;
if(!equals(k,ARG(1,u)))
subst(k,ARG(1,u),ARG(0,u),&temp);
else
copy(ARG(0,u),&temp);
if(sign == 1)
ARGREP(v,i,temp);
else
ARGREP(v,i,tnegate(temp));
}
if(flag == 0)
*next = sigma(v,k,lo,hi);
else if(flag < 0)
*next = series(v,k,lo,hi,make_int(-flag));
else
*next = series(v,k,lo,hi,make_int(flag));
HIGHLIGHT(*next);
strcpy(reason,english(2334)); /* add series */
return 0;
}
/*_______________________________________________________________*/
MEXPORT_SERIES int subseries(term t, term arg, term *next, char *reason)
/* subtract two infinite series getting a single series */
{ int err;
if(FUNCTOR(t) != '+')
return 1;
if(ARITY(t) != 2)
return 1;
if(!NEGATIVE(ARG(1,t)))
return 1;
err = addseries(t,arg,next,reason);
if(err)
return 1;
strcpy(reason,english(2335)); /* subtract series */
return 0;
}
/*_______________________________________________________________*/
MEXPORT_SERIES int seriesevenandodd(term t, term arg, term *next, char *reason)
/* separate terms with even and odd indices */
{ term u,v,w,k,lo,a,b;
if(FUNCTOR(t)!= SUM || !equals(ARG(3,t),infinity))
return 1;
lo = ARG(2,t);
k = ARG(1,t);
u = ARG(0,t);
psubst(product(two,k),k,u,&v);
psubst(sum(product(two,k),one),k,u,&w);
a = ARITY(t) == 4 ? sigma(v,k,lo,infinity) : series(v,k,lo,infinity,ARG(4,t));
b = ARITY(t) == 4 ? sigma(w,k,lo,infinity) : series(w,k,lo,infinity,ARG(4,t));
*next = sum(a,b);
HIGHLIGHT(*next);
strcpy(reason,"$� a_k = �a_(2k) + �a_(2k+1)$");
return 0;
}
/*_______________________________________________________________*/
MEXPORT_SERIES int multiplyseries(term t, term arg, term *next, char *reason)
/* multiply a product of infinite series getting a double summation */
/* FINISH THIS: absolute convergence is required */
{ term m,n,u,v,lo1,lo2,hi1,hi2,a,b,w;
int saveflag;
if(FUNCTOR(t) != '*' || ARITY(t) != 2)
return 1;
a = ARG(0,t);
b = ARG(1,t);
if(FUNCTOR(a) != SUM || FUNCTOR(b) != SUM)
return 1;
u = ARG(0,a);
v = ARG(0,b);
m = ARG(1,a);
n = ARG(1,b);
lo1 = ARG(2,a);
lo2 = ARG(2,b);
hi1 = ARG(3,a);
hi2 = ARG(3,b);
if(equals(m,n))
{ errbuf(0, english(2330));
/* You must first rename one of the summation variables */
return 1;
}
saveflag = get_polyvalzeropowerflag();
set_polyvalzeropowerflag(1);
polyval(product(u,v),&w);
set_polyvalzeropowerflag(saveflag);
*next = indexedsum( indexedsum(w,n,lo2,hi2),m,lo1,hi1);
strcpy(reason, english(2331)); /* multiply series */
HIGHLIGHT(*next);
return 0;
}
/*_______________________________________________________________*/
MEXPORT_SERIES int squareseries(term t, term arg, term *next, char *reason)
{ return 1; /*FINISH THIS */
}
/*_______________________________________________________________*/
MEXPORT_SERIES int squarepowerseries(term t, term arg, term *next, char *reason)
{ return 1; /* FINISH THIS */
}
/*_______________________________________________________________*/
MEXPORT_SERIES int multiplypowerseries(term t, term arg, term *next, char *reason)
/* The rule is straightforward if the series have the form a_nx^n, but if they have
the form a_nx^f(n) it's tricky. We can only handle exponents which are linear in n
and the two exponents must have the same coefficient of the index variable.
*/
{ term m,n,u,v,lo1,lo2,p,q,r,s,a,b,x,ar,br,as,bs,newcoef,newexp,newsummand,k,bk;
if(FUNCTOR(t) != '*' || ARITY(t) != 2)
return 1;
p = ARG(0,t);
q = ARG(1,t);
if(FUNCTOR(p) != SUM || FUNCTOR(q) != SUM)
return 1;
u = ARG(0,p);
v = ARG(0,q);
m = ARG(1,p);
n = ARG(1,q);
lo1 = ARG(2,p);
lo2 = ARG(2,q);
if(equals(m,n) || contains(p,FUNCTOR(n)) || contains(q,FUNCTOR(m)))
{ errbuf(0, english(2330));
/* You must first rename one of the summation variables */
return 1;
}
x = get_eigenvariable();
twoparts(u,x,&a,&r);
twoparts(v,x,&b,&s);
if(FUNCTOR(r) != '^')
{ if(FRACTION(r) && FUNCTOR(ARG(0,r)) == '^' &&
ISATOM(ARG(0,ARG(0,r))) &&
!contains(ARG(1,r),FUNCTOR(x))
)
{ polyval(make_fraction(a,ARG(1,r)),&a);
r = ARG(0,r);
}
}
if(FUNCTOR(s) != '^')
{ if(FRACTION(s) && FUNCTOR(ARG(0,s)) == '^' &&
ISATOM(ARG(0,ARG(0,s))) &&
!contains(ARG(1,s),FUNCTOR(x))
)
{ polyval(make_fraction(b,ARG(1,s)),&b);
s = ARG(0,s);
}
}
if(!equals(ARG(0,r),ARG(0,s)))
return 1;
if(!equals(x,ARG(0,r)))
x = ARG(0,r); /* example, series in (x-a) instead of in x */
r = ARG(1,r);
s = ARG(1,s);
/* Example. Multiplying the series for sin and cos we have
r = 2n, s = 2m+1, a = (-1)^n/(2n)!, b = (-1)^n/(2m+1)! */
if(islinear(r,m,&ar,&br) && islinear(s,n,&as,&bs))
{ /* In the example ar = as = 2 */
/* The new exponent is ar(n+m)+br+bs; we make k = n+m and
then the new coefficient of x^(ar k + br + bs)
is (sum(a[m]b[k-m],m,lo,k-lo) */
if(!equals(ar,as))
{ errbuf(0, english(2340));
/* First rewrite one or both of the series, to arrange that
the exponents have the same coefficient of the summation variable. */
return 1;
}
k = getnewindexvar(t,"knmjpqrs");
if(FUNCTOR(k) == ILLEGAL)
{ errbuf(0, english(1448));
/* Too many subscripted variables, can't make more. */
return 1;
}
psubst(sum(k,tnegate(m)),n,b,&bk);
newcoef = sigma(product(a,bk),m,lo1,sum(k,strongnegate(lo2)));
if(ZERO(br) && ZERO(bs))
newexp = product(ar,k);
else if(ZERO(br))
newexp = sum(product(ar,k),bs);
else if(ZERO(bs))
newexp = sum(product(ar,k),br);
else
{ newexp = make_term('+',3);
ARGREP(newexp,0,product(ar,k));
ARGREP(newexp,1,br);
ARGREP(newexp,2,bs);
}
newsummand = product(newcoef,make_power(x,newexp));
if(ARITY(p)==4 || ARITY(q) == 4)
*next = sigma(newsummand,k,lo2,infinity);
else if (NEGATIVE(ARG(4,p)) && NEGATIVE(ARG(4,q)))
{ if(INTDATA(ARG(0,ARG(4,p))) > INTDATA(ARG(0,ARG(4,q))))
*next = series(newsummand,k,lo2,infinity,ARG(4,p));
else
*next = series(newsummand,k,lo2,infinity,ARG(4,q));
}
else if(NEGATIVE(ARG(4,p)))
*next = series(newsummand,k,lo2,infinity,ARG(4,q));
else
*next = series(newsummand,k,lo2,infinity,ARG(4,p));
HIGHLIGHT(*next);
strcpy(reason, english(2331)); /* multiply series */
return 0;
}
return 1; /* Can any more complicated cases be handled? */
}
/*_______________________________________________________________*/
MEXPORT_SERIES int dividepowerseries(term t, term arg, term *next, char *reason)
/* In dividing series, the coefficients of the quotient are not given in closed form,
but only by a recurrence relation. Mathpert will define a function to give this
recurrence relation and use the new function in the answer.
*/
{ term m,n,u,v,lo1,lo2,p,q,r,s,a,b,x,ar,br,as,bs;
term newcoef,newexp,newsummand,k,bk,temp,temp2,uk,v0,v00,wm,wk,rhs;
int saveflag;
unsigned short f;
int k3;
char printname[3];
char rhs_name[128];
term *atomlist;
double zz;
int nvars,err;
if(FUNCTOR(t) != '/' || ARITY(t) != 2)
return 1;
p = ARG(0,t);
q = ARG(1,t);
if(FUNCTOR(p) != SUM || FUNCTOR(q) != SUM)
return 1;
u = ARG(0,p);
v = ARG(0,q);
m = ARG(1,p);
n = ARG(1,q);
lo1 = ARG(2,p);
lo2 = ARG(2,q);
if(equals(m,n) || contains(p,FUNCTOR(n)) || contains(q,FUNCTOR(m)))
{ errbuf(0, english(2330));
/* You must first rename one of the summation variables */
return 1;
}
x = get_eigenvariable();
saveflag = get_polyvalzeropowerflag();
set_polyvalzeropowerflag(1);
twoparts(u,x,&a,&r);
twoparts(v,x,&b,&s);
if(FUNCTOR(r) != '^')
{ if(FRACTION(r) && FUNCTOR(ARG(0,r)) == '^' &&
ISATOM(ARG(0,ARG(0,r))) &&
!contains(ARG(1,r),FUNCTOR(x))
)
{ polyval(make_fraction(a,ARG(1,r)),&a);
r = ARG(0,r);
}
}
if(FUNCTOR(s) != '^')
{ if(FRACTION(s) && FUNCTOR(ARG(0,s)) == '^' &&
ISATOM(ARG(0,ARG(0,s))) &&
!contains(ARG(1,s),FUNCTOR(x))
)
{ polyval(make_fraction(b,ARG(1,s)),&b);
s = ARG(0,s);
}
}
if(!equals(ARG(0,r),ARG(0,s)))
{ set_polyvalzeropowerflag(saveflag);
return 1;
}
if(!equals(ARG(0,r),x))
x = ARG(0,r); /* example, a series in (x-a) instead of in x */
r = ARG(1,r);
s = ARG(1,s);
nvars = variablesin(a,&atomlist);
if(nvars != 0 && (nvars != 1 || !equals(atomlist[0],m)))
{ errbuf(0, english(2342));
/* Mathpert requires numerical coefficients for series division. */
free2(atomlist);
set_polyvalzeropowerflag(saveflag);
return 1;
}
free2(atomlist);
nvars = variablesin(b,&atomlist);
if(nvars != 0 && (nvars != 1 || !equals(atomlist[0],n)))
{ errbuf(0, english(2342));
/* Mathpert requires numerical coefficients for series division. */
free2(atomlist);
set_polyvalzeropowerflag(saveflag);
return 1;
}
free2(atomlist);
/* Example. Dividing the series for sin and cos we have
r = 2n, s = 2m+1, a = (-1)^n/(2n)!, b = (-1)^n/(2m+1)! */
/* check for nonzero constant term in the denominator */
subst(lo2,n,s,&temp);
polyval(temp,&temp2);
if(!ZERO(temp2))
{ errbuf(0, english(2341));
/* First term in the denominator must be the constant term */
set_polyvalzeropowerflag(saveflag);
return 1;
}
subst(lo2,n,b,&temp);
polyval(temp,&temp2);
if(ZERO(temp2))
{ errbuf(0, english(2343));
/* Constant term must be nonzero for series division. */
set_polyvalzeropowerflag(saveflag);
return 1;
}
deval(temp2,&zz);
if(zz == BADVAL || fabs(zz) < VERYSMALL)
{ errbuf(0, english(2343));
/* Constant term must be nonzero for series division. */
set_polyvalzeropowerflag(saveflag);
return 1;
}
/* Now we've verified that the series have numerical coefficients and there is
a nonzero constant term in the denominator. */
if(islinear(r,m,&ar,&br) && islinear(s,n,&as,&bs))
{ /* In the example ar = as = 2 */
/* The new exponent is ar(n+m)+br+bs; we make k = n+m and
then the new coefficient of x^(ar k + br + bs)
is (sum(a[m]b[k-m],m,lo,k-lo) */
if(!equals(ar,as))
{ errbuf(0, english(2340));
/* First rewrite one or both of the series, to arrange that
the exponents have the same coefficient of the summation variable. */
return 1;
}
k = getnewindexvar(t,"knmjpqrs");
if(FUNCTOR(k) == ILLEGAL)
{ errbuf(0, english(1448));
/* Too many subscripted variables, can't make more. */
return 1;
}
/* Now we have to define the recursion relation for the coefficients.
The case ar = as = 1, br = bs = 0 is treated in Knuth vol. 2, page 506. */
psubst(k,m,a,&uk);
psubst(lo2,n,b,&v0);
psubst(sum(k,tnegate(m)),n,b,&bk);
err = get_new_fname(&f,printname);
f = newfunctor(printname,1);
if(err)
{ errbuf(0, english(2344));
/* There are too many function definitions. Undefine a function to make room for the
definition of the coefficients of the quotient. */
return 1;
}
wm = make_term(f,1);
ARGREP(wm,0,m);
wk = make_term(f,1);
SET_SUBSCRIPTARGS(wk);
SET_SUBSCRIPTARGS(wm);
ARGREP(wk,0,k);
copy(v0,&v00); /* avoid using v0 twice, which would create a DAG */
temp = sum(make_fraction(uk,v0),tnegate(product(reciprocal(v00),sigma(product(wm,bk),m,lo1,sum(k,strongnegate(sum(lo2,one)))))));
polyval(temp,&rhs);
set_polyvalzeropowerflag(saveflag);
mstring(rhs, rhs_name);
enter_definition(wk,rhs,printname,rhs_name);
newcoef = wk;
if(ZERO(br) && ZERO(bs))
newexp = product(ar,k);
else if(ZERO(br))
newexp = sum(product(ar,k),bs);
else if(ZERO(bs))
newexp = sum(product(ar,k),br);
else
{ newexp = make_term('+',3);
ARGREP(newexp,0,product(ar,k));
ARGREP(newexp,1,br);
ARGREP(newexp,2,bs);
}
newsummand = product(newcoef,make_power(x,newexp));
if(ARITY(p)==4 || ARITY(q) == 4)
*next = sigma(newsummand,k,lo2,infinity);
else if (NEGATIVE(ARG(4,p)) && NEGATIVE(ARG(4,q)))
{ if(INTDATA(ARG(0,ARG(4,p))) > INTDATA(ARG(0,ARG(4,q))))
*next = series(newsummand,k,lo2,infinity,ARG(4,p));
else
*next = series(newsummand,k,lo2,infinity,ARG(4,q));
}
else if(NEGATIVE(ARG(4,p)))
*next = series(newsummand,k,lo2,infinity,ARG(4,q));
else
*next = series(newsummand,k,lo2,infinity,ARG(4,p));
HIGHLIGHT(*next);
strcpy(reason, english(2333)); /* divide power series */
k3 = nuserfunctions()-1;
// AddUserItem(functions_menu,opcommand(functions_menu,k3),get_defnstring(k3)); FIX THIS--can't handle recursive function definitions yet
return 0;
}
set_polyvalzeropowerflag(saveflag);
return 1; /* maybe some more complicated forms of exponents could be handled later. */
}
/*_______________________________________________________________*/
MEXPORT_SERIES int divideseriesbypoly(term t, term arg, term *next, char *reason)
/* In case the divisor (denominator) is a polynomial of degree n, the recurrence formula for division of
series only involves the n previous values, rather than a summation over all previous
values. But it's still a recurrence relation so the same code is used.
*/
{ return 1;
}
/*_______________________________________________________________*/
MEXPORT_SERIES int dividepolybyseries(term t, term arg, term *next, char *reason)
/* In case the numerator is a polynomial of degree n, the recurrence formula for division of
series only involves the n previous values, rather than a summation over all previous
values. But it's still a recurrence relation so the same code is used.
*/
{ return 1;
}
/*_______________________________________________________________*/
MEXPORT_SERIES int powerofseries(term t, term arg, term *next, char *reason)
/* Express a power of a power series as a new series, whose coefficients are defined
by a recurrence relation. See Knuth volume 2, page 507.
*/
{ term m,u,lo,alpha,p,r,A,b,x,a,coef1, coef2, part3, leadingexp, w_kminusm,u0;
term newcoef,newexp,newsummand,k,temp,wk,rhs,temp2,w0;
int saveflag;
unsigned short f;
int k3;
char printname[3];
char rhs_name[128];
term *atomlist;
double zz;
int nvars,err;
if(FUNCTOR(t) != '^')
return 1;
p = ARG(0,t);
alpha = ARG(1,t);
if(FUNCTOR(p) != SUM)
return 1;
u = ARG(0,p);
m = ARG(1,p);
lo = ARG(2,p);
x = get_eigenvariable();
saveflag = get_polyvalzeropowerflag();
set_polyvalzeropowerflag(1);
twoparts(u,x,&A,&r);
if(FUNCTOR(r) != '^')
{ if(FRACTION(r) && FUNCTOR(ARG(0,r)) == '^' &&
ISATOM(ARG(0,ARG(0,r))) &&
!contains(ARG(1,r),FUNCTOR(x))
)
{ polyval(make_fraction(A,ARG(1,r)),&A);
r = ARG(0,r);
}
}
x = ARG(0,r);
r = ARG(1,r);
nvars = variablesin(A,&atomlist);
if(nvars != 0 && (nvars != 1 || !equals(atomlist[0],m)))
{ errbuf(0, english(2353));
/* Mathpert requires numerical coefficients for series exponentiation. */
free2(atomlist);
set_polyvalzeropowerflag(saveflag);
return 1;
}
free2(atomlist);
if(!seminumerical(alpha))
{ errbuf(0, english(2354)); /* Exponent must be a number. */
return 1;
}
subst(lo,m,A,&temp);
polyval(temp,&u0);
if(ZERO(u0))
{ errbuf(0, english(2356));
/* Leading coefficient must be nonzero for series exponentiation. */
set_polyvalzeropowerflag(saveflag);
return 1;
}
deval(u0,&zz);
if(zz == BADVAL || fabs(zz) < VERYSMALL)
{ errbuf(0, english(2356));
/* Constant term must be nonzero for series exponentiation. */
set_polyvalzeropowerflag(saveflag);
return 1;
}
if(ONE(u0))
w0 = one;
else
polyval(make_power(u0,alpha),&w0);
subst(lo,m,r,&temp);
polyval(temp,&leadingexp);
if(islinear(r,m,&a,&b))
{ k = getnewindexvar(t,"knmjpqrs");
if(FUNCTOR(k) == ILLEGAL)
{ errbuf(0, english(1448));
/* Too many subscripted variables, can't make more. */
return 1;
}
/* Now we have to define the recursion relation for the coefficients.
The case a = 1, b = 0 is treated in Knuth vol. 2, page 507.
In the general case when V = sum V_k z^(ak+b), equation (8)
on that page becomes:
sum akW_kV_{n-k} = alpha sum (n-k+b)W_kV_{n-k}
Equation (9) then becomes
W_n = sum ((alpha + a)/(nV_0)) k + alpha b/n - a) V_k W_{n-k}
which is implemented here.
*/
err = get_new_fname(&f,printname);
f = newfunctor(printname,1);
if(err)
{ errbuf(0, english(2344));
/* There are too many function definitions. Undefine a function to make room for the
definition of the coefficients of the quotient. */
return 1;
}
w_kminusm = make_term(f,1);
ARGREP(w_kminusm,0,sum(k,tnegate(m)));
wk = make_term(f,1);
SET_SUBSCRIPTARGS(wk);
SET_SUBSCRIPTARGS(w_kminusm);
/* m is the summation variable, too bad it's k in Knuth's formula, sorry about that.
My k is Knuth's n, my m is Knuth's k. Also u here is Knuth's V. */
ARGREP(wk,0,k);
polyval(make_fraction(sum(alpha,a),product(k,u0)),&coef1);
polyval(sum(make_fraction(product(alpha,b),k),tnegate(a)),&coef2);
part3 = sum(product(coef1,m),coef2);
temp = sigma(product3(part3,w_kminusm,A),m,one,k);
polyval(temp,&temp2);
rhs = cases2(if1(equation(k,zero),w0),temp2);
set_polyvalzeropowerflag(saveflag);
mstring(rhs,rhs_name);
enter_definition(wk,rhs,printname, rhs_name);
newcoef = wk;
newexp = product(a,k);
newsummand = product(newcoef,make_power(x,newexp));
if(ARITY(p)==4)
*next = sigma(newsummand,k,lo,infinity);
else
*next = series(newsummand,k,lo,infinity,ARG(4,p));
/* Now correct for the case of non-zero leading exponent */
if(!ZERO(leadingexp))
{ polyval(product(alpha,leadingexp),&newexp);
*next = product(make_power(x,newexp),*next);
}
HIGHLIGHT(*next);
strcpy(reason, english(2355)); /* express $ (sum a_k)^n$ as a series */
k3 = nuserfunctions()-1;
// AddUserItem(functions_menu,opcommand(functions_menu,k3),get_defnstring(k3));
return 0;
}
set_polyvalzeropowerflag(saveflag);
return 1; /* maybe some more complicated forms of exponents could be handled later. */
}
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists