)abbrev package GENPGCD GeneralPolynomialGcdPackage
++ Description:
++ This package provides operations for GCD computations
++ on polynomials
GeneralPolynomialGcdPackage(E, OV, R, P) : C == T where
    R     :  PolynomialFactorizationExplicit
    P     :  PolynomialCategory(R, E, OV)
    OV    :  OrderedSet
    E     :  OrderedAbelianMonoidSup

    SUPP      ==> SparseUnivariatePolynomial P

    C == with
           gcdPolynomial     :   (SUPP, SUPP) -> SUPP
                ++ gcdPolynomial(p, q) returns the GCD of p and q
           randomR        : ()                ->R
                ++ randomR() should be local but conditional

    T == add

      SUPR     ==> SparseUnivariatePolynomial R
      B ==> Boolean

      import from UnivariatePolynomialCategoryFunctions2(R, SUPR, P, SUPP)
      import from UnivariatePolynomialCategoryFunctions2(P, SUPP, R, SUPR)
                 --------  Local  Functions  --------

      better          :    (P, P)     -> Boolean

      lift : (SUPR, SUPP, SUPR, P, List OV, List R) -> Union(SUPP, "failed")
         -- lifts first and third arguments as factors of the second
         -- fourth is gcd of leading coefficients.

      monomContentSup   :    SUPP    -> SUPP

      gcd_monomial : (SUPP, SUPP) -> SUPP

      gcdTrivial      :  (SUPP, SUPP)   -> SUPP
      gcdSameVariables : (SUPP, SUPP, B, B, List OV) -> SUPP
      recursivelyGCDCoefficients : (SUPP, List OV, SUPP, List OV) -> SUPP
      flatten         : (SUPP, List OV) -> SUPP
                        -- evaluates out all variables in the second
                        -- argument, leaving a polynomial of the same
                        -- degree
      variables       :  SUPP          -> List OV
                     ---- JHD's exported functions ---
      gcdPolynomial(p1 : SUPP, p2 : SUPP) ==
        zero? p1 => p2
        zero? p2 => p1
        0 = degree p1  => gcdTrivial(p1, p2)
        0 = degree p2  => gcdTrivial(p2, p1)
        if degree p1 < degree p2 then (p1, p2) := (p2, p1)
        p1 exquo p2 case SUPP  => (unitNormal p2).canonical
        c1 := monomContentSup(p1)
        c2 := monomContentSup(p2)
        p1 := (p1 exquo c1)::SUPP
        p2 := (p2 exquo c2)::SUPP
        cg := gcd_monomial(c1, c2)
        if degree p1 < degree p2 then (p1, p2) := (p2, p1)
        (p1 exquo p2) case SUPP => (unitNormal p2).canonical * cg
        vp1 := variables p1
        vp2 := variables p2
        v1 := setDifference(vp1, vp2)
        v2 := setDifference(vp2, vp1)
        empty?(v1) and empty?(v2) =>
            gcdSameVariables(p1, p2, true, true, vp1)*cg
                 -- all variables are in common
        v := setDifference(vp1, v1)
        pp1 := flatten(p1, v1)
        pp2 := flatten(p2, v2)
        g := gcdSameVariables(pp1, pp2, empty?(v1), empty?(v2), v)
        (g = 1) => cg
        (empty?(v1) or not (p1 exquo g) case "failed") and
                     -- if #vi = 0 then pp1 = p1, so we know g divides
              (empty?(v2) or not (p2 exquo g) case "failed")
            => g*cg  -- divdes them both, so is the gcd
        -- OK, so it's not the gcd: try again
        v := variables g -- there can be at most these variables in answer
        v1 := setDifference(vp1, v)
        v2 := setDifference(vp2, v)
        h :=
            empty?(v1) => flatten(p2, v2)
            empty?(v2) => flatten(p1, v1)
            flatten(p1, v1) - flatten(p2, v2)
        g := gcdSameVariables(h, g, false, true, v)
        (g = 1) => cg
        (empty?(v1) or not (p1 exquo g) case "failed") and
              (empty?(v2) or not (p2 exquo g) case "failed")
            => g*cg  -- divdes them both, so is the gcd
        v := variables g -- there can be at most these variables in answer
        v1 := setDifference(vp1, v)
        if empty?(v1) then
           g := recursivelyGCDCoefficients(g, v, p1, v1)
           (g = 1) => return cg
           v := variables g -- there can be at most these variables in answer
        v2 := setDifference(vp2, v)
        recursivelyGCDCoefficients(g, v, p2, v2)*cg

      if R has StepThrough then
         randomCount : R := init()
         randomR() ==
            (v := nextItem(randomCount)) case R =>
                randomCount := v
                v
            SAY("Taking next stepthrough range in GeneralPolynomialGcdPackage")$Lisp
            randomCount := init()
            randomCount
      else
