)abbrev package PRS PseudoRemainderSequence
++ Author: Ducos Lionel
++ Date Created: January 1995
++ Basic Functions:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ Description: This package contains some functions:
++ \spadopFrom{discriminant}{PseudoRemainderSequence},
++ \spadopFrom{resultant}{PseudoRemainderSequence},
++ \spadopFrom{subResultantGcd}{PseudoRemainderSequence},
++ \spadopFrom{chainSubResultants}{PseudoRemainderSequence},
++ \spadopFrom{degreeSubResultant}{PseudoRemainderSequence},
++ \spadopFrom{lastSubResultant}{PseudoRemainderSequence},
++ \spadopFrom{resultantEuclidean}{PseudoRemainderSequence},
++ \spadopFrom{subResultantGcdEuclidean}{PseudoRemainderSequence},
++ \spadopFrom{semiSubResultantGcdEuclidean1}{PseudoRemainderSequence},
++ \spadopFrom{semiSubResultantGcdEuclidean2}{PseudoRemainderSequence}, etc.
++ These procedures are coming from improvements
++ of the subresultants algorithm.
++ References: Lionel Ducos, "Optimizations of the subresultant algorithm"
++     Journal of Pure and Applied Algebra, 2000, Volume 145, 149-163

PseudoRemainderSequence(R, polR) : Specification == Implementation where
  R : IntegralDomain
  polR : UnivariatePolynomialCategory(R)
  NNI ==> NonNegativeInteger
  LC  ==> leadingCoefficient

  Specification == with
       resultant : (polR, polR) -> R
         ++ \spad{resultant(P, Q)} returns the resultant
         ++ of \spad{P} and \spad{Q}

       resultantEuclidean : (polR, polR) ->
                          Record(coef1 : polR, coef2 : polR, resultant : R)
         ++ \spad{resultantEuclidean(P, Q)} carries out the equality
         ++ \spad{coef1*P + coef2*Q = resultant(P, Q)}

       semiResultantEuclidean2 : (polR, polR) ->
                          Record(coef2 : polR, resultant : R)
         ++ \spad{semiResultantEuclidean2(P, Q)} carries out the equality
         ++ \spad{... P + coef2*Q = resultant(P, Q)}.
         ++ Warning: \spad{degree(P) >= degree(Q)}.

       semiResultantEuclidean1 : (polR, polR) ->
                          Record(coef1 : polR, resultant : R)
         ++ \spad{semiResultantEuclidean1(P, Q)} carries out the equality
         ++ \spad{coef1.P + ... Q = resultant(P, Q)}.

       indiceSubResultant : (polR, polR, NNI) -> polR
         ++ \spad{indiceSubResultant(P, Q, i)} returns
         ++ the subresultant of indice \spad{i}

       indiceSubResultantEuclidean : (polR, polR, NNI) ->
                       Record(coef1 : polR, coef2 : polR, subResultant : polR)
         ++ \spad{indiceSubResultant(P, Q, i)} returns
         ++ the subresultant \spad{S_i(P, Q)} and carries out the equality
         ++ \spad{coef1*P + coef2*Q = S_i(P, Q)}

       semiIndiceSubResultantEuclidean : (polR, polR, NNI) ->
                          Record(coef2 : polR, subResultant : polR)
         ++ \spad{semiIndiceSubResultantEuclidean(P, Q, i)} returns
         ++ the subresultant \spad{S_i(P, Q)} and carries out the equality
         ++ \spad{... P + coef2*Q = S_i(P, Q)}
         ++ Warning: \spad{degree(P) >= degree(Q)}.

       degreeSubResultant : (polR, polR, NNI) -> polR
         ++ \spad{degreeSubResultant(P, Q, d)} computes
         ++ a subresultant of degree \spad{d}.

       degreeSubResultantEuclidean : (polR, polR, NNI) ->
                       Record(coef1 : polR, coef2 : polR, subResultant : polR)
         ++ \spad{degreeSubResultantEuclidean(P, Q, d)} returns
         ++ a subresultant \spad{S_i} of degree \spad{d}
         ++ and carries out the equality \spad{coef1*P + coef2*Q = S_i}.

       semiDegreeSubResultantEuclidean : (polR, polR, NNI) ->
                          Record(coef2 : polR, subResultant : polR)
         ++ \spad{semiDegreeSubResultantEuclidean(P, Q, d)} returns
         ++ a subresultant \spad{S_i} of degree \spad{d}
         ++ and carries out the equality \spad{... P + coef2*Q = S_i}.
         ++ Warning: \spad{degree(P) >= degree(Q)}.

       lastSubResultant : (polR, polR) -> polR
         ++ \spad{lastSubResultant(P, Q)} computes
         ++ the last non zero subresultant of \spad{P} and \spad{Q}

       lastSubResultantEuclidean : (polR, polR) ->
                       Record(coef1 : polR, coef2 : polR, subResultant : polR)
         ++ \spad{lastSubResultantEuclidean(P, Q)} computes
         ++ the last non zero subresultant \spad{S}
         ++ and carries out the equality \spad{coef1*P + coef2*Q = S}.

       semiLastSubResultantEuclidean : (polR, polR) ->
                       Record(coef2 : polR, subResultant : polR)
         ++ \spad{semiLastSubResultantEuclidean(P, Q)} computes
         ++ the last non zero subresultant \spad{S}
         ++ and carries out the equality \spad{... P + coef2*Q = S}.
         ++ Warning: \spad{degree(P) >= degree(Q)}.

       subResultantGcd : (polR, polR) -> polR
         ++ \spad{subResultantGcd(P, Q)} returns the gcd
         ++ of two primitive polynomials \spad{P} and \spad{Q}.

       subResultantGcdEuclidean : (polR, polR)
                     -> Record(coef1 : polR, coef2 : polR, gcd : polR)
         ++ \spad{subResultantGcdEuclidean(P, Q)} carries out the equality
         ++ \spad{coef1*P + coef2*Q = +/- S_i(P, Q)}
         ++ where the degree (not the indice)
         ++ of the subresultant \spad{S_i(P, Q)} is as small as possible.

       semiSubResultantGcdEuclidean2 : (polR, polR)
                                   -> Record(coef2 : polR, gcd : polR)
         ++ \spad{semiSubResultantGcdEuclidean2(P, Q)} carries out the equality
         ++ \spad{... P + coef2*Q = +/- S_i(P, Q)}
         ++ where the degree (not the indice)
         ++ of the subresultant \spad{S_i(P, Q)} is as small as possible.
         ++ Warning: \spad{degree(P) >= degree(Q)}.

       semiSubResultantGcdEuclidean1 : (polR, polR) -> Record(coef1 : polR, gcd : polR)
         ++ \spad{semiSubResultantGcdEuclidean1(P, Q)} carries out the equality
         ++ \spad{coef1*P + ... Q = +/- S_i(P, Q)}
         ++ where the degree (not the indice)
         ++ of the subresultant \spad{S_i(P, Q)} is as small as possible.

       discriminant : polR -> R
         ++ \spad{discriminant(P)} returns the discriminant
         ++ of \spad{P}.

       discriminantEuclidean : polR ->
                           Record(coef1 : polR, coef2 : polR, discriminant : R)
         ++ \spad{discriminantEuclidean(P)} carries out the equality
         ++ \spad{coef1 * P + coef2 * D(P) = discriminant(P)}.

       semiDiscriminantEuclidean : polR ->
                           Record(coef2 : polR, discriminant : R)
         ++ \spad{discriminantEuclidean(P)} carries out the equality
         ++ \spad{... P + coef2 * D(P) = discriminant(P)}.
         ++ Warning: \spad{degree(P) >= degree(Q)}.

       chainSubResultants : (polR, polR) -> List(polR)
         ++ \spad{chainSubResultants(P, Q)} computes the list
         ++ of non zero subresultants of \spad{P} and \spad{Q}.

       schema : (polR, polR) -> List(NNI)
         ++ \spad{schema(P, Q)} returns the list of degrees of
         ++ non zero subresultants of \spad{P} and \spad{Q}.

       if R has GcdDomain then
         resultantReduit : (polR, polR) -> R
         ++ \spad{resultantReduit(P,Q)} returns the "reduce resultant"
         ++ of \spad{P} and \spad{Q}.

         resultantReduitEuclidean : (polR, polR) ->
                        Record(coef1 : polR, coef2 : polR, resultantReduit : R)
         ++ \spad{resultantReduitEuclidean(P, Q)} returns
         ++ the "reduce resultant" and carries out the equality
         ++ \spad{coef1*P + coef2*Q = resultantReduit(P, Q)}.

         semiResultantReduitEuclidean : (polR, polR) ->
                        Record(coef2 : polR, resultantReduit : R)
         ++ \spad{semiResultantReduitEuclidean(P, Q)} returns
         ++ the "reduce resultant" and carries out the equality
         ++ \spad{... P + coef2*Q = resultantReduit(P, Q)}.

         gcd : (polR, polR) -> polR
         ++ \spad{gcd(P, Q)} returns the gcd of \spad{P} and \spad{Q}.

       -- sub-routines exported for convenience ----------------------------

       divide : (polR, polR) -> Record(quotient : polR, remainder : polR)
         ++ \spad{divide(F, G)} computes quotient and rest
         ++ of the exact euclidean division of \spad{F} by \spad{G}.

       LazardQuotient : (R, R, NNI) -> R
         ++ \spad{LazardQuotient(x, y, n)} computes \spad{x^n exquo y^(n-1)}

       LazardQuotient2 : (polR, R, R, NNI) -> polR
         ++ \spad{LazardQuotient2(F, x, y, n)} computes
         ++ \spad{(x^(n-1) * F) exquo y^(n-1)}

       next_sousResultant2 : (polR, polR, polR, R) -> polR
         ++ \spad{next_sousResultant2(P, Q, Z, s)} returns
         ++ the subresultant \spad{S_{e-1}} where
         ++ \spad{P ~ S_d,  Q = S_{d-1},  Z = S_e,  s = lc(S_d)}

  Implementation == add
    X : polR := monomial(1$R, 1)

    (r : R * v : Vector(polR)) : Vector(polR) == r::polR * v
              -- the instruction  map(r * #1, v) is slower !?

    (v : Vector(polR) exquo r : R) : Vector(polR) ==
        map((p1 : polR) : polR +-> (p1 exquo r)::polR, v)

    divide(F : polR, G : polR) : Record(quotient : polR, remainder : polR)==
    -- computes quotient and rest of the exact euclidean division of F by G
         lcG : R := LC(G)
         degG : NNI := degree(G)
         zero?(degG) => ( F := (F exquo lcG)::polR; return construct(F, 0))
         G : polR := reductum(G)
         quot : polR := 0
         while (delta := degree(F) - degG) >= 0 repeat
            mon : polR := monomial((LC(F) exquo lcG)::R, delta::NNI)
            quot := quot + mon
            F := reductum(F) - mon * G
         return construct(quot, F)

    resultant_naif(P : polR, Q : polR) : R ==
    -- valid over a field
       a : R := 1
       repeat
          zero?(Q) => return 0
          (degP, degQ) := (degree(P), degree(Q))
          if odd?(degP) and odd?(degQ) then a := - a
          zero?(degQ) => return (a * LC(Q)^degP)
          U : polR := divide(P, Q).remainder
          a := a * LC(Q)^(degP - degree(U))::NNI
          (P, Q) := (Q, U)

    resultantEuclidean_naif(P : polR, Q : polR) :
                       Record(coef1 : polR, coef2 : polR, resultant : R) ==
    -- valid over a field.
       a : R := 1
       old_cf1 : polR := 1 ; cf1 : polR := 0
       old_cf2 : polR := 0 ; cf2 : polR := 1
       repeat
          zero?(Q) => return [0, 0, 0]
          (degP, degQ) := (degree(P), degree(Q))
          if odd?(degP) and odd?(degQ) then a := -a
          if zero?(degQ) then
             a := a * LC(Q)^(degP-1)::NNI
             return [a*cf1, a*cf2, a*LC(Q)]
          divid := divide(P, Q)
          a := a * LC(Q)^(degP - degree(divid.remainder))::NNI
          (P, Q) := (Q, divid.remainder)
          (old_cf1, old_cf2, cf1, cf2) := (cf1, cf2,
                old_cf1 - divid.quotient * cf1, old_cf2 - divid.quotient * cf2)

    semiResultantEuclidean_naif(P : polR, Q : polR) :
                       Record(coef2 : polR, resultant : R) ==
    -- valid over a field
       a : R := 1
       old_cf2 : polR := 0 ; cf2 : polR := 1
       repeat
          zero?(Q) => return [0, 0]
          (degP, degQ) := (degree(P), degree(Q))
          if odd?(degP) and odd?(degQ) then a := -a
          if zero?(degQ) then
             a := a * LC(Q)^(degP-1)::NNI
             return [a*cf2, a*LC(Q)]
          divid := divide(P, Q)
          a := a * LC(Q)^(degP - degree(divid.remainder))::NNI
          (P, Q) := (Q, divid.remainder)
          (old_cf2, cf2) := (cf2, old_cf2 - divid.quotient * cf2)

    exactQuo(x : R, y : R) : R ==
        ex : Union(R, "failed") := x exquo$R y
        ex case R => ex::R
        error "exactQuo$PRS: bad args"

    LazardQuotient(x : R, y : R, n : NNI) : R ==
       zero?(n) => error("Lazard$PRS : n = 0")
       n = 1 => x
       a : NNI := 1
       while n >= (b := 2*a) repeat a := b
       c : R := x
       n := (n - a)::NNI
       repeat  --  c = x^i / y^(i-1),  i = n_0 quo a,  a = 2^?
          a = 1 => return c
          a := a quo 2
          c := exactQuo(c*c, y)
          if n >= a then ( c := exactQuo(c*x, y) ; n := (n - a)::NNI )

    LazardQuotient2(F : polR, x : R, y : R, n : NNI) : polR ==
       zero?(n) => error("LazardQuotient2$PRS : n = 0")
       n = 1 => F
       x := LazardQuotient(x, y, (n-1)::NNI)
       return ((x * F) exquo y)::polR

    Lazard3(V : Vector(polR), x : R, y : R, n : NNI) : Vector(polR) ==
    -- computes x^(n-1) * V / y^(n-1)
       zero?(n) => error("Lazard3$prs : n = 0")
       n = 1 => V
       x := LazardQuotient(x, y, (n-1)::NNI)
       (x * V) exquo y

    next_sousResultant2(P : polR, Q : polR, Z : polR, s : R) : polR ==
       (lcP, c, se) := (LC(P), LC(Q), LC(Z))
       (d, e) := (degree(P), degree(Q))
       (P, Q, H) := (reductum(P), reductum(Q), - reductum(Z))
       A : polR := coefficient(P, e) * H
       for i in e+1..d-1 repeat
          H := if degree(H) = e-1 then
                  X * reductum(H) - ((LC(H) * Q) exquo c)::polR
               else
                  X * H
          -- H = s_e * X^i mod S_d-1
          A := coefficient(P, i) * H + A
       while degree(P) >= e repeat P := reductum(P)
       A := A + se * P            --  A = s_e * reductum(P_0)       mod S_d-1
       A := (A exquo lcP)::polR   --  A = s_e * reductum(S_d) / s_d mod S_d-1
       A := if degree(H) = e-1 then
               c * (X * reductum(H) + A) - LC(H) * Q
            else
               c * (X * H + A)
       A := (A exquo s)::polR                    -- A = +/- S_e-1
       return (if odd?(d-e) then A else - A)

    next_sousResultant3(VP : Vector(polR), VQ : Vector(polR), s : R, ss : R) :
                                                      Vector(polR) ==
    -- P ~ S_d,  Q = S_d-1,  s = lc(S_d),  ss = lc(S_e)
       (P, Q) := (VP.1, VQ.1)
       (lcP, c) := (LC(P), LC(Q))
       e : NNI := degree(Q)
       if ((delta := degree(P) - e) = 1) then                   -- algo_new
         VP := c * VP - coefficient(P, e) * VQ
         VP := VP exquo lcP
         VP := c * (VP - X * VQ) + coefficient(Q, (e-1)::NNI) * VQ
         VP := VP exquo s
       else                                    -- algorithm of Lickteig - Roy
         (r, rr) := (s * lcP, ss * c)
         divid := divide(rr * P, Q)
         VP.1 := (divid.remainder exquo r)::polR
         for i in 2..#VP repeat
           VP.i := rr * VP.i - VQ.i * divid.quotient
           VP.i := (VP.i exquo r)::polR
       return (if odd?(delta) then VP else - VP)

    algo_new(P : polR, Q : polR) : R ==
       delta : NNI := (degree(P) - degree(Q))::NNI
       s : R := LC(Q)^delta
       (P, Q) := (Q, pseudoRemainder(P, -Q))
       repeat
          -- P = S_c-1 (except the first turn : P ~ S_c-1),
          -- Q = S_d-1,  s = lc(S_d)
          zero?(Q) => return 0
          delta := (degree(P) - degree(Q))::NNI
          Z : polR := LazardQuotient2(Q, LC(Q), s, delta)
          -- Z = S_e ~ S_d-1
          zero?(degree(Z)) => return LC(Z)
          (P, Q) := (Q, next_sousResultant2(P, Q, Z, s))
          s := LC(Z)

    resultant_def(algo) ==>
        zero?(Q) or zero?(P) => 0
        (degP, degQ) := (degree(P), degree (Q))
        if degP < degQ then
            (P, Q) := (Q, P)
            (degP, degQ) := (degQ, degP)
            if odd?(degP) and odd?(degQ) then Q := - Q
        zero?(degQ) => LC(Q)^degP
        -- degree(P) >= degree(Q) > 0
        algo(P, Q)

    if R has FiniteFieldCategory then

        resultant(P : polR, Q : polR) : R ==
            resultant_def(resultant_naif)

    else

        resultant(P : polR, Q : polR) : R ==
            resultant_def(algo_new)

    subResultantEuclidean(P : polR, Q : polR) :
                          Record(coef1 : polR, coef2 : polR, resultant : R) ==
        s : R := LC(Q)^(degree(P) - degree(Q))::NNI
        VP : Vector(polR) := [Q, 0::polR, 1::polR]
        pdiv := pseudoDivide(P, -Q)
        VQ : Vector(polR) := [pdiv.remainder, pdiv.coef::polR, pdiv.quotient]
        repeat
            --  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s=lc(S_d)
            --  S_{c-1} = VP.2 P_0 + VP.3 Q_0,  S_{d-1} = VQ.2 P_0 + VQ.3 Q_0
            (P, Q) := (VP.1, VQ.1)
            zero?(Q) => return [0::polR, 0::polR, 0::R]
            degQ := degree(Q)
            delta := (degree(P) - degQ)::NNI
            zero?(degQ) =>
                l : Vector(polR) := Lazard3(VQ, LC(Q), s, delta)
                return [l.2, l.3, LC(l.1)]
            ss : R := LazardQuotient(LC(Q), s, delta)
            (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
            s := ss

    resultantEuclidean_def(algo) ==>
        zero?(P) or zero?(Q) => [0, 0, 0]
        (degP, degQ) := (degree(P), degree(Q))
        degP < degQ =>
            e : Integer := if odd?(degP) and odd?(degQ) then -1 else 1
            l := resultantEuclidean(Q, e * P)
            [e * l.coef2, l.coef1, l.resultant]
        zero?(degQ) =>
            zero?(degP) => error
               "resultantEuclidean$PRS : constant polynomials"
            s : R := LC(Q)^(degP-1)::NNI
            [0::polR, s::polR, s * LC(Q)]
        algo(P, Q)

    if R has FiniteFieldCategory then

        resultantEuclidean(P : polR, Q : polR) :
                       Record(coef1 : polR, coef2 : polR, resultant : R) ==
            resultantEuclidean_def(resultantEuclidean_naif)

    else

        resultantEuclidean(P : polR, Q : polR) :
                       Record(coef1 : polR, coef2 : polR, resultant : R) ==
            resultantEuclidean_def(subResultantEuclidean)

    semiSubResultantEuclidean(P : polR, Q : polR) :
                       Record(coef2 : polR, resultant : R) ==
        s : R := LC(Q)^(degree(P) - degree(Q))::NNI
        VP : Vector(polR) := [Q, 1::polR]
        pdiv := pseudoDivide(P, -Q)
        VQ : Vector(polR) := [pdiv.remainder, pdiv.quotient]
        repeat
            --  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s=lc(S_d)
            --  S_{c-1} = ...P_0 + VP.3 Q_0,  S_{d-1} = ...P_0 + VQ.3 Q_0
            (P, Q) := (VP.1, VQ.1)
            zero?(Q) => return [0::polR, 0::R]
            degQ := degree(Q)
            delta := (degree(P) - degQ)::NNI
            if zero?(degQ) then
                l : Vector(polR) := Lazard3(VQ, LC(Q), s, delta)
                return [l.2, LC(l.1)]
            ss : R := LazardQuotient(LC(Q), s, delta)
            (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
            s := ss

    semiResultantEuclidean2_def(algo) ==>
        zero?(P) or zero?(Q) => [0, 0]
        (degP, degQ) := (degree(P), degree(Q))
        degP < degQ => error "semiResultantEuclidean2 : bad degrees"
        zero?(degQ) =>
            zero?(degP) => error
                "semiResultantEuclidean2 : constant polynomials"
            s : R := LC(Q)^(degP-1)::NNI
            [s::polR, s * LC(Q)]
        algo(P, Q)

    if R has FiniteFieldCategory then

        semiResultantEuclidean2(P : polR, Q : polR) :
                                Record(coef2 : polR, resultant : R) ==
            semiResultantEuclidean2_def(semiResultantEuclidean_naif)

    else

        semiResultantEuclidean2(P : polR, Q : polR) :
                                Record(coef2 : polR, resultant : R) ==
            semiResultantEuclidean2_def(semiSubResultantEuclidean)

    semiResultantEuclidean1(P : polR, Q : polR) :
                       Record(coef1 : polR, resultant : R) ==
       result := resultantEuclidean(P, Q)
       [result.coef1, result.resultant]

    indiceSubResultant(P : polR, Q : polR, i : NNI) : polR ==
       zero?(Q) or zero?(P) => 0
       if degree(P) < degree(Q) then
          (P, Q) := (Q, P)
          if odd?(degree(P)-i) and odd?(degree(Q)-i) then Q := - Q
       if i = degree(Q) then
          delta : NNI := (degree(P)-degree(Q))::NNI
          zero?(delta) => error("indiceSubResultant$PRS : bad degrees")
          s : R := LC(Q)^(delta-1)::NNI
          return s*Q
       i > degree(Q) => 0
       s : R := LC(Q)^(degree(P) - degree(Q))::NNI
       (P, Q) := (Q, pseudoRemainder(P, -Q))
       repeat
          -- P = S_{c-1} ~ S_d , Q = S_{d-1},  s = lc(S_d),  i < d
          (degP, degQ) := (degree(P), degree(Q))
          i = degP-1 => return Q
          zero?(Q) or (i > degQ) => return 0
          Z : polR := LazardQuotient2(Q, LC(Q), s, (degP - degQ)::NNI)
          --  Z = S_e ~ S_d-1
          i = degQ => return Z
          (P, Q) := (Q, next_sousResultant2(P, Q, Z, s))
          s := LC(Z)

    indiceSubResultantEuclidean(P : polR, Q : polR, i : NNI) :
                    Record(coef1 : polR, coef2 : polR, subResultant : polR) ==
       zero?(Q) or zero?(P) => construct(0::polR, 0::polR, 0::polR)
       if degree(P) < degree(Q) then
          e := if odd?(degree(P)-i) and odd?(degree(Q)-i) then -1 else 1
          l := indiceSubResultantEuclidean(Q, e * P, i)
          return construct(e * l.coef2, l.coef1, l.subResultant)
       if i = degree(Q) then
          delta : NNI := (degree(P)-degree(Q))::NNI
          zero?(delta) =>
                      error("indiceSubResultantEuclidean$PRS : bad degrees")
          s : R := LC(Q)^(delta-1)::NNI
          return construct(0::polR, s::polR, s * Q)
       i > degree(Q) => construct(0::polR, 0::polR, 0::polR)
       s : R := LC(Q)^(degree(P) - degree(Q))::NNI
       VP : Vector(polR) := [Q, 0::polR, 1::polR]
       pdiv := pseudoDivide(P, -Q)
       VQ : Vector(polR) := [pdiv.remainder, pdiv.coef::polR, pdiv.quotient]
       repeat
          --  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s=lc(S_d),  i < d
          --  S_{c-1} = VP.2 P_0 + VP.3 Q_0,  S_{d-1} = VQ.2 P_0 + VQ.3 Q_0
          (P, Q) := (VP.1, VQ.1)
          zero?(Q) => return construct(0::polR, 0::polR, 0::polR)
          (degP, degQ) := (degree(P), degree(Q))
          i = degP-1 => return construct(VQ.2, VQ.3, VQ.1)
          (i > degQ) => return construct(0::polR, 0::polR, 0::polR)
          VZ := Lazard3(VQ, LC(Q), s, (degP - degQ)::NNI)
          i = degQ => return construct(VZ.2, VZ.3, VZ.1)
          ss : R := LC(VZ.1)
          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
          s := ss

    semiIndiceSubResultantEuclidean(P : polR, Q : polR, i : NNI) :
                    Record(coef2 : polR, subResultant : polR) ==
       zero?(Q) or zero?(P) => construct(0::polR, 0::polR)
       degree(P) < degree(Q) =>
                  error("semiIndiceSubResultantEuclidean$PRS : bad degrees")
       if i = degree(Q) then
          delta : NNI := (degree(P)-degree(Q))::NNI
          zero?(delta) =>
                  error("semiIndiceSubResultantEuclidean$PRS : bad degrees")
          s : R := LC(Q)^(delta-1)::NNI
          return construct(s::polR, s * Q)
       i > degree(Q) => construct(0::polR, 0::polR)
       s : R := LC(Q)^(degree(P) - degree(Q))::NNI
       VP : Vector(polR) := [Q, 1::polR]
       pdiv := pseudoDivide(P, -Q)
       VQ : Vector(polR) := [pdiv.remainder, pdiv.quotient]
       repeat
          --  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s = lc(S_d),  i < d
          --  S_{c-1} = ...P_0 + VP.2 Q_0,  S_{d-1} = ...P_0 + ...Q_0
          (P, Q) := (VP.1, VQ.1)
          zero?(Q) => return construct(0::polR, 0::polR)
          (degP, degQ) := (degree(P), degree(Q))
          i = degP-1 => return construct(VQ.2, VQ.1)
          (i > degQ) => return construct(0::polR, 0::polR)
          VZ := Lazard3(VQ, LC(Q), s, (degP - degQ)::NNI)
          i = degQ => return construct(VZ.2, VZ.1)
          ss : R := LC(VZ.1)
          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
          s := ss

    degreeSubResultant(P : polR, Q : polR, i : NNI) : polR ==
       zero?(Q) or zero?(P) => 0
       if degree(P) < degree(Q) then (P, Q) := (Q, P)
       if i = degree(Q) then
          delta : NNI := (degree(P)-degree(Q))::NNI
          zero?(delta) => error("degreeSubResultant$PRS : bad degrees")
          s : R := LC(Q)^(delta-1)::NNI
          return s*Q
       i > degree(Q) => 0
       s : R := LC(Q)^(degree(P) - degree(Q))::NNI
       (P, Q) := (Q, pseudoRemainder(P, -Q))
       repeat
          -- P = S_{c-1},  Q = S_{d-1},  s = lc(S_d)
          zero?(Q) or (i > degree(Q)) => return 0
          i = degree(Q) => return Q
          Z : polR := LazardQuotient2(Q, LC(Q), s, (degree(P) - degree(Q))::NNI)
          --  Z = S_e ~ S_d-1
          (P, Q) := (Q, next_sousResultant2(P, Q, Z, s))
          s := LC(Z)

    degreeSubResultantEuclidean(P : polR, Q : polR, i : NNI) :
                     Record(coef1 : polR, coef2 : polR, subResultant : polR) ==
       zero?(Q) or zero?(P) => construct(0::polR, 0::polR, 0::polR)
       if degree(P) < degree(Q) then
          l := degreeSubResultantEuclidean(Q, P, i)
          return construct(l.coef2, l.coef1, l.subResultant)
       if i = degree(Q) then
          delta : NNI := (degree(P)-degree(Q))::NNI
          zero?(delta) =>
                      error("degreeSubResultantEuclidean$PRS : bad degrees")
          s : R := LC(Q)^(delta-1)::NNI
          return construct(0::polR, s::polR, s * Q)
       i > degree(Q) => construct(0::polR, 0::polR, 0::polR)
       s : R := LC(Q)^(degree(P) - degree(Q))::NNI
       VP : Vector(polR) := [Q, 0::polR, 1::polR]
       pdiv := pseudoDivide(P, -Q)
       VQ : Vector(polR) := [pdiv.remainder, pdiv.coef::polR, pdiv.quotient]
       repeat
          --  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s=lc(S_d)
          --  S_{c-1} = ...P_0 + VP.3 Q_0,  S_{d-1} = ...P_0 + VQ.3 Q_0
          (P, Q) := (VP.1, VQ.1)
          zero?(Q) or (i > degree(Q)) =>
               return construct(0::polR, 0::polR, 0::polR)
          i = degree(Q) => return construct(VQ.2, VQ.3, VQ.1)
          ss : R := LazardQuotient(LC(Q), s, (degree(P)-degree(Q))::NNI)
          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
          s := ss

    semiDegreeSubResultantEuclidean(P : polR, Q : polR, i : NNI) :
                     Record(coef2 : polR, subResultant : polR) ==
       zero?(Q) or zero?(P) => construct(0::polR, 0::polR)
       degree(P) < degree(Q) =>
                  error("semiDegreeSubResultantEuclidean$PRS : bad degrees")
       if i = degree(Q) then
          delta : NNI := (degree(P)-degree(Q))::NNI
          zero?(delta) =>
                  error("semiDegreeSubResultantEuclidean$PRS : bad degrees")
          s : R := LC(Q)^(delta-1)::NNI
          return construct(s::polR, s * Q)
       i > degree(Q) => construct(0::polR, 0::polR)
       s : R := LC(Q)^(degree(P) - degree(Q))::NNI
       VP : Vector(polR) := [Q, 1::polR]
       pdiv := pseudoDivide(P, -Q)
       VQ : Vector(polR) := [pdiv.remainder, pdiv.quotient]
       repeat
          --  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s=lc(S_d)
          --  S_{c-1} = ...P_0 + VP.3 Q_0,  S_{d-1} = ...P_0 + VQ.3 Q_0
          (P, Q) := (VP.1, VQ.1)
          zero?(Q) or (i > degree(Q)) =>
               return construct(0::polR, 0::polR)
          i = degree(Q) => return construct(VQ.2, VQ.1)
          ss : R := LazardQuotient(LC(Q), s, (degree(P)-degree(Q))::NNI)
          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
          s := ss

    lastSubResultant(P : polR, Q : polR) : polR ==
       zero?(Q) or zero?(P) => 0
       if degree(P) < degree(Q) then (P, Q) := (Q, P)
       zero?(degree(Q)) => (LC(Q)^degree(P))::polR
       s : R := LC(Q)^(degree(P) - degree(Q))::NNI
       (P, Q) := (Q, pseudoRemainder(P, -Q))
       Z : polR := P
       repeat
          -- Z = S_d  (except the first turn : Z = P)
          -- P = S_{c-1} ~ S_d,  Q = S_{d-1},  s = lc(S_d)
          zero?(Q) => return Z
          Z := LazardQuotient2(Q, LC(Q), s, (degree(P) - degree(Q))::NNI)
          -- Z = S_e ~ S_{d-1}
          zero?(degree(Z)) => return Z
          (P, Q) := (Q, next_sousResultant2(P, Q, Z, s))
          s := LC(Z)

    lastSubResultantEuclidean(P : polR, Q : polR) :
                    Record(coef1 : polR, coef2 : polR, subResultant : polR) ==
       zero?(Q) or zero?(P) => construct(0::polR, 0::polR, 0::polR)
       if degree(P) < degree(Q) then
          l := lastSubResultantEuclidean(Q, P)
          return construct(l.coef2, l.coef1, l.subResultant)
       if zero?(degree(Q)) then
          degP : NNI := degree(P)
          zero?(degP) =>
              error("lastSubResultantEuclidean$PRS : constant polynomials")
          s : R := LC(Q)^(degP-1)::NNI
          return construct(0::polR, s::polR, s * Q)
       s : R := LC(Q)^(degree(P) - degree(Q))::NNI
       VP : Vector(polR) := [Q, 0::polR, 1::polR]
       pdiv := pseudoDivide(P, -Q)
       VQ : Vector(polR) := [pdiv.remainder, pdiv.coef::polR, pdiv.quotient]
       VZ : Vector(polR) := copy(VP)
       repeat
          --  VZ.1 = S_d,  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s = lc(S_d)
          --  S_{c-1} = VP.2 P_0 + VP.3 Q_0
          --  S_{d-1} = VQ.2 P_0 + VQ.3 Q_0
          --  S_d     = VZ.2 P_0 + VZ.3 Q_0
          (Q, Z) := (VQ.1, VZ.1)
          zero?(Q) => return construct(VZ.2, VZ.3, VZ.1)
          VZ := Lazard3(VQ, LC(Q), s, (degree(Z) - degree(Q))::NNI)
          zero?(degree(Q)) => return construct(VZ.2, VZ.3, VZ.1)
          ss : R := LC(VZ.1)
          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
          s := ss

    semiLastSubResultantEuclidean(P : polR, Q : polR) :
                    Record(coef2 : polR, subResultant : polR) ==
       zero?(Q) or zero?(P) => construct(0::polR, 0::polR)
       degree(P) < degree(Q) =>
              error("semiLastSubResultantEuclidean$PRS : bad degrees")
       if zero?(degree(Q)) then
          degP : NNI := degree(P)
          zero?(degP) =>
              error("semiLastSubResultantEuclidean$PRS : constant polynomials")
          s : R := LC(Q)^(degP-1)::NNI
          return construct(s::polR, s * Q)
       s : R := LC(Q)^(degree(P) - degree(Q))::NNI
       VP : Vector(polR) := [Q, 1::polR]
       pdiv := pseudoDivide(P, -Q)
       VQ : Vector(polR) := [pdiv.remainder, pdiv.quotient]
       VZ : Vector(polR) := copy(VP)
       repeat
          --  VZ.1 = S_d,  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s = lc(S_d)
          --  S_{c-1} = ... P_0 + VP.2 Q_0
          --  S_{d-1} = ... P_0 + VQ.2 Q_0
          --  S_d     = ... P_0 + VZ.2 Q_0
          (Q, Z) := (VQ.1, VZ.1)
          zero?(Q) => return construct(VZ.2, VZ.1)
          VZ := Lazard3(VQ, LC(Q), s, (degree(Z) - degree(Q))::NNI)
          zero?(degree(Q)) => return construct(VZ.2, VZ.1)
          ss : R := LC(VZ.1)
          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
          s := ss

    chainSubResultants(P : polR, Q : polR) : List(polR) ==
       zero?(Q) or zero?(P) => []
       if degree(P) < degree(Q) then
          (P, Q) := (Q, P)
          if odd?(degree(P)) and odd?(degree(Q)) then Q := - Q
       L : List(polR) := []
       zero?(degree(Q)) => L
       L := [Q]
       s : R := LC(Q)^(degree(P) - degree(Q))::NNI
       (P, Q) := (Q, pseudoRemainder(P, -Q))
       repeat
          -- P = S_{c-1},  Q = S_{d-1},  s = lc(S_d)
          -- L = [S_d, ...., S_{q-1}]
          zero?(Q) => return L
          L := concat(Q, L)
          -- L = [S_{d-1}, ...., S_{q-1}]
          delta : NNI := (degree(P) - degree(Q))::NNI
          Z : polR := LazardQuotient2(Q, LC(Q), s, delta)            -- Z = S_e ~ S_d-1
          if delta > 1 then L := concat(Z, L)
          -- L = [S_e, ...., S_{q-1}]
          zero?(degree(Z)) => return L
          (P, Q) := (Q, next_sousResultant2(P, Q, Z, s))
          s := LC(Z)

    schema(P : polR, Q : polR) : List(NNI) ==
       zero?(Q) or zero?(P) => []
       if degree(P) < degree(Q) then (P, Q) := (Q, P)
       zero?(degree(Q)) => [0]
       L : List(NNI) := []
       s : R := LC(Q)^(degree(P) - degree(Q))::NNI
       (P, Q) := (Q, pseudoRemainder(P, Q))
       repeat
          -- P = S_{c-1} ~ S_d,  Q = S_{d-1},  s = lc(S_d)
          zero?(Q) => return L
          e : NNI := degree(Q)
          L := concat(e, L)
          delta : NNI := (degree(P) - e)::NNI
          Z : polR := LazardQuotient2(Q, LC(Q), s, delta)            -- Z = S_e ~ S_d-1
          if delta > 1 then L := concat(e, L)
          zero?(e) => return L
          (P, Q) := (Q, next_sousResultant2(P, Q, Z, s))
          s := LC(Z)

    subResultantGcd(P : polR, Q : polR) : polR ==
       zero?(P) and zero?(Q) => 0
       zero?(P) => Q
       zero?(Q) => P
       if degree(P) < degree(Q) then (P, Q) := (Q, P)
       zero?(degree(Q)) => 1$polR
       s : R := LC(Q)^(degree(P) - degree(Q))::NNI
       (P, Q) := (Q, pseudoRemainder(P, -Q))
       repeat
          -- P = S_{c-1},  Q = S_{d-1},  s = lc(S_d)
          zero?(Q) => return P
          zero?(degree(Q)) => return 1$polR
          Z : polR := LazardQuotient2(Q, LC(Q), s, (degree(P) - degree(Q))::NNI)
          -- Z = S_e ~ S_d-1
          (P, Q) := (Q, next_sousResultant2(P, Q, Z, s))
          s := LC(Z)

    subResultantGcdEuclidean(P : polR, Q : polR) :
                    Record(coef1 : polR, coef2 : polR, gcd : polR) ==
       zero?(P) and zero?(Q) => construct(0::polR, 0::polR, 0::polR)
       zero?(P) => construct(0::polR, 1::polR, Q)
       zero?(Q) => construct(1::polR, 0::polR, P)
       if degree(P) < degree(Q) then
          l := subResultantGcdEuclidean(Q, P)
          return construct(l.coef2, l.coef1, l.gcd)
       zero?(degree(Q)) => construct(0::polR, 1::polR, Q)
       s : R := LC(Q)^(degree(P) - degree(Q))::NNI
       VP : Vector(polR) := [Q, 0::polR, 1::polR]
       pdiv := pseudoDivide(P, -Q)
       VQ : Vector(polR) := [pdiv.remainder, pdiv.coef::polR, pdiv.quotient]
       repeat
          --  VP.1 = S_{c-1},  VQ.1 = S_{d-1},  s=lc(S_d)
          --  S_{c-1} = VP.2 P_0 + VP.3 Q_0,  S_{d-1} = VQ.2 P_0 + VQ.3 Q_0
          (P, Q) := (VP.1, VQ.1)
          zero?(Q) => return construct(VP.2, VP.3, P)
          e : NNI := degree(Q)
          zero?(e) => return construct(VQ.2, VQ.3, Q)
          ss := LazardQuotient(LC(Q), s, (degree(P) - e)::NNI)
          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
          s := ss

    semiSubResultantGcdEuclidean2(P : polR, Q : polR) :
                                  Record(coef2 : polR, gcd : polR) ==
       zero?(P) and zero?(Q) => construct(0::polR, 0::polR)
       zero?(P) => construct(1::polR, Q)
       zero?(Q) => construct(0::polR, P)
       degree(P) < degree(Q) =>
                       error("semiSubResultantGcdEuclidean2$PRS : bad degrees")
       zero?(degree(Q)) => construct(1::polR, Q)
       s : R := LC(Q)^(degree(P) - degree(Q))::NNI
       VP : Vector(polR) := [Q, 1::polR]
       pdiv := pseudoDivide(P, -Q)
       VQ : Vector(polR) := [pdiv.remainder, pdiv.quotient]
       repeat
          --  P=S_{c-1},  Q=S_{d-1},  s=lc(S_d)
          --  S_{c-1} = ? P_0 + old_cf2 Q_0,  S_{d-1} = ? P_0 + cf2 Q_0
          (P, Q) := (VP.1, VQ.1)
          zero?(Q) => return construct(VP.2, P)
          e : NNI := degree(Q)
          zero?(e) => return construct(VQ.2, Q)
          ss := LazardQuotient(LC(Q), s, (degree(P) - e)::NNI)
          (VP, VQ) := (VQ, next_sousResultant3(VP, VQ, s, ss))
          s := ss

    semiSubResultantGcdEuclidean1(P : polR, Q : polR) :
                       Record(coef1 : polR, gcd : polR) ==
       result := subResultantGcdEuclidean(P, Q)
       [result.coef1, result.gcd]

    discriminant(P : polR) : R ==
       d : Integer := degree(P)
       zero?(d) => error "cannot take discriminant of constants"
       a : Integer := (d * (d-1)) quo 2
       a := (-1)^a::NonNegativeInteger
       dP : polR := differentiate P
       r : R := resultant(P, dP)
       d := d - degree(dP) - 1
       return (if zero?(d) then a * (r exquo LC(P))::R
               else a * r * LC(P)^(d-1)::NNI)

    discriminantEuclidean(P : polR) :
                       Record(coef1 : polR, coef2 : polR, discriminant : R) ==
       d : Integer := degree(P)
       zero?(d) => error "cannot take discriminant of constants"
       a : Integer := (d * (d-1)) quo 2
       a := (-1)^a::NonNegativeInteger
       dP : polR := differentiate P
       rE := resultantEuclidean(P, dP)
       d := d - degree(dP) - 1
       if zero?(d) then
          c1 : polR := a * (rE.coef1 exquo LC(P))::polR
          c2 : polR := a * (rE.coef2 exquo LC(P))::polR
          cr : R := a * (rE.resultant exquo LC(P))::R
       else
          c1 : polR := a * rE.coef1 * LC(P)^(d-1)::NNI
          c2 : polR := a * rE.coef2 * LC(P)^(d-1)::NNI
          cr : R := a * rE.resultant * LC(P)^(d-1)::NNI
       return construct(c1, c2, cr)

    semiDiscriminantEuclidean(P : polR) :
                            Record(coef2 : polR, discriminant : R) ==
       d : Integer := degree(P)
       zero?(d) => error "cannot take discriminant of constants"
       a : Integer := (d * (d-1)) quo 2
       a := (-1)^a::NonNegativeInteger
       dP : polR := differentiate P
       rE := semiResultantEuclidean2(P, dP)
       d := d - degree(dP) - 1
       if zero?(d) then
          c2 : polR := a * (rE.coef2 exquo LC(P))::polR
          cr : R := a * (rE.resultant exquo LC(P))::R
       else
          c2 : polR := a * rE.coef2 * LC(P)^(d-1)::NNI
          cr : R := a * rE.resultant * LC(P)^(d-1)::NNI
       return construct(c2, cr)

    if R has GcdDomain then
       resultantReduit(P : polR, Q : polR) : R ==
          UV := subResultantGcdEuclidean(P, Q)
          UVs : polR := UV.gcd
          degree(UVs) > 0 => 0
          l : List(R) := concat(coefficients(UV.coef1), coefficients(UV.coef2))
          return (LC(UVs) exquo gcd(l))::R

       resultantReduitEuclidean(P : polR, Q : polR) :
                     Record(coef1 : polR, coef2 : polR, resultantReduit : R) ==
          UV := subResultantGcdEuclidean(P, Q)
          UVs : polR := UV.gcd
          degree(UVs) > 0 => construct(0::polR, 0::polR, 0::R)
          l : List(R) := concat(coefficients(UV.coef1), coefficients(UV.coef2))
          gl : R := gcd(l)
          c1 : polR := (UV.coef1 exquo gl)::polR
          c2 : polR := (UV.coef2 exquo gl)::polR
          rr : R := (LC(UVs) exquo gl)::R
          return construct(c1, c2, rr)

       semiResultantReduitEuclidean(P : polR, Q : polR) :
                                   Record(coef2 : polR, resultantReduit : R) ==
          UV := subResultantGcdEuclidean(P, Q)
          UVs : polR := UV.gcd
          degree(UVs) > 0 => construct(0::polR, 0::R)
          l : List(R) := concat(coefficients(UV.coef1), coefficients(UV.coef2))
          gl : R := gcd(l)
          c2 : polR := (UV.coef2 exquo gl)::polR
          rr : R := (LC(UVs) exquo gl)::R
          return construct(c2, rr)

       gcd_naif(P : polR, Q : polR) : polR ==
       -- valid over a field
          zero?(P) => (Q exquo LC(Q))::polR
          repeat
             zero?(Q) => return (P exquo LC(P))::polR
             zero?(degree(Q)) => return 1$polR
             (P, Q) := (Q, divide(P, Q).remainder)

       if R has FiniteFieldCategory then

           gcd(P : polR, Q : polR) : polR == gcd_naif(P, Q)

       else

           gcd(P : polR, Q : polR) : polR ==
               zero?(P) => Q
               zero?(Q) => P
               cP : R := content(P)
               cQ : R := content(Q)
               P := (P exquo cP)::polR
               Q := (Q exquo cQ)::polR
               G : polR := subResultantGcd(P, Q)
               gcd(cP, cQ) * primitivePart(G)

--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.
