)abbrev domain NSUP NewSparseUnivariatePolynomial
++ Author: Marc Moreno Maza
++ Date Created: 23/07/98
++ Basic Operations:
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ Examples:
++ References:
++ Description: A post-facto extension for \spadtype{SUP} in order
++ to speed up operations related to pseudo-division and gcd for
++ both \spadtype{SUP} and, consequently, \spadtype{NSMP}.

NewSparseUnivariatePolynomial(R) : Exports == Implementation where

  R : Ring
  NNI ==> NonNegativeInteger
  SUPR ==> SparseUnivariatePolynomial R

  Exports == Join(UnivariatePolynomialCategory(R),
   CoercibleTo(SUPR), RetractableTo(SUPR)) with
     monicModulo : (%, %) -> %
        ++ \spad{monicModulo(a, b)} returns \spad{r} such that \spad{r} is
        ++ reduced w.r.t. \spad{b} and \spad{b} divides \spad{a - r}
        ++ where \spad{b} is monic.
     lazyResidueClass : (%, %) -> Record(polnum : %, polden : R, power : NNI)
        ++ \spad{lazyResidueClass(a, b)} returns \spad{[r, c, n]} such that
        ++ \spad{r} is reduced w.r.t. \spad{b} and \spad{b} divides
        ++ \spad{c^n * a - r} where \spad{c} is \spad{leadingCoefficient(b)}
        ++ and \spad{n} is as small as possible with the previous properties.
     lazyPseudoRemainder : (%, %) -> %
        ++ \spad{lazyPseudoRemainder(a, b)} returns \spad{r} if \spad{lazyResidueClass(a, b)}
        ++ returns \spad{[r, c, n]}. This lazy pseudo-remainder is computed by
        ++ means of the \spadopFrom{fmecg}{NewSparseUnivariatePolynomial} operation.
     lazyPseudoDivide : (%, %) -> Record(coef : R, gap : NNI, quotient : %, remainder : %)
        ++ \spad{lazyPseudoDivide(a, b)} returns \spad{[c, g, q, r]} such that
        ++ \spad{c^n * a = q*b +r} and \spad{lazyResidueClass(a, b)} returns \spad{[r, c, n]}
        ++ where \spad{n + g = max(0, degree(b) - degree(a) + 1)}.
     lazyPseudoQuotient : (%, %) -> %
        ++ \spad{lazyPseudoQuotient(a, b)} returns \spad{q} if \spad{lazyPseudoDivide(a, b)}
        ++ returns \spad{[c, g, q, r]}
     if R has IntegralDomain then
       subResultantsChain : (%, %) -> List %
         ++ \spad{subResultantsChain(a, b)} returns the list of the non-zero
         ++ sub-resultants of \spad{a} and \spad{b} sorted by increasing
         ++ degree.
       lastSubResultant : (%, %) -> %
         ++ \spad{lastSubResultant(a, b)} returns \spad{resultant(a, b)}
         ++ if \spad{a} and \spad{b} has no non-trivial gcd in \spad{R^(-1) P}
         ++ otherwise the non-zero sub-resultant with smallest index.
       extendedSubResultantGcd : (%, %) -> Record(gcd : %, coef1 : %, coef2 : %)
         ++ \spad{extendedSubResultantGcd(a, b)} returns \spad{[g, ca, cb]} such
         ++ that \spad{g} is a gcd of \spad{a} and \spad{b} in \spad{R^(-1) P}
         ++ and \spad{g = ca * a + cb * b}
       halfExtendedSubResultantGcd1 : (%, %) -> Record(gcd : %, coef1 : %)
         ++ \spad{halfExtendedSubResultantGcd1(a, b)} returns \spad{[g, ca]} such that
         ++ \spad{extendedSubResultantGcd(a, b)} returns \spad{[g, ca, cb]}
       halfExtendedSubResultantGcd2 : (%, %) -> Record(gcd : %, coef2 : %)
         ++ \spad{halfExtendedSubResultantGcd2(a, b)} returns \spad{[g, cb]} such that
         ++ \spad{extendedSubResultantGcd(a, b)} returns \spad{[g, ca, cb]}
       extendedResultant : (%, %) -> Record(resultant : R, coef1 : %, coef2 : %)
         ++ \spad{extendedResultant(a, b)} returns \spad{[r, ca, cb]} such that
         ++ \spad{r} is the resultant of \spad{a} and \spad{b} and
         ++ \spad{r = ca * a + cb * b}
       halfExtendedResultant1 : (%, %) -> Record(resultant : R, coef1 : %)
         ++ \spad{halfExtendedResultant1(a, b)} returns \spad{[r, ca]} such that
         ++ \spad{extendedResultant(a, b)} returns \spad{[r, ca, cb]}
       halfExtendedResultant2 : (%, %) -> Record(resultant : R, coef2 : %)
         ++ \spad{halfExtendedResultant2(a, b)} returns \spad{[r, ca]} such that
         ++ \spad{extendedResultant(a, b)} returns \spad{[r, ca, cb]}

  Implementation == SparseUnivariatePolynomial(R) add

     Term ==> Record(k : NonNegativeInteger, c : R)
     Rep ==> List Term

     rep(s : %) : Rep == s pretend Rep
     per(l : Rep) : % == l pretend %

     coerce (p : %) : SUPR ==
       p pretend SUPR

     coerce (p : SUPR) : % ==
       p pretend %

     retractIfCan (p:%) : Union(SUPR,"failed") ==
       (p pretend SUPR)::Union(SUPR,"failed")

     monicModulo(x, y) ==
         zero? y =>
             error "in monicModulo$NSUP: division by 0"
         ground? y =>
             error "in monicModulo$NSUP: ground? #2"
         yy := rep y
         not ((yy.first.c) = 1) =>
             error "in monicModulo$NSUP: not monic #2"
         xx := rep x; empty? xx => x
         e := yy.first.k; y := per(yy.rest)
         -- while (not empty? xx) repeat
         repeat
             if (u := subtractIfCan(xx.first.k,e)) case "failed" then break
             xx := rep fmecg(per rest(xx), u, xx.first.c, y)
             if empty? xx then break
         per xx

     lazyResidueClass(x, y) ==
                zero? y =>
                   error "in lazyResidueClass$NSUP: division by 0"
                ground? y =>
                   error "in lazyResidueClass$NSUP: ground? #2"
                yy := rep y; co := yy.first.c; xx : Rep := rep x
                empty? xx => [x, co, 0]
                pow : NNI := 0; e := yy.first.k; y := per(yy.rest);
                repeat
                  if (u := subtractIfCan(xx.first.k,e)) case "failed" then break
                  xx := rep fmecg(co * per rest(xx), u, xx.first.c, y)
                  pow := pow + 1
                  if empty? xx then break
                [per xx, co, pow]

     lazyPseudoRemainder(x, y) ==
                zero? y =>
                   error "in lazyPseudoRemainder$NSUP: division by 0"
                ground? y =>
                   error "in lazyPseudoRemainder$NSUP: ground? #2"
                ground? x => x
                yy := rep y; co := yy.first.c
                (co = 1) => monicModulo(x, y)
                (co = -1) => - monicModulo(-x, -y)
                xx := rep x; e := yy.first.k; y := per(yy.rest)
                repeat
                  if (u := subtractIfCan(xx.first.k,e)) case "failed" then break
                  xx := rep fmecg(co * per rest(xx), u, xx.first.c, y)
                  if empty? xx then break
                per xx

     lazyPseudoDivide(x, y) ==
                zero? y =>
                   error "in lazyPseudoDivide$NSUP: division by 0"
                ground? y =>
                   error "in lazyPseudoDivide$NSUP: ground? #2"
                yy := rep y; e := yy.first.k;
                xx : Rep := rep x; co := yy.first.c
                (empty? xx) or (xx.first.k < e) => [co, 0, 0, x]
                pow : NNI := subtractIfCan(xx.first.k, e)::NNI + 1
                qq : Rep := []; y := per(yy.rest)
                repeat
                  if (u := subtractIfCan(xx.first.k,e)) case "failed" then break
                  qq := cons([u@NNI, xx.first.c]$Term, rep (co * per qq))
                  xx := rep fmecg(co * per rest(xx), u, xx.first.c, y)
                  pow := subtractIfCan(pow, 1)::NNI
                  if empty? xx then break
                [co, pow, per reverse qq, per xx]

     lazyPseudoQuotient(x, y) ==
                zero? y =>
                   error "in lazyPseudoQuotient$NSUP: division by 0"
                ground? y =>
                   error "in lazyPseudoQuotient$NSUP: ground? #2"
                yy := rep y; e := yy.first.k; xx : Rep := rep x
                (empty? xx) or (xx.first.k < e) => 0
                qq : Rep := []; co := yy.first.c; y := per(yy.rest)
                repeat
                  if (u := subtractIfCan(xx.first.k,e)) case "failed" then break
                  qq := cons([u@NNI, xx.first.c]$Term, rep (co * per qq))
                  xx := rep fmecg(co * per rest(xx), u, xx.first.c, y)
                  if empty? xx then break
                per reverse qq

     if R has IntegralDomain then

       pack ==> PseudoRemainderSequence(R, %)

       subResultantGcd(p1, p2) == subResultantGcd(p1, p2)$pack

       subResultantsChain(p1, p2) == chainSubResultants(p1, p2)$pack

       lastSubResultant(p1, p2) == lastSubResultant(p1, p2)$pack

       resultant(p1, p2) == resultant(p1, p2)$pack

       extendedResultant(p1, p2) ==
          re : Record(coef1 : %, coef2 : %, resultant : R) := resultantEuclidean(p1, p2)$pack
          [re.resultant, re.coef1, re.coef2]

       halfExtendedResultant1(p1 : %, p2 : %) : Record(resultant : R, coef1 : %) ==
          re : Record(coef1 : %, resultant : R) := semiResultantEuclidean1(p1, p2)$pack
          [re.resultant, re.coef1]

       halfExtendedResultant2(p1 : %, p2 : %) : Record(resultant : R, coef2 : %) ==
          re : Record(coef2 : %, resultant : R) := semiResultantEuclidean2(p1, p2)$pack
          [re.resultant, re.coef2]

       extendedSubResultantGcd(p1, p2) ==
          re : Record(coef1 : %, coef2 : %, gcd : %) := subResultantGcdEuclidean(p1, p2)$pack
          [re.gcd, re.coef1, re.coef2]

       halfExtendedSubResultantGcd1(p1 : %, p2 : %) : Record(gcd : %, coef1 : %) ==
          re : Record(coef1 : %, gcd : %) := semiSubResultantGcdEuclidean1(p1, p2)$pack
          [re.gcd, re.coef1]

       halfExtendedSubResultantGcd2(p1 : %, p2 : %) : Record(gcd : %, coef2 : %) ==
          re : Record(coef2 : %, gcd : %) := semiSubResultantGcdEuclidean2(p1, p2)$pack
          [re.gcd, re.coef2]

)abbrev package NSUP2 NewSparseUnivariatePolynomialFunctions2
++ Author:
++ Basic Functions:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ This package lifts a mapping from coefficient rings R to S to
++ a mapping from sparse univariate polynomial over R to
++ a sparse univariate polynomial over S.
++ Note that the mapping is assumed
++ to send zero to zero, since it will only be applied to the non-zero
++ coefficients of the polynomial.

