Sindbad~EG File Manager
/* extended_polygcd and partial fractions. Note, the
subresultant gcd algorithm in plain vanilla form is in polynoms.c */
/* M. Beeson
original date 2.29.92
Last modified 1.29.98
*/
#include <assert.h>
#include <string.h>
#include "globals.h"
#include "order.h"
#include "cancel.h"
#include "algaux.h"
#include "factor.h"
#include "simpprod.h"
#include "polynoms.h"
#include "mpmem.h"
#include "pvalaux.h" /* polyval2 */
static int partialfractions_aux(term pnum, term p,term q, term powerp, term powerq, term x, term *ans);
static void combine_fractions(term t, term *ans);
/*____________________________________________________________________*/
void extended_polygcd(POLYnomial u, POLYnomial v, POLYnomial *alpha, POLYnomial *beta, POLYnomial *ans)
/* subresultant gcd algorithm, souped up to produce alpha and beta such
that gcd(u,v) = alpha u + alpha v.
All inputs and outputs are POLY terms -- even if the answer is a constant.
*/
/* To describe the algorithm in Knuth's terms:
Add to C1: au = bv = 1; bu=av=0;
Add to C3: au = av; bu = bv;
av = (cc*au-q*av)/gh^delta
bv = (cc*bu-q*bv)/gh^delta
where q is the quotient of the pseudodivision
and cc is the constant produced by the pseudodivision.
This description assumes the above assignments are made
simultaneously; in the code below we have to first
save au and bu before replacing them.
Add to C4: return *alpha = va, *beta = bv
See page 410 of Knuth volume 2.
*/
{ int i,err,err2;
term contentu,contentv;
term temp,trash,c,d,content,au,bu,av,bv,saveau,savebu;
POLYnomial a,b,principalpartu,principalpartv;
term polyzero,polyone;
term delta;
long *deltaval;
term q,r,cc,g,h;
void *savenode = heapmax();
assert(FUNCTOR(u)==POLY);
assert(FUNCTOR(v)==POLY);
/* first make sure u and are primitive */
err = pp(u,&contentu,&principalpartu);
err2 = pp(v,&contentv,&principalpartv);
if(!err && !err2) /* both have nontrivial content */
{ if(INTEGERP(contentu) && INTEGERP(contentv))
gcd(contentu,contentv,&d);
else
polygcd(contentu,contentv,&d);
extended_polygcd(principalpartu,principalpartv,&a,&b,&temp);
*ans = multpolybyconstant(d,temp);
*alpha = multpolybyconstant(d,a);
*beta = multpolybyconstant(d,b);
save_and_reset(and3(*alpha,*beta,*ans),savenode,&temp);
*alpha = ARG(0,temp);
*beta = ARG(1,temp);
*ans = ARG(2,temp);
RELEASE(temp);
return;
}
else if(! err) /* content of u was nontrivial */
{ extended_polygcd(principalpartu,v,&a,&b,&temp);
*ans = multpolybyconstant(contentu,temp);
*alpha = multpolybyconstant(contentu,a);
*beta = multpolybyconstant(contentu,b);
save_and_reset(and3(*alpha,*beta,*ans),savenode,&temp);
*alpha = ARG(0,temp);
*beta = ARG(1,temp);
*ans = ARG(2,temp);
RELEASE(temp);
return;
}
else if(! err2) /* content of v was nontrivial */
{ extended_polygcd(u,principalpartv,&a,&b,&temp);
*ans = multpolybyconstant(contentv,temp);
*alpha = multpolybyconstant(contentv,a);
*beta = multpolybyconstant(contentv,b);
save_and_reset(and3(*alpha,*beta,*ans),savenode,&temp);
*alpha = ARG(0,temp);
*beta = ARG(1,temp);
*ans = ARG(2,temp);
RELEASE(temp);
return;
}
/* Now u and v are primitive */
if(ARITY(v) > ARITY(u)) /* ensure deg(v) \le deg(u) */
{ extended_polygcd(v,u,beta,alpha,ans); /* swap args */
return;
}
polyone = make_term(POLY,1);
polyzero = make_term(POLY,1);
ARGREP(polyone,0,one);
ARGREP(polyzero,0,zero);
g = h = one; /* Step C1 in Knuth */
au = bv = polyone;
bu = av = polyzero;
/* we are going to alter the args of v so we need to copy it first */
copy(v,&temp);
v = temp; /* the local v now points into all new space so the copy of
v in the calling environment can't be disturbed */
delta = make_int(100L); /* create space at *(delta.args) */
KILLARGS(delta); /* avoid destroying a DAG when terms are made below with
two copies of delta in them */
deltaval = (long *) (delta.args);
while(1) /* loop terminated only by return */
{ *deltaval = ARITY(u)-ARITY(v); /* change value of delta without
allocating new space */
pseudodiv(u,v,&q,&r,&cc); /* Step C2 in Knuth */
if(ARITY(r)==1 && ZERO(ARG(0,r))) /* zero remainder */
{ pp(v,&content,ans); /* Step C4 */
c = signedfraction(one,content);
*alpha = multpolybyconstant(c,av);
*beta = multpolybyconstant(c,bv);
save_and_reset(and3(*alpha,*beta,*ans),savenode,&temp);
*alpha = ARG(0,temp);
*beta = ARG(1,temp);
*ans = ARG(2,temp);
RELEASE(temp);
return;
}
/* not yet done, go on to Step C3 in Knuth */
u = v;
v = r;
saveau = multpolybyconstant(cc,au);
savebu = multpolybyconstant(cc,bu);
au = av;
bu = bv;
polymult(q,av,&temp); /* can't be of degree more than 32 K
because degrees of these polys are bounded */
av = polysub(saveau,temp);
polymult(q,bv,&temp);
bv = polysub(savebu,temp);
temp=product(g, make_power(h,delta));
err=value(temp,&c);
if(err == 1)
c = temp;
if(! ONE(c))
{ for(i=0;i<ARITY(v);i++)
{ cancel(ARG(i,v),c,&trash,&temp);
ARGREP(v,i,temp);
}
for(i=0;i<ARITY(av);i++)
{ cancel(ARG(i,av),c,&trash,&temp);
ARGREP(av,i,temp);
}
for(i=0;i<ARITY(bv);i++)
{ cancel(ARG(i,bv),c,&trash,&temp);
ARGREP(bv,i,temp);
}
}
/* next reset g and h */
g = ARG(ARITY(u)-1,u); /* leading coefficient of u */
if(ONE(delta))
h = g;
if(!ZERO(delta))
{ if(equals(delta,minusone))
temp = make_power(g,delta);
else
temp = make_fraction(make_power(g,delta),make_power(h,sum(delta,minusone)));
err = value(temp,&h);
if(err==1)
h = temp;
}
}
}
/*____________________________________________________________________*/
int partialfractions(term t, term x, term *ans)
/* convert a rational function t in variable x to partial fractions form.
The denominator is presumed to be a polynomial or product of (powers of)
polynomials already; no factoring of the denominator is done.
Return zero for success.
This returns zero on polynomials too; in that case *ans = t;
and it also works regardless of the degree of the numerator.
If t is already in partial fractions form still return 0. Return value 1
can arise then either from non-polynomial terms contained in t, or from
polymult giving rise to a polynomial of degree more than 255.
The method uses extended_polygcd as
suggested on p. 215 of Computer Algebra, by Davenport et. al.
Viz: 1/(pq) = (lambda p + mu q)/(pq) = lambda/q + mu/p.
Also: 1/(p^n q) = (lambda p + mu q)/(p^n q) = lambda /(p^(n-1)q + mu /p^n
and then you treat the two terms recursively;
given q/p^n you write q = ap + b so q/p^n = b/p^n + a/p^(n-1)
and treat these terms recursively too.
*/
{ term num,nump,denom,temp,temp1,temp2,pow1,pow2;
term p,q,r,cc,pp,qq,rr,s,s2,a,b;
term powerp,powerq,first,second,c,v,oneoverr;
int err;
unsigned short i,n;
void *savenode;
if (ATOMIC(t))
{ *ans = t;
return 0;
}
if (FUNCTOR(t) == '-')
{ err = partialfractions(ARG(0,t),x,&temp);
if(err)
return err;
*ans = strongnegate(temp);
return 0;
}
if(FUNCTOR(t) != '/')
{ err = makepoly(t,x,ans);
*ans = t; /* don't change the input, so polyvalop won't succeed */
return err;
}
num = ARG(0,t);
if(ZERO(num))
{ *ans = zero;
return 0;
}
denom = ARG(1,t);
err = makepoly(num,x,&nump);
if(err)
{ err = partialfractions(make_fraction(one,denom),x,&temp);
if(err)
return 1;
if(FUNCTOR(temp) != '+')
{ polyval2(product(num,temp),ans);
if(FUNCTOR(*ans) == '*')
sortargs(*ans);
return 0;
}
n = ARITY(temp);
*ans = make_term('+',n);
for(i=0;i<n;i++)
polyval2(product(num,ARG(i,temp)),ARGPTR(*ans)+i);
return 0;
}
if(FUNCTOR(denom) == '^') /* case of num/p^n */
{ if(!INTEGERP(ARG(1,denom)))
return 1;
err = makepoly(ARG(0,denom),x,&p);
if(err)
return 1;
powerp = ARG(1,denom);
if(ARITY(nump) < ARITY(p))
{ *ans = t;
return 0;
}
pseudodiv(nump,p,&q,&r,&cc);
qq = poly_term(q,x);
rr = poly_term(r,x);
pow2 = sum(powerp,minusone);
err = value(pow2,&pow1);
if(err == 1)
pow1 = pow2;
if(ONE(pow1))
{ if(NEGATIVE(cc))
first = signedfraction(tnegate(qq),product(ARG(0,cc),ARG(0,denom)));
else
first = make_fraction(qq, product(cc,ARG(0,denom)));
}
else if(NEGATIVE(cc))
first = signedfraction(tnegate(qq),product(ARG(0,cc),make_power(ARG(0,denom),pow1)));
else
first = make_fraction(qq,product(cc,make_power(ARG(0,denom),pow1)));
second = make_fraction(rr,product(cc,denom));
if(ONE(pow1))
temp = first;
else
{ err = partialfractions(first,x,&temp);
if(err)
assert(0);
}
polyval2(sum(second,temp),ans);
return 0;
}
err = makepoly(denom,x,&p);
if(!err)
{ if(ARITY(p) <= ARITY(nump))
{ pseudodiv(nump,p,&q,&r,&cc);
a = make_fraction(poly_term(q,x),cc);
b = make_fraction(poly_term(r,x),product(cc,denom));
polyval2(sum(a,b),ans);
return 0;
}
*ans = t;
return 0;
}
if(FUNCTOR(denom) != '*')
return 1;
savenode = heapmax();
n = ARITY(denom);
twoparts(denom,x,&c,&v);
if(!ONE(c))
{ err = partialfractions(make_fraction(num,v),x,&temp);
if(err)
{ reset_heap(savenode);
return 1;
}
/* distribute(make_fraction(one,c),temp,ans);
removed to enable this to go into polyval.dll,
which doesn't include distribute; the following
code should be better anyway. */
if(FUNCTOR(temp) != '+')
{ polyval2(make_fraction(temp,c),ans);
save_and_reset(*ans,savenode,ans);
return 0;
}
n = ARITY(temp);
pp = make_term('+',ARITY(temp));
q =make_fraction(one,c);
for(i=0;i<n;i++)
mt(q,ARG(i,temp),ARGPTR(pp)+i);
polyval2(pp,ans);
save_and_reset(*ans,savenode,ans);
return 0;
}
/* Now every factor in denom contains x */
err = makepoly(ARG(0,denom),x,&p);
if(err)
{ if(FUNCTOR(ARG(0,denom))== '^' && INTEGERP(ARG(1,ARG(0,denom))))
{ powerp = ARG(1,ARG(0,denom));
err = makepoly(ARG(0,ARG(0,denom)),x,&p);
if(err)
{ reset_heap(savenode);
return 1;
}
}
else
{ reset_heap(savenode);
return 1;
}
}
else
powerp = one;
err = makepoly(ARG(1,denom),x,&q);
if(err)
{ if(FUNCTOR(ARG(1,denom))== '^' && INTEGERP(ARG(1,ARG(1,denom))))
{ powerq = ARG(1,ARG(1,denom));
err = makepoly(ARG(0,ARG(1,denom)),x,&q);
if(err)
{ reset_heap(savenode);
return 1;
}
}
else
{ reset_heap(savenode);
return 1;
}
}
else
powerq = one;
err = partialfractions_aux(nump,p,q,powerp,powerq,x,&temp);
if(err)
{ reset_heap(savenode);
return 1;
}
save_and_reset(temp,savenode,&temp);
/* although partialfractions calls save_and_reset before exiting,
it makes recursive calls, and must clean up the heap before
doing so. It doesn't do any good to clean up the heap just
before exit if you're going to make deeply nested recursive calls.
*/
if(n==2) /* call it recursively on the summands of temp */
{ err = partialfractions(ARG(0,temp),x,&pp);
if(err)
{ reset_heap(savenode);
return 1;
}
err = partialfractions(ARG(1,temp),x,&qq);
if(err)
{ reset_heap(savenode);
return 1;
}
polyval2(sum(pp,qq),&v);
/* But v can contain fractions whose denominators differ only by an
integer factor; these should be combined. */
combine_fractions(v,ans);
save_and_reset(*ans,savenode,ans);
return 0;
}
/* Now n > 2 */
if(n==3)
rr = ARG(2,denom);
else /* denom = pp * qq * rr */
{ rr = make_term('*',(unsigned short)(n-2));
for(i=2;i<n;i++)
ARGREP(rr,i-2,ARG(i,denom));
}
/* 1/ denom = (alpha pp + beta qq)/ (pp qq rr) == alpha/qq rr + beta/ pp rr */
first = ARG(0,temp);
second = ARG(1,temp);
assert(SIGNEDFRACTION(first));
assert(SIGNEDFRACTION(second));
oneoverr=reciprocal(rr);
temp1 = multiply_cancel_and_order(first,oneoverr);
temp2 = multiply_cancel_and_order(second,oneoverr);
err = partialfractions(temp1,x,&s);
if(err)
{ reset_heap(savenode);
return 1;
}
err = partialfractions(temp2,x,&s2);
if(err)
{ reset_heap(savenode);
return 1;
}
polyval2(sum(s,s2),&v);
combine_fractions(v,ans);
save_and_reset(*ans,savenode,ans);
return 0;
}
/*____________________________________________________________________*/
static int partialfractions_aux(POLYnomial pnum, POLYnomial p, POLYnomial q, term powerp, term powerq, term x, term *ans)
/* pnum, p and q are already POLYnomials;
powerp and powerq are the exponents (maybe 'one') of p and q;
Produce the right-hand side of one of these equations,
where Ap + Bq = 1
num/(pq) = num (Ap + Bq)/(pq) = num A/q + num B/p^n
num/(p^nq) = num (Ap + Bq)/(p^nq) =num A/(p^(n-1)q + num B/p^n
and with p and q switched
num/(p^nq^m) = num (Ap + Bq)/(p^nq^m) = num A/(p^(n-1)q^m) + num B/(p^nq^(m-1)
Return 0 for success; return 1 for failure, which can occur if
the two polynomials are not relatively prime, or if a polynomial
with degree more than 32K arises.
*/
{ term alpha,beta,alpha1,beta1,temp,pp,qq,pp1,qq1,betanum,alphanum,newpower;
int err;
extended_polygcd(p,q,&alpha,&beta,&temp);
if(ARITY(temp) > 1)
return 1; /* polynomials were not relatively prime */
pp = poly_term(p,x);
qq = poly_term(q,x);
err = polymult(alpha,pnum,&alphanum);
if(err)
return 1;
err = polymult(beta,pnum,&betanum);
if(ONE(ARG(0,temp)))
{ alpha1 = poly_term(alphanum,x);
beta1 = poly_term(betanum,x);
}
else
{ term c = reciprocal(ARG(0,temp));
polyval2(product(c,poly_term(alphanum,x)),&alpha1);
polyval2(product(c,poly_term(betanum,x)),&beta1);
}
if(err)
return 1;
if(!ONE(powerp))
{ err = value(sum(powerp,minusone),&newpower);
if(err)
return 1;
pp1 = make_power(pp,newpower);
}
else
pp1 = one;
if(!ONE(powerq))
{ err = value(sum(powerq,minusone),&newpower);
if(err)
return 1;
qq1 = make_power(qq,newpower);
}
else
qq1 = one;
copy(sum(signedfraction(beta1,product(qq1,make_power(pp,powerp))),signedfraction(alpha1,product(pp1,make_power(qq,powerq)))),ans);
/* copy to avoid creating DAGS. Otherwise there are several duplicate
subterms in *ans. */
additive_sortargs(*ans);
return 0;
}
/*_________________________________________________________________*/
static int equals_mod_z(term a, term b)
/* return 1 if a and b differ only by integer factors,
zero if not. */
{ int i,k;
unsigned short n,m;
term u,v;
if(FUNCTOR(a) != '*' && FUNCTOR(b) != '*')
return equals(a,b);
if(FUNCTOR(a) == '*' && INTEGERP(ARG(0,a)))
{ n = ARITY(a);
if(n==2)
u = ARG(1,a);
else
{ u = make_term('*',(unsigned short)(n-1));
for(i=0;i<n-1;i++)
ARGREP(u,i,ARG(i+1,a));
}
}
else
{ u = a;
n = 0; /* so we don't try to RELEASE(u) below */
}
if(FUNCTOR(b) == '*' && INTEGERP(ARG(0,b)))
{ m = ARITY(b);
if(m==2)
v = ARG(1,b);
else
{ v = make_term('*',(unsigned short)(m-1));
for(i=0;i<m-1;i++)
ARGREP(v,i,ARG(i+1,b));
}
}
else
{ v = b;
m = 0;
}
k = equals(u,v) ? 1 : 0;
if(n > 2)
RELEASE(u);
if(m > 2)
RELEASE(v);
return k;
}
/*_________________________________________________________________*/
static void combine_fractions(term t, term *ans)
/* t is a sum. If there are fractions in t whose denominators differ
only by an integer factor, as 1/(2a) and 1/(3a), then add them,
putting the result of all such combinations into *ans. If no
terms combine in this way, make *ans = t.
*/
{ unsigned short n;
int i,j,k;
term u,v,u2,v2,temp,t2;
int savecomdenomflag,savefactorflag,savefactorflag2,savenegexpflag,savefractexpflag;
if(FUNCTOR(t) != '+')
{ *ans = t;
return;
}
savecomdenomflag = get_polyvalcomdenomflag();
savefactorflag = get_polyvalfactorflag();
savefactorflag2 = get_polyvalfactorflag2();
savenegexpflag = get_polyvalnegexpflag();
savefractexpflag = get_polyvalfractexpflag();
set_polyvalcomdenomflag(1);
set_polyvalfactorflag(0);
set_polyvalfactorflag2(0);
set_polyvalnegexpflag(0);
set_polyvalfractexpflag(0);
start:
n = ARITY(t);
for(i=0;i<n;i++)
{ u = ARG(i,t);
if(NEGATIVE(u))
u = ARG(0,u);
if(!FRACTION(u))
continue;
u2 = ARG(1,u);
for(j=i+1;j<n;j++)
{ v = ARG(j,t);
if(NEGATIVE(v))
v = ARG(0,v);
if(!FRACTION(v))
continue;
v2 = ARG(1,v);
if(equals_mod_z(u2,v2))
{ polyval(sum(ARG(i,t),ARG(j,t)),&temp);
if(n==2)
{ *ans = temp;
goto out;
}
if(FUNCTOR(temp) == '+')
continue;
t2 = make_term('+',(unsigned short)(n-1));
for(k=0;k<n-1;k++)
ARGREP(t2,k,k<i? ARG(k,t) : k==i ? temp : k<j ? ARG(k,t) : ARG(k+1,t));
t = t2;
goto start; /* tail recursion */
}
}
}
*ans = t;
out:
set_polyvalcomdenomflag(savecomdenomflag);
set_polyvalfactorflag(savefactorflag);
set_polyvalfactorflag2(savefactorflag2);
set_polyvalnegexpflag(savenegexpflag);
set_polyvalfractexpflag(savefractexpflag);
}
/*_________________________________________________________________*/
#if 0
static int check_term(term t)
/* return 0 if t has a subterm with arity more than 100, 1 otherwise */
/* Used for debugging only. */
{ unsigned short i,n;
if(ATOMIC(t))
return 1;
n = ARITY(t);
if(n > 100)
return 0;
for(i=0;i<n;i++)
{ if(!check_term(ARG(i,t)))
return 0;
}
return 1;
}
#endif
Sindbad File Manager Version 1.0, Coded By Sindbad EG ~ The Terrorists