-- FIXME: strange random distribution used (#227).
            randomR() == (random(100)$Integer)::R

                     ---- JHD's local functions ---
      gcdSameVariables(p1 : SUPP, p2 : SUPP, prim1 : B, prim2 : B,
                       lv : List OV) : SUPP ==
            -- two non-trivial polynomials, we return primitive
            -- part of gcd
          #lv = 0 => map(coerce@(R->P), gcdPolynomial(map(ground, p1),
                                             map(ground, p2)))
          if degree(p1) > degree(p2) then
              (p1, p2) := (p2, p1)
              (prim1, prim2) := (prim2, prim1)
          degree p1 = 1 =>
              if not(prim1) then p1 := (p1 exquo content(p1))::SUPP
              p2 exquo p1 case SUPP => p1
              1
          gcdLC := gcd(leadingCoefficient p1, leadingCoefficient p2)
          count : NonNegativeInteger := 0
          good_cnt : NonNegativeInteger := 0
          v : SUPR
          dv : NonNegativeInteger
          while count<10 repeat
            lr := [randomR() for vv in lv]
            count := count + 1
            while zero? eval(gcdLC, lv, lr) and count<10 repeat
                  lr := [randomR() for vv in lv]
                  count := count+1
            count = 10 => error "too many evaluations in GCD code"
            up1 : SUPR := map(x +-> ground eval(x, lv, lr), p1)
            up2 : SUPR := map(x +-> ground eval(x, lv, lr), p2)
            u := gcdPolynomial(up1, up2)
            (du := degree(u)) = 0 => return 1
            -- we want two consistent evaluations
            good_cnt = 0 =>
                good_cnt := 1
                v := u
                dv := du
            dv < du => "iterate"
            du < dv =>
                good_cnt := 1
                v := u
                dv := du
            du = degree(p1) =>
                if not(prim1) then
                    p1 := (p1 exquo content(p1))::SUPP
                    prim1 := true
                p2 exquo p1 case SUPP => return p2
                "next"
            up1 := (up1 exquo u)::SUPR
            degree gcd(u, up1) = 0 =>
                ans := lift(u, p1, up1, gcdLC, lv, lr)
                ans case SUPP => return ans
                "next"
            up2 := (up2 exquo u)::SUPR
            degree gcd(u, up2) = 0 =>
                ans := lift(u, p2, up2, gcdLC, lv, lr)
                ans case SUPP => return ans
                "next"
            -- so neither cofactor is relatively prime
            count := 0
            while count < 10 repeat
               r := randomR()
               uu := up1+r*up2
               degree gcd(u, uu)=0 =>
                 ans := lift(u, p1 + r::P *p2, uu, gcdLC, lv, lr)
                 ans case SUPP => return ans
                 "next"
            error "too many evaluations in GCD code"
          count >= 10 => error "too many evaluations in GCD code"

      fix_lc(u : SUPR, lc : P, elc : R) : Union(SUPP, "failed") ==
          u1 := elc*u
          u1u := u1 exquo leadingCoefficient(u)
          u1u case "failed" => "failed"
          map(x +-> x::P, u1u::SUPR)

      lift(gR : SUPR, p : SUPP, cfR : SUPR, gcdLC : P, lv : List OV,
           lr : List R) ==
        -- lift the coprime factorisation gR*cfR = (univariate of p)
        -- where the variables lv have been evaluated at lr
        egcdLC := ground(eval(gcdLC, lv, lr))
        (gu := fix_lc(gR, gcdLC, egcdLC)) case "failed" => "failed"
        g := gu::SUPP
        lcp := leadingCoefficient p
        elcp := ground(eval(lcp, lv, lr))
        (cfu := fix_lc(cfR, lcp, elcp)) case "failed" => "failed"
        cf := cfu::SUPP
        p := gcdLC*p       -- impose leading coefficient of p on each factor
        while lv ~= [] repeat
           v := first lv
           r := first lr
           lv := rest lv
           lr := rest lr
           thisp := map(x +-> eval(x, lv, lr), p)
           d := "max"/[degree(c,v) for c in coefficients p]
           prime := v::P - r::P
           pn := prime
           origFactors := [g, cf]::List SUPP
           g := monomial(eval(gcdLC, lv, lr), degree(g)) + reductum(g)
           cf := monomial(eval(lcp, lv, lr), degree(cf)) + reductum(cf)
           for n in 1..d repeat
              Ecart := (thisp- g*cf) exquo pn
              Ecart case "failed" =>
                 error "failed lifting in hensel in Complex Polynomial GCD"
              zero? Ecart => break
              step := solveLinearPolynomialEquation(origFactors,
                                                  map(x +-> eval(x, v, r), Ecart::SUPP))
              step case "failed" => return "failed"
              g := g+pn*first step
              cf := cf+pn*second step
              pn := pn*prime
           thisp ~= g*cf => return "failed"
        gcdLC = 1 => g
        g exquo content(g)

      recursivelyGCDCoefficients(g : SUPP, v : List OV, p : SUPP, pv : List OV) ==
         mv := first pv   -- take each coefficient w.r.t. mv
         pv := rest pv    -- and recurse on pv as necessary
         d := "max"/[degree(u,mv) for u in coefficients p]
         for i in 0..d repeat
             p1 := map(x +-> coefficient(x, mv, i), p)
             oldg := g
             if pv = [] then g := gcdSameVariables(g, p1, true, false, v)
             else g := recursivelyGCDCoefficients(g, v, p1, pv)
             (g = 1) => return 1
             g ~= oldg =>
                oldv := v
                v := variables g
                pv := setUnion(pv, setDifference(v, oldv))
         g
      flatten(p1 : SUPP, lv : List OV) ==
         #lv = 0 => p1
         lr := [ randomR() for vv in lv]
         dg := degree p1
         while dg ~= degree (ans := map(x +-> eval(x, lv, lr), p1)) repeat
           lr := [ randomR() for vv in lv]
         ans
      variables(p1 : SUPP) ==
        removeDuplicates ("concat"/[variables u for u in coefficients p1])
      gcdTrivial(p1 : SUPP, p2 : SUPP) ==
        -- p1 is non-zero, but has degree zero
        -- p2 is non-zero
        cp1 := leadingCoefficient p1
        (cp1 = 1) => 1
        degree p2 = 0 => gcd(cp1, leadingCoefficient p2)::SUPP
        un? := unit? cp1
        while not zero? p2 and not un? repeat
           cp1 := gcd(leadingCoefficient p2, cp1)
           un? := unit? cp1
           p2 := reductum p2
        un? => 1
        cp1::SUPP

      gcd_monomial(p1 : SUPP, p2 : SUPP) ==
          monomial(gcd(leadingCoefficient(p1), leadingCoefficient(p2)),
                   min(degree(p1), degree(p2)))

      monomContentSup(u : SUPP) : SUPP ==
          md := minimumDegree u
          monomial(gcd(sort(better, coefficients u)), md)$SUPP

  -- Ordering for gcd purposes
      better(p1 : P, p2 : P) : Boolean ==
        ground? p1 => true
        ground? p2 => false
        degree(p1, mainVariable(p1)::OV) < degree(p2, mainVariable(p2)::OV)

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