NewSparseUnivariatePolynomialFunctions2(R : Ring, S : Ring) : with
  map : (R->S, NewSparseUnivariatePolynomial R) -> NewSparseUnivariatePolynomial S
    ++ \spad{map(func, poly)} creates a new polynomial by applying func to
    ++ every non-zero coefficient of the polynomial poly.
 == add
  map(f, p) == map(f, p)$UnivariatePolynomialCategoryFunctions2(R,
           NewSparseUnivariatePolynomial R, S, NewSparseUnivariatePolynomial S)

)abbrev category RPOLCAT RecursivePolynomialCategory
++ Author: Marc Moreno Maza
++ Date Created: 04/22/1994
++ Basic Functions: mvar, mdeg, init, head, tail, prem, lazyPrem
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords: polynomial, multivariate, ordered variables set
++ References:
++ Description:
++ A category for general multi-variate polynomials with coefficients
++ in a ring, variables in an ordered set, and exponents from an
++ ordered abelian monoid, with a \spadfun{sup} operation.
++ When not constant, such a polynomial is viewed as a univariate polynomial in its
++ main variable w. r. t. to the total ordering on the elements in the ordered set, so that some
++ operations usually defined for univariate polynomials make sense here.

RecursivePolynomialCategory(R : Ring, E : OrderedAbelianMonoidSup, V : OrderedSet) : Category ==
  PolynomialCategory(R, E, V) with
     mvar : % -> V
         ++ \spad{mvar(p)} returns an error if \spad{p} belongs to \spad{R},
         ++ otherwise returns its main variable w. r. t. to the total ordering
         ++ on the elements in \spad{V}.
     mdeg : % -> NonNegativeInteger
         ++ \spad{mdeg(p)} returns an error if \spad{p} is \spad{0},
         ++ otherwise, if \spad{p} belongs to \spad{R} returns \spad{0},
         ++ otherwise, returns the degree of \spad{p} in its main variable.
     init : % -> %
         ++ \spad{init(p)} returns an error if \spad{p} belongs to \spad{R},
         ++ otherwise returns its leading coefficient, where \spad{p} is viewed
         ++ as a univariate polynomial in its main variable.
     head : % -> %
         ++ \spad{head(p)} returns \spad{p} if \spad{p} belongs to \spad{R},
         ++ otherwise returns its leading term (monomial in the FriCAS sense),
         ++ where \spad{p} is viewed as a univariate polynomial in its main variable.
     tail : % -> %
         ++ \spad{tail(p)} returns its reductum, where \spad{p} is viewed as a univariate
         ++ polynomial in its main variable.
     deepestTail : % -> %
         ++ \spad{deepestTail(p)} returns \spad{0} if \spad{p} belongs to \spad{R},
         ++ otherwise returns tail(p), if \spad{tail(p)} belongs to  \spad{R}
         ++ or \spad{mvar(tail(p)) < mvar(p)}, otherwise returns \spad{deepestTail(tail(p))}.
     iteratedInitials : % -> List %
         ++ \spad{iteratedInitials(p)} returns \spad{[]} if \spad{p} belongs to \spad{R},
         ++ otherwise returns the list of the iterated initials of \spad{p}.
     deepestInitial : % -> %
         ++ \spad{deepestInitial(p)} returns an error if \spad{p} belongs to \spad{R},
         ++ otherwise returns the last term of \spad{iteratedInitials(p)}.
     leadingCoefficient : (%, V) -> %
         ++ \spad{leadingCoefficient(p, v)} returns the leading coefficient of \spad{p},
         ++ where \spad{p} is viewed as A univariate polynomial in \spad{v}.
     reductum : (%, V) -> %
         ++ \spad{reductum(p, v)} returns the reductum of \spad{p}, where \spad{p} is viewed as
         ++ a univariate polynomial in \spad{v}.
     monic? : % -> Boolean
         ++ \spad{monic?(p)} returns false if \spad{p} belongs to \spad{R},
         ++ otherwise returns true iff \spad{p} is monic as a univariate polynomial
         ++ in its main variable.
     quasiMonic? : % -> Boolean
         ++ \spad{quasiMonic?(p)} returns false if \spad{p} belongs to \spad{R},
         ++ otherwise returns true iff the initial of \spad{p} lies in the base ring \spad{R}.
     mainMonomial : % -> %
         ++ \spad{mainMonomial(p)} returns an error if \spad{p} is \spad{O},
         ++ otherwise, if \spad{p} belongs to \spad{R} returns \spad{1},
         ++ otherwise, \spad{mvar(p)} raised to the power \spad{mdeg(p)}.
     leastMonomial : % -> %
         ++ \spad{leastMonomial(p)} returns an error if \spad{p} is \spad{O},
         ++ otherwise, if \spad{p} belongs to \spad{R} returns \spad{1},
         ++ otherwise, the monomial of \spad{p} with lowest degree,
         ++ where \spad{p} is viewed as a univariate polynomial in its main variable.
     mainCoefficients : % -> List %
         ++ \spad{mainCoefficients(p)} returns an error if \spad{p} is \spad{O},
         ++ otherwise, if \spad{p} belongs to \spad{R} returns [p],
         ++ otherwise returns the list of the coefficients of \spad{p},
         ++ where \spad{p} is viewed as a univariate polynomial in its main variable.
     mainMonomials : % -> List %
         ++ \spad{mainMonomials(p)} returns an error if \spad{p} is \spad{O},
         ++ otherwise, if \spad{p} belongs to \spad{R} returns [1],
         ++ otherwise returns the list of the monomials of \spad{p},
         ++ where \spad{p} is viewed as a univariate polynomial in its main variable.
     RittWuCompare : (%, %) -> Union(Boolean,"failed")
         ++ \spad{RittWuCompare(a,b)} returns \spad{"failed"} if \spad{a} and \spad{b} have same rank w.r.t.
         ++ Ritt and Wu Wen Tsun ordering using the refinement of Lazard,
         ++ otherwise returns \spad{infRittWu?(a, b)}.
     infRittWu? : (%, %) -> Boolean
         ++ \spad{infRittWu?(a, b)} returns true if \spad{a} is less than \spad{b}
         ++ w.r.t. the Ritt and Wu Wen Tsun ordering using the refinement of Lazard.
     supRittWu? : (%, %) -> Boolean
         ++ \spad{supRittWu?(a, b)} returns true if \spad{a} is greater than \spad{b}
         ++ w.r.t. the Ritt and Wu Wen Tsun ordering using the refinement of Lazard.
     reduced? : (%, %) -> Boolean
         ++ \spad{reduced?(a, b)} returns true iff \spad{degree(a, mvar(b)) < mdeg(b)}.
     reduced? : (%, List(%)) -> Boolean
         ++ \spad{reduced?(q, lp)} returns true iff \spad{reduced?(q, p)} holds
         ++ for every \spad{p} in \spad{lp}.
     headReduced? : (%, %) -> Boolean
         ++ \spad{headReduced?(a, b)} returns true iff \spad{degree(head(a), mvar(b)) < mdeg(b)}.
     headReduced? : (%, List(%)) -> Boolean
         ++ \spad{headReduced?(q, lp)} returns true iff \spad{headReduced?(q, p)} holds
         ++ for every \spad{p} in \spad{lp}.
     initiallyReduced? : (%, %) -> Boolean
         ++ \spad{initiallyReduced?(a, b)} returns false iff there exists an iterated initial
         ++ of \spad{a} which is not reduced w.r.t \spad{b}.
     initiallyReduced? : (%, List(%)) -> Boolean
         ++ \spad{initiallyReduced?(q, lp)} returns true iff \spad{initiallyReduced?(q, p)} holds
         ++ for every \spad{p} in \spad{lp}.
     normalized? : (%, %) -> Boolean
         ++ \spad{normalized?(a, b)} returns true iff \spad{a} and its iterated initials have
         ++ degree zero w.r.t. the main variable of \spad{b}
     normalized? : (%, List(%)) -> Boolean
         ++ \spad{normalized?(q, lp)} returns true iff \spad{normalized?(q, p)} holds
         ++ for every \spad{p} in \spad{lp}.
     prem : (%, %) -> %
         ++ \spad{prem(a, b)} computes the pseudo-remainder of \spad{a} by \spad{b},
         ++ both viewed as univariate polynomials in the main variable of \spad{b}.
     pquo : (%, %) -> %
         ++ \spad{pquo(a, b)} computes the pseudo-quotient of \spad{a} by \spad{b},
         ++ both viewed as univariate polynomials in the main variable of \spad{b}.
     prem : (%, %, V) -> %
         ++ \spad{prem(a, b, v)} computes the pseudo-remainder of \spad{a} by \spad{b},
         ++ both viewed as univariate polynomials in \spad{v}.
     pquo : (%, %, V) -> %
         ++ \spad{pquo(a, b, v)} computes the pseudo-quotient of \spad{a} by \spad{b},
         ++ both viewed as univariate polynomials in \spad{v}.
     lazyPrem : (%, %) -> %
         ++ \spad{lazyPrem(a, b)} returns the polynomial \spad{r} reduced w.r.t. \spad{b}
         ++ and such that \spad{b} divides \spad{init(b)^e a - r} where \spad{e}
         ++ is the number of steps of this pseudo-division.
     lazyPquo : (%, %) -> %
         ++ \spad{lazyPquo(a, b)} returns the polynomial \spad{q} such that
         ++ \spad{lazyPseudoDivide(a, b)} returns \spad{[c, g, q, r]}.
     lazyPrem : (%, %, V) -> %
         ++ \spad{lazyPrem(a, b, v)} returns the polynomial \spad{r}
         ++ reduced w.r.t. \spad{b} viewed as univariate polynomials in the variable
         ++ \spad{v} such that \spad{b} divides \spad{init(b)^e a - r}
         ++ where \spad{e} is the number of steps of this pseudo-division.
     lazyPquo : (%, %, V) -> %
         ++ \spad{lazyPquo(a, b, v)} returns the polynomial \spad{q} such that
         ++ \spad{lazyPseudoDivide(a, b, v)} returns \spad{[c, g, q, r]}.
     lazyPremWithDefault : (%, %) -> Record(coef : %, gap : NonNegativeInteger, remainder : %)
         ++ \spad{lazyPremWithDefault(a, b)} returns \spad{[c, g, r]}
         ++ such that \spad{r = lazyPrem(a, b)} and \spad{(c^g)*r = prem(a, b)}.
     lazyPremWithDefault : (%, %, V) -> Record(coef : %, gap : NonNegativeInteger, remainder : %)
         ++ \spad{lazyPremWithDefault(a, b, v)} returns \spad{[c, g, r]}
         ++ such that \spad{r = lazyPrem(a, b, v)} and \spad{(c^g)*r = prem(a, b, v)}.
     lazyPseudoDivide : (%, %) -> Record(coef : %, gap : NonNegativeInteger, quotient : %, remainder : %)
         ++ \spad{lazyPseudoDivide(a, b)} returns \spad{[c, g, q, r]}
         ++ such that \spad{[c, g, r] = lazyPremWithDefault(a, b)} and
         ++ \spad{q} is the pseudo-quotient computed in this lazy pseudo-division.
     lazyPseudoDivide : (%, %, V) -> Record(coef : %, gap : NonNegativeInteger, quotient : %, remainder : %)
         ++ \spad{lazyPseudoDivide(a, b, v)} returns \spad{[c, g, q, r]} such that
         ++ \spad{r = lazyPrem(a, b, v)}, \spad{(c^g)*r = prem(a, b, v)} and \spad{q}
         ++ is the pseudo-quotient computed in this lazy pseudo-division.
     pseudoDivide : (%, %) -> Record(quotient : %, remainder : %)
         ++ \spad{pseudoDivide(a, b)} computes \spad{[pquo(a, b), prem(a, b)]}, both
         ++ polynomials viewed as univariate polynomials in the main variable of \spad{b},
         ++ if \spad{b} is not a constant polynomial.
     monicModulo : (%, %) -> %
         ++ \spad{monicModulo(a, b)} computes \spad{a mod b}, if \spad{b} is
         ++ monic as univariate polynomial in its main variable.
     lazyResidueClass : (%, %) -> Record(polnum : %, polden : %, power : NonNegativeInteger)
         ++ \spad{lazyResidueClass(a, b)} returns \spad{[p, q, n]} where \spad{p / q^n}
         ++ represents the residue class of \spad{a} modulo \spad{b}
         ++ and \spad{p} is reduced w.r.t. \spad{b} and \spad{q} is \spad{init(b)}.
     headReduce : (%, %) -> %
         ++ \spad{headReduce(a, b)} returns a polynomial \spad{r} such that
         ++ \spad{headReduced?(r, b)} holds and there exists an integer \spad{e}
         ++ such that \spad{init(b)^e a - r} is zero modulo \spad{b}.
     initiallyReduce : (%, %) -> %
         ++ \spad{initiallyReduce(a, b)} returns a polynomial \spad{r} such that
         ++ \spad{initiallyReduced?(r, b)} holds and there exists an integer \spad{e}
         ++ such that \spad{init(b)^e a - r} is zero modulo \spad{b}.

     if (V has ConvertibleTo(Symbol)) then
         CoercibleTo(Polynomial R)
         ConvertibleTo(Polynomial R)
         if R has Algebra Fraction Integer then
             retractIfCan : Polynomial Fraction Integer -> Union(%,"failed")
               ++ \spad{retractIfCan(p)} returns \spad{p} as an element of
               ++ the current domain, if all its variables belong to \spad{V}.
             retract : Polynomial Fraction Integer -> %
               ++ \spad{retract(p)} returns \spad{p} as an element of the
               ++ current domain, if \spad{retractIfCan(p)} does not return
               ++ "failed", otherwise an error is produced.
             convert : Polynomial Fraction Integer -> %
               ++ \spad{convert(p)} returns the same as \spad{retract(p)}.

         if R has Algebra Integer then
             retractIfCan : Polynomial Integer -> Union(%,"failed")
               ++ \spad{retractIfCan(p)} returns \spad{p} as an element of
               ++ the current domain, if all its variables belong to \spad{V}.
             retract : Polynomial Integer -> %
               ++ \spad{retract(p)} returns \spad{p} as an element of the
               ++ current domain, if \spad{retractIfCan(p)} does not return
               ++ "failed", otherwise an error is produced.
             convert : Polynomial Integer -> %
               ++ \spad{convert(p)} returns the same as \spad{retract(p)}.

         retractIfCan : Polynomial R -> Union(%,"failed")
           ++ \spad{retractIfCan(p)} returns \spad{p} as an element of
           ++ the current domain, if all its variables belong to \spad{V}.
         retract : Polynomial R -> %
           ++ \spad{retract(p)} returns \spad{p} as an element of the
           ++ current domain, if \spad{retractIfCan(p)} does not return
           ++ "failed", otherwise an error is produced.
         convert : Polynomial R -> %
           ++ \spad{convert(p)} returns the same as \spad{retract(p)}.

         if R has RetractableTo(Integer) then
             ConvertibleTo(String)

     if R has IntegralDomain then
       primPartElseUnitCanonical : % -> %
           ++ \spad{primPartElseUnitCanonical(p)} returns \spad{primitivePart(p)}
           ++ if \spad{R} is a gcd-domain, otherwise \spad{unitCanonical(p)}.
       primPartElseUnitCanonical! : % -> %
           ++ \spad{primPartElseUnitCanonical!(p)} replaces  \spad{p}
           ++ by \spad{primPartElseUnitCanonical(p)}.
       exactQuotient : (%, R) -> %
           ++ \spad{exactQuotient(p, r)} computes the exact quotient of \spad{p}
           ++ by \spad{r}, which is assumed to be a divisor of \spad{p}.
           ++ No error is returned if this exact quotient fails!
       exactQuotient! : (%, R) -> %
           ++ \spad{exactQuotient!(p, r)} replaces \spad{p} by \spad{exactQuotient(p, r)}.
       exactQuotient : (%, %) -> %
           ++ \spad{exactQuotient(a, b)} computes the exact quotient of \spad{a}
           ++ by \spad{b}, which is assumed to be a divisor of \spad{a}.
           ++ No error is returned if this exact quotient fails!
       exactQuotient! : (%, %) -> %
           ++ \spad{exactQuotient!(a, b)} replaces \spad{a} by \spad{exactQuotient(a, b)}
       subResultantGcd : (%, %) -> %
           ++ \spad{subResultantGcd(a, b)} computes a gcd of \spad{a} and \spad{b}
           ++ where \spad{a} and \spad{b} are assumed to have the same main variable \spad{v}
           ++ and are viewed as univariate polynomials in \spad{v} with coefficients
           ++ in the fraction field of the polynomial ring generated by their other variables
           ++ over \spad{R}.
       extendedSubResultantGcd : (%, %) -> Record(gcd : %, coef1 : %, coef2 : %)
           ++ \spad{extendedSubResultantGcd(a, b)} returns \spad{[g, ca, cb]}
           ++ such that \spad{g} is \spad{subResultantGcd(a, b)} and we have
           ++ \spad{ca * a + cb * cb = g}.
       halfExtendedSubResultantGcd1 : (%, %) -> Record(gcd : %, coef1 : %)
           ++ \spad{halfExtendedSubResultantGcd1(a, b)} returns \spad{[g, ca]}
           ++ if \spad{extendedSubResultantGcd(a, b)} returns \spad{[g, ca, cb]}
           ++ otherwise produces an error.
       halfExtendedSubResultantGcd2 : (%, %) -> Record(gcd : %, coef2 : %)
           ++ \spad{halfExtendedSubResultantGcd2(a, b)} returns \spad{[g, cb]}
           ++ if \spad{extendedSubResultantGcd(a, b)} returns \spad{[g, ca, cb]}
           ++ otherwise produces an error.
       resultant : (%, %) -> %
           ++ \spad{resultant(a, b)} computes the resultant of \spad{a} and \spad{b}
           ++ where \spad{a} and \spad{b} are assumed to have the same main variable \spad{v}
           ++ and are viewed as univariate polynomials in \spad{v}.
       subResultantChain : (%, %) -> List %
           ++ \spad{subResultantChain(a, b)}, where \spad{a} and \spad{b}
           ++ are not constant polynomials with the same main variable,
           ++ returns the subresultant chain of \spad{a} and \spad{b}.
       lastSubResultant : (%, %) -> %
           ++ \spad{lastSubResultant(a, b)} returns the last non-zero subresultant
           ++ of \spad{a} and \spad{b} where \spad{a} and \spad{b} are assumed to have
           ++ the same main variable \spad{v} and are viewed as univariate polynomials in \spad{v}.
       LazardQuotient : (%, %, NonNegativeInteger) -> %
           ++ \spad{LazardQuotient(a, b, n)} returns \spad{a^n exquo b^(n-1)}
           ++ assuming that this quotient does not fail.
       LazardQuotient2 : (%, %, %, NonNegativeInteger) -> %
           ++ \spad{LazardQuotient2(p, a, b, n)} returns
           ++ \spad{(a^(n-1) * p) exquo b^(n-1)}
           ++ assuming that this quotient does not fail.
       next_subResultant2 : (%, %, %, %) -> %
           ++ \spad{next_subResultant2(p, q, z, s)} is the multivariate
           ++ version of the operation
           ++ \spadopFrom{next_sousResultant2}{PseudoRemainderSequence}
           ++ from the \spadtype{PseudoRemainderSequence} constructor.
       iexactQuo : (R, R) -> R
           ++ iexactQuo(x, y) should be local but conditional

     if R has GcdDomain then
       gcd : (R, %) -> R
           ++ \spad{gcd(r, p)} returns the gcd of \spad{r} and the content of \spad{p}.
       primitivePart! : % -> %
           ++ \spad{primitivePart!(p)} replaces \spad{p}  by its primitive part.
       mainContent : % -> %
           ++ \spad{mainContent(p)} returns the content of \spad{p} viewed as a univariate
           ++ polynomial in its main variable and with coefficients in the
           ++ polynomial ring generated by its other variables over \spad{R}.
       mainPrimitivePart : % -> %
           ++ \spad{mainPrimitivePart(p)} returns the primitive part of \spad{p} viewed as a
           ++ univariate polynomial in its main variable and with coefficients
           ++ in the polynomial ring generated by its other variables over \spad{R}.
       mainSquareFreePart : % -> %
           ++ \spad{mainSquareFreePart(p)} returns the square free part of \spad{p} viewed as a
           ++ univariate polynomial in its main variable and with coefficients
           ++ in the polynomial ring generated by its other variables over \spad{R}.

 add
     O ==> OutputForm
     NNI ==> NonNegativeInteger
     INT ==> Integer

     import from Integer
     import from Symbol
     import from SparseUnivariatePolynomial(%)

     exactQuo : (R, R) -> R

     coerce(p : %) : O ==
       ground? (p) => (ground(p))::O
       if (((ip := init(p))) = 1)
         then
           if zero?((tp := tail(p)))
             then
               if (((dp := mdeg(p))) = 1)
                 then
                   return((mvar(p))::O)
                 else
                   return(((mvar(p))::O ^$O (dp::O)))
             else
               if (((dp := mdeg(p))) = 1)
                 then
                   return((mvar(p))::O +$O (tp::O))
                 else
                   return(((mvar(p))::O ^$O (dp::O)) +$O (tp::O))
          else
           if zero?((tp := tail(p)))
             then
               if (((dp := mdeg(p))) = 1)
                 then
                   return((ip::O) *$O  (mvar(p))::O)
                 else
                   return((ip::O) *$O ((mvar(p))::O ^$O (dp::O)))
             else
               if ((mdeg(p)) = 1)
                 then
                   return(((ip::O) *$O  (mvar(p))::O) +$O (tp::O))
       ((ip)::O *$O ((mvar(p))::O ^$O ((mdeg(p)::O))) +$O (tail(p)::O))

     mvar p ==
       ground?(p) => error "Error in mvar from RPOLCAT : #1 is constant."
       mainVariable(p)::V

     mdeg p ==
       ground?(p) => 0$NNI
       degree(p, mainVariable(p)::V)

     init p ==
       ground?(p) => error "Error in mvar from RPOLCAT : #1 is constant."
       v := mainVariable(p)::V
       coefficient(p, v, degree(p, v))

     leadingCoefficient (p, v) ==
       zero? (d := degree(p, v)) => p
       coefficient(p, v, d)

     head p ==
       ground? p => p
       v := mainVariable(p)::V
       d := degree(p, v)
       monomial(coefficient(p, v, d), v, d)

     reductum(p, v) ==
       zero? (d := degree(p, v)) => 0$%
       p - monomial(coefficient(p, v, d), v, d)

     tail p ==
       ground? p => 0$%
       p - head(p)

     deepestTail p ==
       ground? p => 0$%
       ground? tail(p) => tail(p)
       mvar(p) > mvar(tail(p)) => tail(p)
       deepestTail(tail(p))

     iteratedInitials p ==
       ground? p => []
       p := init(p)
       cons(p, iteratedInitials(p))

     localDeepestInitial (p : %) : % ==
       ground? p => p
       localDeepestInitial init p

     deepestInitial p ==
       ground? p => error "Error in deepestInitial from RPOLCAT : #1 is constant."
       localDeepestInitial init p

     monic? p ==
       ground? p => false
       (recip(init(p))$% case %)@Boolean

     quasiMonic?  p ==
       ground? p => false
       ground?(init(p))

     mainMonomial p ==
       zero? p => error "Error in mainMonomial from RPOLCAT : #1 is zero"
       ground? p => 1$%
       v := mainVariable(p)::V
       monomial(1$%, v, degree(p, v))

     leastMonomial p ==
       zero? p => error "Error in leastMonomial from RPOLCAT : #1 is zero"
       ground? p => 1$%
       v := mainVariable(p)::V
       monomial(1$%, v, minimumDegree(p, v))

     mainCoefficients p ==
       zero? p => error "Error in mainCoefficients from RPOLCAT : #1 is zero"
       ground? p => [p]
       v := mainVariable(p)::V
       coefficients(univariate(p, v)@SparseUnivariatePolynomial(%))

     mainMonomials p ==
       zero? p => error "Error in mainMonomials from RPOLCAT : #1 is zero"
       ground? p => [1$%]
       v := mainVariable(p)::V
       lm := monomials(univariate(p, v)@SparseUnivariatePolynomial(%))
       [monomial(1$%, v, degree(m)) for m in lm]

     RittWuCompare (a, b) ==
       (ground? b and  ground? a) => "failed"::Union(Boolean,"failed")
       ground? b => false::Union(Boolean,"failed")
       ground? a => true::Union(Boolean,"failed")
       mvar(a) < mvar(b) => true::Union(Boolean,"failed")
       mvar(a) > mvar(b) => false::Union(Boolean,"failed")
       mdeg(a) < mdeg(b) => true::Union(Boolean,"failed")
       mdeg(a) > mdeg(b) => false::Union(Boolean,"failed")
       lc := RittWuCompare(init(a), init(b))
       lc case Boolean => lc
       RittWuCompare(tail(a), tail(b))

     infRittWu? (a, b) ==
       lc : Union(Boolean,"failed") := RittWuCompare(a,b)
       lc case Boolean => lc
       false

     supRittWu? (a, b) ==
       infRittWu? (b, a)

     prem (a : %, b : %) : % ==
       cP := lazyPremWithDefault (a, b)
       ((cP.coef) ^ (cP.gap)) * cP.remainder

     pquo (a : %, b : %) : % ==
       cPS := lazyPseudoDivide (a, b)
       c := (cPS.coef) ^ (cPS.gap)
       c * cPS.quotient

     prem (a : %, b : %, v : V) : % ==
       cP := lazyPremWithDefault (a, b, v)
       ((cP.coef) ^ (cP.gap)) * cP.remainder

     pquo (a : %, b : %, v : V) : % ==
       cPS := lazyPseudoDivide (a, b, v)
       c := (cPS.coef) ^ (cPS.gap)
       c * cPS.quotient

     lazyPrem (a : %, b : %) : % ==
       (not ground?(b)) and (monic?(b)) => monicModulo(a, b)
       (lazyPremWithDefault (a, b)).remainder

     lazyPquo (a : %, b : %) : % ==
       (lazyPseudoDivide (a, b)).quotient

     lazyPrem (a : %, b : %, v : V) : % ==
       zero? b => error "Error in lazyPrem : (%,%,V) -> % from RPOLCAT : #2 is zero"
       ground?(b) => 0$%
       (v = mvar(b)) => lazyPrem(a, b)
       dbv : NNI := degree(b, v)
       zero? dbv => 0$%
       dav : NNI := degree(a, v)
       zero? dav => a
       test : INT := dav::INT - dbv
       lcbv : % := leadingCoefficient(b, v)
       while not zero?(a) and not negative?(test) repeat
         lcav := leadingCoefficient(a, v)
         term := monomial(lcav, v, test::NNI)
         a := lcbv * a - term * b
         test := degree(a, v)::INT - dbv
       a

     lazyPquo (a : %, b : %, v : V) : % ==
       (lazyPseudoDivide (a, b, v)).quotient

     headReduce (a : %, b : %) ==
       ground? b => error "Error in headReduce : (%,%) -> Boolean from TSETCAT : #2 is constant"
       ground? a => a
       mvar(a) = mvar(b) => lazyPrem(a, b)
       while not reduced?((ha := head a), b) repeat
         lrc := lazyResidueClass(ha, b)
         if zero? tail(a)
           then
             a := lrc.polnum
           else
             a := lrc.polnum +  (lrc.polden)^(lrc.power) * tail(a)
       a

     initiallyReduce(a : %, b : %) ==
       ground? b => error "Error in initiallyReduce : (%,%) -> Boolean from TSETCAT : #2 is constant"
       ground? a => a
       v := mvar(b)
       mvar(a) = v => lazyPrem(a, b)
       ia := a
       ma := 1$%
       ta := 0$%
       while (not ground?(ia)) and (mvar(ia) >= mvar(b)) repeat
         if (mvar(ia) = mvar(b)) and (mdeg(ia) >= mdeg(b))
           then
             iamodb := lazyResidueClass(ia, b)
             ia := iamodb.polnum
             if not zero? ta
               then
                 ta :=  (iamodb.polden)^(iamodb.power) * ta
         if zero? ia
           then
             ia := ta
             ma := 1$%
             ta := 0$%
           else
             if not ground?(ia)
               then
                 ta := tail(ia) * ma + ta
                 ma := mainMonomial(ia) * ma
                 ia := init(ia)
       ia * ma + ta

     lazyPremWithDefault (a, b) ==
       ground?(b) => error "Error in lazyPremWithDefault from RPOLCAT : #2 is constant"
       ground?(a) => [1$%, 0$NNI, a]
       xa := mvar a
       xb := mvar b
       xa < xb => [1$%, 0$NNI, a]
       lcb : % := init b
       db : NNI := mdeg b
       test : INT := degree(a, xb)::INT - db
       delta : INT := max(test + 1$INT, 0$INT)
       if xa = xb
         then
           b := tail b
           while not zero?(a) and not negative?(test) repeat
             term := monomial(init(a), xb, test::NNI)
             a := lcb * tail(a) - term * b
             delta := delta - 1$INT
             test := degree(a, xb)::INT - db
         else
           while not zero?(a) and not negative?(test) repeat
             term := monomial(leadingCoefficient(a, xb), xb, test::NNI)
             a := lcb * a - term * b
             delta := delta - 1$INT
             test := degree(a, xb)::INT - db
       [lcb, (delta::NNI), a]

     lazyPremWithDefault (a, b, v) ==
       zero? b => error "Error in lazyPremWithDefault : (%,%,V) -> % from RPOLCAT : #2 is zero"
       ground?(b) => [b, 1$NNI, 0$%]
       (v = mvar(b)) => lazyPremWithDefault(a, b)
       dbv : NNI := degree(b, v)
       zero? dbv => [b, 1$NNI, 0$%]
       dav : NNI := degree(a, v)
       zero? dav => [1$%, 0$NNI, a]
       test : INT := dav::INT - dbv
       delta : INT := max(test + 1$INT, 0$INT)
       lcbv : % := leadingCoefficient(b, v)
       while not zero?(a) and not negative?(test) repeat
         lcav := leadingCoefficient(a, v)
         term := monomial(lcav, v, test::NNI)
         a := lcbv * a - term * b
         delta := delta - 1$INT
         test := degree(a, v)::INT - dbv
       [lcbv, (delta::NNI), a]

     pseudoDivide (a, b) ==
       cPS := lazyPseudoDivide (a, b)
       c := (cPS.coef) ^ (cPS.gap)
       [c * cPS.quotient, c * cPS.remainder]

     lazyPseudoDivide (a, b) ==
       ground?(b) => error "Error in lazyPseudoDivide from RPOLCAT : #2 is constant"
       ground?(a) => [1$%, 0$NNI, 0$%, a]
       xa := mvar a
       xb := mvar b
       xa < xb => [1$%, 0$NNI, 0$%, a]
       lcb : % := init b
       db : NNI := mdeg b
       q := 0$%
       test : INT := degree(a, xb)::INT - db
       delta : INT := max(test + 1$INT, 0$INT)
       if xa = xb
         then
           b := tail b
           while not zero?(a) and not negative?(test) repeat
             term := monomial(init(a), xb, test::NNI)
             a := lcb * tail(a) - term * b
             q := lcb * q + term
             delta := delta - 1$INT
             test := degree(a, xb)::INT - db
         else
           while not zero?(a) and not negative?(test) repeat
             term := monomial(leadingCoefficient(a, xb), xb, test::NNI)
             a := lcb * a - term * b
             q := lcb * q + term
             delta := delta - 1$INT
             test := degree(a, xb)::INT - db
       [lcb, (delta::NNI), q, a]

     lazyPseudoDivide (a, b, v) ==
       zero? b => error "Error in lazyPseudoDivide : (%,%,V) -> % from RPOLCAT : #2 is zero"
       ground?(b) => [b, 1$NNI, a, 0$%]
       (v = mvar(b)) => lazyPseudoDivide(a, b)
       dbv : NNI := degree(b, v)
       zero? dbv => [b, 1$NNI, a, 0$%]
       dav : NNI := degree(a, v)
       zero? dav => [1$%, 0$NNI, 0$%, a]
       test : INT := dav::INT - dbv
       delta : INT := max(test + 1$INT, 0$INT)
       lcbv : % := leadingCoefficient(b, v)
       q := 0$%
       while not zero?(a) and not negative?(test) repeat
         lcav := leadingCoefficient(a, v)
         term := monomial(lcav, v, test::NNI)
         a := lcbv * a - term * b
         q := lcbv * q + term
         delta := delta - 1$INT
         test := degree(a, v)::INT - dbv
       [lcbv, (delta::NNI), q, a]

     monicModulo (a, b) ==
         ground?(b) =>
             error "Error in monicModulo from RPOLCAT : #2 is constant"
         rec : Union(%, "failed") := recip((ib := init(b)))$%
         rec case "failed" =>
             error "Error in monicModulo from RPOLCAT : #2 is not monic"
         ground? a => a
         r1 := rec@%
         ib * ((lazyPremWithDefault(r1*a, r1*b)).remainder)

     lazyResidueClass(a, b) ==
       zero? b => [a, 1$%, 0$NNI]
       ground? b => [0$%, 1$%, 0$NNI]
       ground? a => [a, 1$%, 0$NNI]
       xa := mvar a
       xb := mvar b
       xa < xb => [a, 1$%, 0$NNI]
       monic?(b) => [monicModulo(a, b), 1$%, 0$NNI]
       lcb : % := init b
       db : NNI := mdeg b
       test : INT := degree(a, xb)::INT - db
       pow : NNI := 0
       if xa = xb
         then
           b := tail b
           while not zero?(a) and not negative?(test) repeat
             term := monomial(init(a), xb, test::NNI)
             a := lcb * tail(a) - term * b
             pow := pow + 1$NNI
             test := degree(a, xb)::INT - db
         else
           while not zero?(a) and not negative?(test) repeat
             term := monomial(leadingCoefficient(a, xb), xb, test::NNI)
             a := lcb * a - term * b
             pow := pow + 1$NNI
             test := degree(a, xb)::INT - db
       [a, lcb, pow]

     reduced? (a : %, b : %) : Boolean ==
       degree(a, mvar(b)) < mdeg(b)

     reduced? (p : %, lq : List(%)) : Boolean ==
       ground? p => true
       while (not empty? lq) and (reduced?(p, first lq)) repeat
         lq := rest lq
       empty? lq

     headReduced? (a : %, b : %) : Boolean ==
       reduced?(head(a), b)

     headReduced? (p : %, lq : List(%)) : Boolean ==
       reduced?(head(p), lq)

     initiallyReduced? (a : %, b : %) : Boolean ==
       ground? b => error "Error in initiallyReduced? : (%,%) -> Bool. from RPOLCAT : #2 is constant"
       ground?(a) => true
       mvar(a) < mvar(b) => true
       (mvar(a) = mvar(b)) => reduced?(a, b)
       initiallyReduced?(init(a), b)

     initiallyReduced? (p : %, lq : List(%)) : Boolean ==
       ground? p => true
       while (not empty? lq) and (initiallyReduced?(p, first lq)) repeat
         lq := rest lq
       empty? lq

     normalized?(a : %, b : %) : Boolean ==
       ground? b => error "Error in  normalized? : (%,%) -> Boolean from TSETCAT : #2 is constant"
       ground? a => true
       mvar(a) < mvar(b) => true
       (mvar(a) = mvar(b)) => false
       normalized?(init(a), b)

     normalized? (p : %, lq : List(%)) : Boolean ==
       while (not empty? lq) and (normalized?(p, first lq)) repeat
         lq := rest lq
       empty? lq

     if R has IntegralDomain then

       if R has EuclideanDomain then

           iexactQuo(r : R, s : R) : R ==
             r quo$R s
         else
           iexactQuo(r : R, s : R) : R ==
             (r exquo$R s)::R

       exactQuo(r : R, s : R) : R == iexactQuo(r, s)

       exactQuotient (p : %, r : R) ==
         (p exquo$% r)::%

       exactQuotient (a : %, b : %) ==
         ground? b => exactQuotient(a, ground(b))
         (a exquo$% b)::%

       exactQuotient! (a : %, b : %) ==
         ground? b => exactQuotient!(a, ground(b))
         a := (a exquo$% b)::%

       if (R has GcdDomain) and not(R has Field) then

         primPartElseUnitCanonical p ==
           primitivePart p

         primitivePart! p ==
           zero? p => p
           if ((cp := content(p)) = 1)
             then
               p := unitCanonical p
             else
               p := unitCanonical exactQuotient!(p, cp)
           p

         primPartElseUnitCanonical! p ==
           primitivePart! p

       else
         primPartElseUnitCanonical p ==
           unitCanonical p

         primPartElseUnitCanonical! p ==
           p := unitCanonical p


     if R has GcdDomain then

       gcd(r : R, p : %) : R ==
         (r = 1) => r
         zero? p => r
         ground? p => gcd(r, ground(p))$R
         gcd(gcd(r, init(p)), tail(p))

       mainContent p ==
         zero? p => p
         "gcd"/mainCoefficients(p)

       mainPrimitivePart p ==
         zero? p => p
         (unitNormal((p exquo$% mainContent(p))::%)).canonical

       mainSquareFreePart p ==
         ground? p => p
         v := mainVariable(p)::V
         sfp : SparseUnivariatePolynomial(%)
         sfp := squareFreePart(univariate(p, v)@SparseUnivariatePolynomial(%))
         multivariate(sfp, v)

     if (V has ConvertibleTo(Symbol)) then

         PR ==> Polynomial R
         PQ ==> Polynomial Fraction Integer
         PZ ==> Polynomial Integer
         IES ==> IndexedExponents(Symbol)
         Q ==> Fraction Integer
         Z ==> Integer

         convert(p : %) : PR ==
           ground? p => (ground(p)$%)::PR
           v : V := mvar(p)
           d : NNI := mdeg(p)
           convert(init(p))@PR *$PR ((convert(v)@Symbol)::PR)^d +$PR convert(tail(p))@PR

         coerce(p : %) : PR ==
           convert(p)@PR

         localRetract : PR -> %
         localRetractPQ : PQ -> %
         localRetractPZ : PZ -> %
         localRetractIfCan : PR -> Union(%,"failed")
         localRetractIfCanPQ : PQ -> Union(%,"failed")
         localRetractIfCanPZ : PZ -> Union(%,"failed")

         if V has Finite then

             sizeV : NNI := size()$V
             lv : List Symbol
             lv := [convert(index(i::PositiveInteger)$V)@Symbol for i in 1..sizeV]

             localRetract(p : PR) : % ==
               ground? p => (ground(p)$PR)::%
               mvp : Symbol := (mainVariable(p)$PR)::Symbol
               d : NNI
               imvp : PositiveInteger := (position(mvp, lv)$(List Symbol))::PositiveInteger
               vimvp : V := index(imvp)$V
               xvimvp, c : %
               newp := 0$%
               while (not zero? (d := degree(p, mvp))) repeat
                 c := localRetract(coefficient(p, mvp, d)$PR)
                 xvimvp := monomial(c, vimvp, d)$%
                 newp := newp +$% xvimvp
                 p := p -$PR monomial(coefficient(p, mvp, d)$PR, mvp, d)$PR
               newp +$% localRetract(p)

             if R has Algebra Fraction Integer then
                 localRetractPQ(pq : PQ) : % ==
                   ground? pq => ((ground(pq)$PQ)::R)::%
                   mvp : Symbol := (mainVariable(pq)$PQ)::Symbol
                   d : NNI
                   imvp : PositiveInteger := (position(mvp, lv)$(List Symbol))::PositiveInteger
                   vimvp : V := index(imvp)$V
                   xvimvp, c : %
                   newp := 0$%
                   while (not zero? (d := degree(pq, mvp))) repeat
                     c := localRetractPQ(coefficient(pq, mvp, d)$PQ)
                     xvimvp := monomial(c, vimvp, d)$%
                     newp := newp +$% xvimvp
                     pq := pq -$PQ monomial(coefficient(pq, mvp, d)$PQ, mvp, d)$PQ
                   newp +$% localRetractPQ(pq)

             if R has Algebra Integer then
                 localRetractPZ(pz : PZ) : % ==
                   ground? pz => ((ground(pz)$PZ)::R)::%
                   mvp : Symbol := (mainVariable(pz)$PZ)::Symbol
                   d : NNI
                   imvp : PositiveInteger := (position(mvp, lv)$(List Symbol))::PositiveInteger
                   vimvp : V := index(imvp)$V
                   xvimvp, c : %
                   newp := 0$%
                   while (not zero? (d := degree(pz, mvp))) repeat
                     c := localRetractPZ(coefficient(pz, mvp, d)$PZ)
                     xvimvp := monomial(c, vimvp, d)$%
                     newp := newp +$% xvimvp
                     pz := pz -$PZ monomial(coefficient(pz, mvp, d)$PZ, mvp, d)$PZ
                   newp +$% localRetractPZ(pz)

             retractable?(p : PR) : Boolean ==
               lvp := variables(p)$PR
               while not empty? lvp and member?(first lvp, lv) repeat
                 lvp := rest lvp
               empty? lvp

             retractablePQ?(p : PQ) : Boolean ==
               lvp := variables(p)$PQ
               while not empty? lvp and member?(first lvp, lv) repeat
                 lvp := rest lvp
               empty? lvp

             retractablePZ?(p : PZ) : Boolean ==
               lvp := variables(p)$PZ
               while not empty? lvp and member?(first lvp, lv) repeat
                 lvp := rest lvp
               empty? lvp

             localRetractIfCan(p : PR) : Union(%,"failed") ==
               not retractable?(p) => "failed"::Union(%,"failed")
               localRetract(p)::Union(%,"failed")

             localRetractIfCanPQ(p : PQ) : Union(%,"failed") ==
               not retractablePQ?(p) => "failed"::Union(%,"failed")
               localRetractPQ(p)::Union(%,"failed")

             localRetractIfCanPZ(p : PZ) : Union(%,"failed") ==
               not retractablePZ?(p) => "failed"::Union(%,"failed")
               localRetractPZ(p)::Union(%,"failed")

         if R has Algebra Integer or _
            R has Algebra Fraction Integer then
           mpc2Z := MPolyCatFunctions2(Symbol, IES, IES, Z, R, PZ, PR)
           ZToR (z : Z) : R == coerce(z)@R
           PZToPR (pz : PZ) : PR == map(ZToR, pz)$mpc2Z

           if R has Algebra Fraction Integer then

             mpc2Q := MPolyCatFunctions2(Symbol, IES, IES, Q, R, PQ, PR)
             QToR (q : Q) : R == coerce(q)@R
             PQToPR (pq : PQ) : PR == map(QToR, pq)$mpc2Q

             retract(pq : PQ) ==
               rif : Union(%,"failed") := retractIfCan(pq)@Union(%,"failed")
               (rif case "failed") => error "failed in retract: POLY Z -> % from RPOLCAT"
               rif

             convert(pq : PQ) ==
               retract(pq)@%

             if not (R has QuotientFieldCategory(Integer))
               then
                 -- the only operation to implement is retractIfCan : PR -> Union(%,"failed")
                 -- when V does not have Finite

                 if V has Finite
                   then
                     retractIfCan(pr : PR) ==
                       localRetractIfCan(pr)@Union(%,"failed")

                     retractIfCan(pq : PQ) ==
                       localRetractIfCanPQ(pq)@Union(%,"failed")
                   else
                     retractIfCan(pq : PQ) ==
                       pr : PR := PQToPR(pq)
                       retractIfCan(pr)@Union(%,"failed")

                 retractIfCan(pz : PZ) ==
                   pr : PR := PZToPR(pz)
                   retractIfCan(pr)@Union(%,"failed")

                 retract(pr : PR) ==
                   rif : Union(%,"failed") := retractIfCan(pr)@Union(%,"failed")
                   (rif case "failed") => error "failed in retract: POLY Z -> % from RPOLCAT"
                   rif

                 convert(pr : PR) ==
                   retract(pr)@%

               else
                 -- the only operation to implement is retractIfCan : PQ -> Union(%,"failed")
                 -- when V does not have Finite
                 mpc2ZQ := MPolyCatFunctions2(Symbol, IES, IES, Z, Q, PZ, PQ)
                 mpc2RQ := MPolyCatFunctions2(Symbol, IES, IES, R, Q, PR, PQ)
                 ZToQ(z : Z) : Q == coerce(z)@Q
                 RToQ(r : R) : Q == retract(r)@Q

                 PZToPQ (pz : PZ) : PQ == map(ZToQ, pz)$mpc2ZQ
                 PRToPQ (pr : PR) : PQ == map(RToQ, pr)$mpc2RQ

                 retractIfCan(pz : PZ) ==
                   pq : PQ := PZToPQ(pz)
                   retractIfCan(pq)@Union(%,"failed")

                 if V has Finite
                   then
                     retractIfCan(pq : PQ) ==
                       localRetractIfCanPQ(pq)@Union(%,"failed")

                     convert(pr : PR) ==
                       lrif : Union(%,"failed") := localRetractIfCan(pr)@Union(%,"failed")
                       (lrif case "failed") => error "failed in convert: PR->% from RPOLCAT"
                       lrif
                   else
                     convert(pr : PR) ==
                       pq : PQ := PRToPQ(pr)
                       retract(pq)@%

           if (R has Algebra Integer) and _
              not(R has Algebra Fraction Integer) then

             retract(pz : PZ) ==
               rif : Union(%,"failed") := retractIfCan(pz)@Union(%,"failed")
               (rif case "failed") => error "failed in retract: POLY Z -> % from RPOLCAT"
               rif

             convert(pz : PZ) ==
               retract(pz)@%

             if not (R has IntegerNumberSystem)
               then
                 -- the only operation to implement is retractIfCan : PR -> Union(%,"failed")
                 -- when V does not have Finite

                 if V has Finite
                   then
                     retractIfCan(pr : PR) ==
                       localRetractIfCan(pr)@Union(%,"failed")

                     retractIfCan(pz : PZ) ==
                       localRetractIfCanPZ(pz)@Union(%,"failed")
                   else
                     retractIfCan(pz : PZ) ==
                       pr : PR := PZToPR(pz)
                       retractIfCan(pr)@Union(%,"failed")

                 retract(pr : PR) ==
                   rif : Union(%,"failed") := retractIfCan(pr)@Union(%,"failed")
                   (rif case "failed") => error "failed in retract: POLY Z -> % from RPOLCAT"
                   rif

                 convert(pr : PR) ==
                   retract(pr)@%

               else
                 -- the only operation to implement is retractIfCan : PZ -> Union(%,"failed")
                 -- when V does not have Finite

                 mpc2RZ := MPolyCatFunctions2(Symbol, IES, IES, R, Z, PR, PZ)
                 RToZ(r : R) : Z == retract(r)@Z
                 PRToPZ (pr : PR) : PZ == map(RToZ, pr)$mpc2RZ

                 if V has Finite
                   then
                     convert(pr : PR) ==
                       lrif : Union(%,"failed") := localRetractIfCan(pr)@Union(%,"failed")
                       (lrif case "failed") => error "failed in convert: PR->% from RPOLCAT"
                       lrif
                     retractIfCan(pz : PZ) ==
                       localRetractIfCanPZ(pz)@Union(%,"failed")
                   else
                     convert(pr : PR) ==
                       pz : PZ := PRToPZ(pr)
                       retract(pz)@%


         if not(R has Algebra Integer) and not(R has Algebra Fraction Integer)
           then
             -- the only operation to implement is retractIfCan : PR -> Union(%,"failed")

             if V has Finite
               then
                 retractIfCan(pr : PR) ==
                   localRetractIfCan(pr)@Union(%,"failed")

             retract(pr : PR) ==
               rif : Union(%,"failed") := retractIfCan(pr)@Union(%,"failed")
               (rif case "failed") => error "failed in retract: POLY Z -> % from RPOLCAT"
               rif

             convert(pr : PR) ==
               retract(pr)@%

         if (R has RetractableTo(INT))
           then

             convert(pol : %) : String ==
               ground?(pol) => convert(retract(ground(pol))@INT)@String
               ipol : % := init(pol)
               vpol : V := mvar(pol)
               dpol : NNI := mdeg(pol)
               tpol : % := tail(pol)
               sipol, svpol, sdpol, stpol : String
               if (ipol = 1)
                 then
                   sipol := empty()$String
                 else
                   if ((-ipol) = 1)
                     then
                       sipol := "-"
                     else
                       sipol := convert(ipol)@String
                       if not monomial?(ipol)
                         then
                           sipol := concat(["(",sipol,")*"])$String
                         else
                           sipol := concat(sipol,"*")$String
               svpol := string(convert(vpol)@Symbol)
               if (dpol = 1)
                 then
                   sdpol :=  empty()$String
                 else
                   sdpol := concat("^",convert(convert(dpol)@INT)@String )$String
               if zero? tpol
                 then
                   stpol :=  empty()$String
                 else
                   if ground?(tpol)
                     then
                       n := retract(ground(tpol))@INT
                       if n > 0
                         then
                           stpol :=  concat(" +",convert(n)@String)$String
                         else
                           stpol := convert(n)@String
                     else
                       stpol := convert(tpol)@String
                       if not member?((stpol.1)::String,["+","-"])$(List String)
                         then
                           stpol :=  concat(" + ",stpol)$String
               concat([sipol, svpol, sdpol, stpol])$String

)abbrev domain NSMP NewSparseMultivariatePolynomial
++ Author: Marc Moreno Maza
++ Date Created: 22/04/94
++ Basic Operations:
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ Examples:
++ References:
++ Description: A post-facto extension for \spadtype{SMP} in order
++ to speed up operations related to pseudo-division and gcd.
++ This domain is based on the \spadtype{NSUP} constructor which is
++ itself a post-facto extension of the \spadtype{SUP} constructor.
++ Version: 2

