#
#--> subres(a,b,x)
#
#  Input :   a,b: two multivariate polynomial with algebraic number
#                 coefficients -- rationals, RootOf's or radicals,
#              x: a variable,
#
#  Output:      : returns the subresultant sequence,
#		a sequence of polynomials in decreasing degree in x
#
#  Reference:	"Algorithms for Computer Algebra"
#		Geddes K. O, Labahn G., Czapor S.
#
#		"Computer Algebra"
#		J. Davenport, E. Tournier
#
#  G. Labahn and M. Monagan July 1991.
#


subres := proc(a,b,x) local t,S;
option `Copyright 1991 by the University of Waterloo`;

    if not type(x,name) then ERROR(`3rd argument must be a name`) fi;
    if not type(a,'polynom(anything,x)') or not type(b,polynom(anything,x)) then
	ERROR(`1st and 2nd arguments must be polynomials in `,x) fi;

if printlevel > 1 then
lprint(`subres: starting a subresultant computation at time`,time()) fi;

    if   type(a,'polynom(rational)') and 
         type(b,'polynom(rational)') then S := `subres/rational`(a,b,x);

    elif type(a,'polynom(algnum)') and
         type(b,'polynom(algnum)') then S := `subres/algnum`(a,b,x);

    elif type(a,'polynom(radnum)') and
         type(b,'polynom(radnum)') then
	 S := [`subres/algnum`(convert(a,RootOf), convert(b,RootOf), x)];
	 S := seq( convert(t,radical), t=S );

    else ERROR(`1st and 2nd arguments must multivariate polynomials`.
		`whose coefficients are rationals or algebraic numbers`);
    fi;

if printlevel > 1 then
lprint(`subres: finishing a subresultant computation at time`,time()) fi;

    S;

end:


`subres/rational` := proc(a,b,x)
local c,d,j,u,v,r,g,h,du,ddu,dv,ddv,S,s,t;

	u := expand(a);
	v := expand(b);


        if degree(u,x) < degree(v,x) then
	   t := u; u := v; v := t; s := (-1)^(degree(u,x)*degree(v,x));
        else
	   s := 1;
        fi;


	du := degree(u,x);
	dv := degree(v,x);

if printlevel > 2 then
lprint(`subres: degrees of input polynomials`,du,dv) fi;

	S := collect(u,x);
	ddu := du; ddv := dv;
	if u = 0 or v = 0 then RETURN(S) fi;
	if du = 0 and dv = 0 then RETURN(1) fi;
	if dv = 0 then RETURN(u,v,expand(v^du)) fi;

	c := 1;  g := 1;  h := 1;
	while dv > 0 do
		d := du-dv;
		c := c*(-1)^(du*dv);
		r := prem(u,v,x);
		u := v; v := r; du := dv; dv := degree(r,x);
		j := degree(u,x);
                S := S, collect(s^((ddu-j)*(ddv-j))*u,x);

if printlevel > 2 then
lprint(`subres: degree of pseudo remainder`,degree(u,x)) fi;

		divide(v,g*h^d,'v');
		g := coeff(u,x,du);
		if d = 1 then h := g else divide(g^d,h^(d-1),'h') fi;
	od;
	if du = 1 then RETURN( S, expand(s^(ddu*ddv)*c*v) ) fi;
	divide(v,h,'r');
	S, expand(s^(ddu*ddv)*c*v*r^(du-1));

end:

`subres/algnum` := subs( [divide=evala@Divide,
			 prem=evala@Prem,
			 expand=evala@Expand], " ):

`help/text/subres` := TEXT(
`FUNCTION: subres - subresultant polynomial remainder sequence`,
`      `,
`CALLING SEQUENCE: subres(a,b,x);`,
`      `,
`PARAMETERS:`,
`   a, b - polynomials in the variable x`,
`   x - name`,
`      `,
`SYNOPSIS:   `,
`   `,
`- Given two polynomials a and b in the variable x the function subres`,
`  computes the subresultant PRS of a and b.  The coefficients of polynomials`,
`  a and b can be rational numbers, algebraic numbers, or more generally,`,
`  multivariate polynomials in other variables over the same number field.`,
`   `,
`- The output returned is the subresultant sequence, a sequence of polynomials`,
`  in x in decreasing degree where the last polynomial in the sequence is the`,
`  resultant of a and b in x, which is a constant in x, i.e. it lies in the`,
`  coefficient domain.`,
`      `,
`- Note, the input polynomials can have algebraic numbers represented`,
`  by either radicals or RootOf's, but not a combination of both.`,
`  I.e. the sqrt(2) can be represented by either 2^(1/2) or RootOf(x^2-2,x).`,
`   `,
`- The algorithm is described in the references`,
`   `,
`  "Algorithms for Computer Algebra" by K.O. Geddes, S. Czapor, G. Labahn and`,
`  "Computer Algebra" by J. H. Davenport, Y. Siret, and E. Tournier.`,
`   `,
`EXAMPLES:   `,
`   `,
`> a := x^6+3*x^2+1:`,
`> b := x^4+2*x^2-1:`,
`> subres(a,b,x);`,
`   `,
`                6      2       4      2         2`,
`               x  + 3 x  + 1, x  + 2 x  - 1, 8 x  - 1, 2209`,
`   `,
`> a := y*x^3+y^2*x^2+2*y*x:`,
`> b := (y-1)*x^2+2*y^4*x-y^2:`,
`> subres(a,b,x);`,
`   `,
`      3    2  2                   2      4      2`,
`   y x  + y  x  + 2 y x, (y - 1) x  + 2 y  x - y ,`,
`   `,
`         3      2    4            7      6      9       5    4      7`,
`       (y  - 4 y  + y  + 2 y - 2 y  + 2 y  + 4 y ) x + y  - y  - 2 y ,`,
`   `,
`            12      11      10      9      8      7      5      4`,
`       - 8 y   - 2 y   + 4 y   - 3 y  - 2 y  - 4 y  + 8 y  - 4 y`,
`   `,
`> alias(y = RootOf(x^2-3)):`,
`> a := y*x^3+y^2*x^2+2*y*x:`,
`> b := (y-1)*x^2+2*y^4*x-y^2:`,
`> subres(a,b,x);`,
`   `,
`                  3              2           2`,
`               y x  + 2 y x + 3 x , (y - 1) x  + 18 x - 3,`,
`   `,
`                   (275 y + 51) x - 9 - 45 y, - 765 y - 5058`,
`   `,
`> z := sqrt(3):`,
`> a := z*x^3+z^2*x^2+2*z*x:`,
`> b := (z-1)*x^2+2*z^4*x-z^2:`,
`> subres(a,b,x);`,
`   `,
`           1/2  3      2      1/2      1/2       2`,
`          3    x  + 3 x  + 2 3    x, (3    - 1) x  + 18 x - 3,`,
`   `,
`                    1/2                   1/2         1/2`,
`              (275 3    + 51) x - 9 - 45 3   , - 765 3    - 5058`,
`   `,
`SEE ALSO:  resultant, prem, RootOf`
):

#save `subres.m`;
#quit