NewSparseMultivariatePolynomial(R, VarSet) : Exports == Implementation where
  R : Ring
  VarSet : OrderedSet
  N ==> NonNegativeInteger
  Z ==> Integer
  SUP ==> NewSparseUnivariatePolynomial
  SMPR ==> SparseMultivariatePolynomial(R, VarSet)
  SUP2 ==> NewSparseUnivariatePolynomialFunctions2(%, %)

  Exports == Join(RecursivePolynomialCategory(R, IndexedExponents VarSet, VarSet),
                  CoercibleTo(SMPR), RetractableTo(SMPR))

  Implementation ==  SparseMultivariatePolynomial(R, VarSet) add

     D := NewSparseUnivariatePolynomial(%)
     VPoly :=  Record(v : VarSet, ts : D)
     Rep := Union(R, VPoly)

    --local function
     PSimp : (D, VarSet) -> %

     PSimp(up, mv) ==
       if degree(up) = 0 then leadingCoefficient(up) else [mv, up]$VPoly

     coerce (p : %) : SMPR ==
       p pretend SMPR

     coerce (p : SMPR) : % ==
       p pretend %

     retractIfCan (p:%) : Union(SMPR,"failed") ==
       (p pretend SMPR)::Union(SMPR,"failed")

     mvar p ==
       p case R => error "Error in mvar from NSMP : #1 has no variables."
       p.v

     mdeg p ==
       p case R => 0$N
       degree(p.ts)$D

     init p ==
       p case R => error "Error in init from NSMP : #1 has no variables."
       leadingCoefficient(p.ts)$D

     head p ==
       p case R => p
       ([p.v, leadingMonomial(p.ts)$D]$VPoly)::Rep

     tail p ==
       p case R => 0$%
       red := reductum(p.ts)$D
       ground?(red)$D => (ground(red)$D)::Rep
       ([p.v, red]$VPoly)::Rep

     iteratedInitials p ==
       p case R => []
       p := leadingCoefficient(p.ts)$D
       cons(p, iteratedInitials(p))

     localDeepestInitial (p : %) : % ==
       p case R => p
       localDeepestInitial leadingCoefficient(p.ts)$D

     deepestInitial p ==
       p case R => error "Error in deepestInitial from NSMP : #1 has no variables."
       localDeepestInitial leadingCoefficient(p.ts)$D

     mainMonomial p ==
       zero? p => error "Error in mainMonomial from NSMP : the argument is zero"
       p case R => 1$%
       monomial(1$%, p.v, degree(p.ts)$D)

     leastMonomial p ==
       zero? p => error "Error in leastMonomial from NSMP : the argument is zero"
       p case R => 1$%
       monomial(1$%, p.v, minimumDegree(p.ts)$D)

     mainCoefficients p ==
       zero? p => error "Error in mainCoefficients from NSMP : the argument is zero"
       p case R => [p]
       coefficients(p.ts)$D

     leadingCoefficient(p : %, x : VarSet) : % ==
       (p case R) => p
       p.v = x => leadingCoefficient(p.ts)$D
       zero? (d := degree(p, x)) => p
       coefficient(p, x, d)

     localMonicModulo(a : %, b : %) : % ==
       -- b is assumed to have initial 1
       a case R => a
       a.v < b.v => a
       mM : %
       if a.v > b.v
         then
           m : D := map((a1 : %) : % +-> localMonicModulo(a1, b), a.ts)$SUP2
         else
           m : D := monicModulo(a.ts, b.ts)$D
       if ground?(m)$D
          then
            mM := (ground(m)$D)::Rep
          else
            mM := ([a.v, m]$VPoly)::Rep
       mM

     monicModulo (a, b) ==
       b case R => error "Error in monicModulo from NSMP : #2 is constant"
       ib : % := init(b)@%
       not ground?(ib)$% =>
         error "Error in monicModulo from NSMP : #2 is not monic"
       mM : %
       if not ((ib) = 1)$%
         then
           r : R := ground(ib)$%
           rec : Union(R,"failed") := recip(r)$R
           (rec case "failed") =>
             error "Error in monicModulo from NSMP : #2 is not monic"
           a case R => a
           a := (rec@R) * a
           b := (rec@R) * b
           mM := ib * localMonicModulo (a, b)
         else
           mM := localMonicModulo (a, b)
       mM

     prem(a : %, b : %) : % ==
       -- with pseudoRemainder$NSUP
       b case R =>
         error "in prem$NSMP: ground? #2"
       db : N := degree(b.ts)$D
       lcb : % := leadingCoefficient(b.ts)$D
       test : Z := degree(a, b.v)::Z - db
       delta : Z := max(test + 1$Z, 0$Z)
       (a case R) or (a.v < b.v) => lcb ^ (delta::N) *$% a@%
       a.v = b.v =>
         r : D := pseudoRemainder(a.ts, b.ts)$D
         ground?(r) => return (ground(r)$D)::Rep
         ([a.v, r]$VPoly)::Rep
       while not zero?(a) and not negative?(test) repeat
         term := monomial(leadingCoefficient(a, b.v), b.v, test::N)
         a := lcb * a -$% term * b
         delta := delta - 1$Z
         test := degree(a, b.v)::Z - db
       lcb ^ (delta::N) *$% a

     pquo (a : %, b : %) : % ==
       cPS := lazyPseudoDivide (a, b)
       c := (cPS.coef) ^$% (cPS.gap)
       c *$% cPS.quotient

     pseudoDivide(a : %, b : %) : Record(quotient : %, remainder : %) ==
       -- from RPOLCAT
       cPS := lazyPseudoDivide(a, b)
       c := (cPS.coef) ^$% (cPS.gap)
       [c * cPS.quotient, c * cPS.remainder]

     lazyPrem(a : %, b : %) : % ==
       -- with lazyPseudoRemainder$NSUP
       -- Uses leadingCoefficient: (%, V) -> %
       b case R =>
         error "in lazyPrem$NSMP: ground? #2"
       (a case R) or (a.v < b.v) => a
       a.v = b.v => PSimp(lazyPseudoRemainder(a.ts, b.ts)$D, a.v)
       db : N := degree(b.ts)$D
       lcb : % := leadingCoefficient(b.ts)$D
       test : Z := degree(a, b.v)::Z - db
       while not zero?(a) and not negative?(test) repeat
         term := monomial(leadingCoefficient(a, b.v), b.v, test::N)
         a := lcb * a -$% term * b
         test := degree(a, b.v)::Z - db
       a

     lazyPquo (a : %, b : %) : % ==
       -- with lazyPseudoQuotient$NSUP
       b case R =>
         error "in lazyPquo$NSMP: #2 is constant"
       (a case R) or (a.v < b.v) => 0
       a.v = b.v => PSimp(lazyPseudoQuotient(a.ts, b.ts)$D, a.v)
       db : N := degree(b.ts)$D
       lcb : % := leadingCoefficient(b.ts)$D
       test : Z := degree(a, b.v)::Z - db
       q := 0$%
       test : Z := degree(a, b.v)::Z - db
       while not zero?(a) and not negative?(test) repeat
         term := monomial(leadingCoefficient(a, b.v), b.v, test::N)
         a := lcb * a -$% term * b
         q := lcb * q +$% term
         test := degree(a, b.v)::Z - db
       q

     lazyPseudoDivide(a : %, b : %) : Record(coef : %, gap : N, quotient : %, remainder : %) ==
       -- with lazyPseudoDivide$NSUP
       b case R =>
         error "in lazyPseudoDivide$NSMP: #2 is constant"
       (a case R) or (a.v < b.v) => [1$%, 0$N, 0$%, a]
       a.v = b.v =>
         cgqr := lazyPseudoDivide(a.ts, b.ts)
         [cgqr.coef, cgqr.gap, PSimp(cgqr.quotient, a.v), PSimp(cgqr.remainder, a.v)]
       db : N := degree(b.ts)$D
       lcb : % := leadingCoefficient(b.ts)$D
       test : Z := degree(a, b.v)::Z - db
       q := 0$%
       delta : Z := max(test + 1$Z, 0$Z)
       while not zero?(a) and not negative?(test) repeat
         term := monomial(leadingCoefficient(a, b.v), b.v, test::N)
         a := lcb * a -$% term * b
         q := lcb * q +$% term
         delta := delta - 1$Z
         test := degree(a, b.v)::Z - db
       [lcb, (delta::N), q, a]

     lazyResidueClass(a : %, b : %) : Record(polnum : %, polden : %, power : N) ==
       -- with lazyResidueClass$NSUP
       b case R =>
         error "in lazyResidueClass$NSMP: #2 is constant"
       lcb : % := leadingCoefficient(b.ts)$D
       (a case R) or (a.v < b.v) => [a, lcb, 0]
       a.v = b.v =>
         lrc := lazyResidueClass(a.ts, b.ts)$D
         [PSimp(lrc.polnum, a.v), lrc.polden, lrc.power]
       db : N := degree(b.ts)$D
       test : Z := degree(a, b.v)::Z - db
       pow : N := 0
       while not zero?(a) and not negative?(test) repeat
         term := monomial(leadingCoefficient(a, b.v), b.v, test::N)
         a := lcb * a -$% term * b
         pow := pow + 1
         test := degree(a, b.v)::Z - db
       [a, lcb, pow]

     if R has IntegralDomain then

       packD := PseudoRemainderSequence(%, D)

       exactQuo(x : %, y : %) : % ==
         ex : Union(%,"failed") := x exquo$% y
         (ex case %) => ex
         error "in exactQuotient$NSMP: bad args"

       LazardQuotient(x : %, y : %, n : N) : % ==
           LazardQuotient(x, y, n)$packD

       LazardQuotient2(p : %, a : %, b : %, n : N) ==
         zero?(n) => error "in LazardQuotient2$NSMP: bad #4"
         n = 1 => p
         c : % := LazardQuotient(a, b, (n-1)::N)
         exactQuo(c*p, b)

       next_subResultant2(p : %, q : %, z : %, s : %) ==
         PSimp(next_sousResultant2(p.ts, q.ts, z.ts, s)$packD, p.v)

       subResultantGcd(a : %, b : %) : % ==
         (a case R) or (b case R) =>
           error "subResultantGcd$NSMP: one arg is constant"
         a.v ~= b.v =>
           error "subResultantGcd$NSMP: mvar(#1) ~= mvar(#2)"
         PSimp(subResultantGcd(a.ts, b.ts), a.v)

       halfExtendedSubResultantGcd1(a : %, b : %) : Record(gcd : %, coef1 : %) ==
         (a case R) or (b case R) =>
           error "halfExtendedSubResultantGcd1$NSMP: one arg is constant"
         a.v ~= b.v =>
           error "halfExtendedSubResultantGcd1$NSMP: mvar(#1) ~= mvar(#2)"
         hesrg := halfExtendedSubResultantGcd1(a.ts, b.ts)$D
         [PSimp(hesrg.gcd, a.v), PSimp(hesrg.coef1, a.v)]

       halfExtendedSubResultantGcd2(a : %, b : %) : Record(gcd : %, coef2 : %) ==
         (a case R) or (b case R) =>
           error "halfExtendedSubResultantGcd2$NSMP: one arg is constant"
         a.v ~= b.v =>
           error "halfExtendedSubResultantGcd2$NSMP: mvar(#1) ~= mvar(#2)"
         hesrg := halfExtendedSubResultantGcd2(a.ts, b.ts)$D
         [PSimp(hesrg.gcd, a.v), PSimp(hesrg.coef2, a.v)]

       extendedSubResultantGcd(a : %, b : %) : Record(gcd : %, coef1 : %, coef2 : %) ==
         (a case R) or (b case R) =>
           error "extendedSubResultantGcd$NSMP: one arg is constant"
         a.v ~= b.v =>
           error "extendedSubResultantGcd$NSMP: mvar(#1) ~= mvar(#2)"
         esrg := extendedSubResultantGcd(a.ts, b.ts)$D
         [PSimp(esrg.gcd, a.v), PSimp(esrg.coef1, a.v), PSimp(esrg.coef2, a.v)]

       resultant(a : %, b : %) : % ==
         (a case R) or (b case R) =>
           error "resultant$NSMP: one arg is constant"
         a.v ~= b.v =>
           error "resultant$NSMP: mvar(#1) ~= mvar(#2)"
         resultant(a.ts, b.ts)$D

       subResultantChain(a : %, b : %) : List % ==
         (a case R) or (b case R) =>
           error "subResultantChain$NSMP: one arg is constant"
         a.v ~= b.v =>
           error "subResultantChain$NSMP: mvar(#1) ~= mvar(#2)"
         [PSimp(up, a.v) for up in subResultantsChain(a.ts, b.ts)]

       lastSubResultant(a : %, b : %) : % ==
         (a case R) or (b case R) =>
           error "lastSubResultant$NSMP: one arg is constant"
         a.v ~= b.v =>
           error "lastSubResultant$NSMP: mvar(#1) ~= mvar(#2)"
         PSimp(lastSubResultant(a.ts, b.ts), a.v)

       if R has EuclideanDomain
       then

         exactQuotient (a : %, b : R) ==
           (b = 1) => a
           a case R => (a@R quo$R b)::%
           ([a.v, map((a1 : %) : % +-> exactQuotient(a1, b), a.ts)$SUP2]$VPoly)::Rep

         exactQuotient! (a : %, b : R) ==
           (b = 1) => a
           a case R => (a@R quo$R b)::%
           a.ts := map((a1 : %) : % +-> exactQuotient!(a1, b), a.ts)$SUP2
           a

       else

         exactQuotient (a : %, b : R) ==
           (b = 1) => a
           a case R => ((a@R exquo$R b)::R)::%
           ([a.v, map((a1 : %) : % +-> exactQuotient(a1, b), a.ts)$SUP2]$VPoly)::Rep

         exactQuotient! (a : %, b : R) ==
           (b = 1) => a
           a case R => ((a@R exquo$R b)::R)::%
           a.ts := map((a1 : %) : % +-> exactQuotient!(a1, b), a.ts)$SUP2
           a

     if R has GcdDomain
     then

       localGcd(r : R, p : %) : R ==
         p case R => gcd(r, p@R)$R
         gcd(r, content(p))$R

       gcd(r : R, p : %) : R ==
         (r = 1) => r
         zero? p => r
         localGcd(r, p)

       content p ==
         p case R => p
         up : D := p.ts
         r := 0$R
         while (not zero? up) and (not (r = 1)) repeat
           r := localGcd(r, leadingCoefficient(up))
           up := reductum up
         r

       primitivePart! p ==
         zero? p => p
         p case R => 1$%
         cp := content(p)
         p.ts := unitCanonical(map((a1 : %) : % +-> exactQuotient!(a1, cp), p.ts)$SUP2)$D
         p

--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
--
--Redistribution and use in source and binary forms, with or without
--modification, are permitted provided that the following conditions are
--met:
--
--    - Redistributions of source code must retain the above copyright
--      notice, this list of conditions and the following disclaimer.
--
--    - Redistributions in binary form must reproduce the above copyright
--      notice, this list of conditions and the following disclaimer in
--      the documentation and/or other materials provided with the
--      distribution.
--
--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--      names of its contributors may be used to endorse or promote products
--      derived from this software without specific prior written permission.
--
--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
