)abbrev package MLIFT MultivariateLifting
++ Author : P.Gianni.
++ Description:
++ This package provides the functions for the multivariate "lifting", using
++ an algorithm of Paul Wang.
++ This package will work for every euclidean domain R which has property
++ F, i.e. there exists a factor operation in \spad{R[x]}.

MultivariateLifting(E, OV, R, P) : C == T
 where
  OV        :   OrderedSet
  E         :   OrderedAbelianMonoidSup
  R         :   IntegralDomain  -- with property "F"
  Z         ==> Integer
  BP        ==> SparseUnivariatePolynomial R
  P         :   PolynomialCategory(R, E, OV)
  SUP       ==> SparseUnivariatePolynomial P
  NNI       ==> NonNegativeInteger
  Term      ==> Record(expt : NNI, pcoef : P)
  VTerm     ==> List Term
  Table     ==> Vector List BP
  L         ==> List
  SF        ==> BP -> Union(L BP, "failed")
  SFF       ==> L BP -> Union(SF, "failed")

  C == with
    corrPoly : (SUP, L OV, L R, L NNI, L SUP, SF) -> Union(L SUP, "failed")
        ++ corrPoly(u, lv, lr, ln, lu, bsolv) solves polynomial equation
        ++ system u/f = sum(ai/lu(i)) where f is product of lu(i) and
        ++ deg(ai) < deg(lu(i)) using modular method.  corrPoly returns
        ++ "failed" if there are no solution.  lv is list of variables,
        ++ lr is list of corresponding evaluation points, bsolv is
        ++ solver over R specialized for modular images of lu.
    lifting : (SUP, L OV, L BP, L R, L P, L NNI, SFF) -> Union(L SUP, "failed")
        ++ lifting(u, lv, lu, lr, lp, ln, gen_solv) lifts univariate
        ++ factorization, returning recovered factors or "failed" in
        ++ case of bad reduction.
        ++ u is multivariate polynomial to factor, lu is list
        ++ of univariate factors, lv is list of variables, ln
        ++ is list of degrees corresponding to variables,
        ++ lr is list of evaluation points,
        ++ lp is list of leading coefficients of factors if known,
        ++ empty otherwise,  gen_solv delivers solver for
        ++ polynomial equations
    if R has EuclideanDomain then
        lifting : (SUP, L OV, L BP, L R, L P, L NNI, R) ->
                   Union(L SUP, "failed")
           ++ lifting(u, lv, lu, lr, lp, ln, r) is
           ++ lifting(u, lv, lu, lr, lp, ln, solv(r)) where
           ++ solv(r) is solver using reduction modulo r
           ++ and lifting.  Memberes of lu must be relatively
           ++ prime modulo r

  T == add

    import from NPCoef(BP, E, OV, R, P)
    import from IntegerCombinatoricFunctions(Z)

    SUPF2   ==> SparseUnivariatePolynomialFunctions2

    DetCoef ==> Record(deter : L SUP, dterm : L VTerm, nfacts : L BP,
                       nlead : L P)

              ---   local functions   ---
    normalDerivM    :    (P, Z, OV)     ->  P
    normalDeriv     :     (SUP, Z)     ->  SUP
    subslead        :     (SUP, P)     ->  SUP
    subscoef        :   (SUP, L Term)  ->  SUP
    maxDegree       :   (SUP, OV)      ->  NonNegativeInteger


    corrPoly(m : SUP, lvar : L OV, fval : L R, ld : L NNI, flist : L SUP,
             bsolv : SF):Union(L SUP,"failed") ==
      --  The correction coefficients are evaluated recursively.
      --   Extended Euclidean algorithm for the multivariate case.

      -- the polynomial is univariate  --
      #lvar = 0 =>
        lp := bsolv(map(ground, m)$SUPF2(P, R))
        if lp case "failed" then return "failed"
        lcoef := [map(coerce, mp)$SUPF2(R, P) for mp in lp@L(BP)]

      diff, ddiff, pol, polc : SUP
      listpolv, listcong : L SUP
      deg1 : NNI := ld.first
      np : NNI := #flist
      a : P := fval.first ::P
      y : OV := lvar.first
      lvar := lvar.rest
      listpolv : L SUP := [map((p1 : P) : P +-> eval(p1, y, a), f1)
                             for f1 in flist]
      um := map((p1 : P) : P +-> eval(p1, y, a), m)
      flcoef := corrPoly(um, lvar, fval.rest, ld.rest, listpolv, bsolv)
      if flcoef case "failed" then return "failed"
      else lcoef := flcoef@L(SUP)
      listcong := [*/[flist.i for i in 1..np | i ~= l] for l in 1..np]
      polc : SUP := (monomial(1, y, 1) - a)::SUP
      pol := 1$SUP
      diff := m- +/[lcoef.i*listcong.i for i in 1..np]
      for l in 1..deg1 repeat
        if diff = 0 then return lcoef
        pol := pol*polc
        ddiff := map((p1: P): P +-> eval(normalDerivM(p1,l,y),y,a),diff)
        ddiff = 0 => "next l"
        fbeta := corrPoly(ddiff, lvar, fval.rest, ld.rest, listpolv, bsolv)
        if fbeta case "failed" then return "failed"
        else beta := fbeta@L(SUP)
        lcoef := [lcoef.i+beta.i*pol  for i in 1..np]
        diff := diff- +/[listcong.i*beta.i for i in 1..np]*pol
      lcoef


    lifting1(m : SUP, lvar : L OV, plist : L SUP, vlist : L R, tlist : L P, _
             coeflist : L VTerm, listdeg : L NNI, bsolv : SF
            ) : Union(L SUP,"failed") ==
    -- The factors of m (multivariate) are determined ,
    -- We suppose to know the true univariate factors
    -- some coefficients are determined
      conglist : L SUP := empty()
      nvar : NNI := #lvar
      pol, polc : P
      mc, mj : SUP
      testp : Boolean := (not empty?(tlist))
      lalpha : L SUP := empty()
      tlv : L P := empty()
      subsvar : L OV := empty()
      subsval : L R := empty()
      li : L OV := lvar
      ldeg : L NNI := empty()
      clv : L VTerm := empty()
      --j =#variables, i=#factors
      for j in 1..nvar repeat
        x  := li.first
        li := rest li
        conglist := plist
        v := vlist.first
        vlist := rest vlist
        degj := listdeg.j
        ldeg := cons(degj, ldeg)
        subsvar := cons(x, subsvar)
        subsval := cons(v, subsval)

      --substitute the determined coefficients
        if testp then
          if j<nvar then
            tlv := [eval(p, li, vlist) for p in tlist]
            clv := [[[term.expt, eval(term.pcoef, li, vlist)]$Term
                   for term in clist] for clist  in coeflist]
          else (tlv, clv) := (tlist, coeflist)
          plist := [subslead(p, lcp) for p in plist for lcp in tlv]
          if not(empty? coeflist) then
            plist := [subscoef(tpol, clist)
                   for tpol in plist for clist in clv]
        -- m(x1, .., xj, aj+1, .., an
        mj := map((p1 : P) : P +-> eval(p1, li, vlist), m)
        polc := x::P - v::P  --(xj-aj)
        pol := 1$P
      --Construction of Rik, k in 1..right degree for xj+1
        for k in 1..degj repeat  --I can exit before
         pol := pol*polc
         mc := */[term for term in plist]-mj
         if mc = 0 then break
         --Modulus Dk
         mc := map((p1 : P) : P +-> normalDerivM(p1, k, x), mc)
         (mc := map((p1: P): P +-> eval(p1,[x],[v]),mc))=0 => "next k"
         flalpha := corrPoly(mc, subsvar.rest, subsval.rest,
                          ldeg.rest, conglist, bsolv)
         if flalpha case "failed" then return "failed"
         else lalpha := flalpha@L(SUP)
         plist := [term-alpha*pol for term in plist for alpha in lalpha]
        -- PGCD may call with a smaller valure of degj
        idegj : Integer := maxDegree(m, x)
        for term in plist repeat idegj := idegj -maxDegree(term, x)
        idegj < 0 => return "failed"
      plist
        --There are not extraneous factors

    maxDegree(um : SUP, x : OV) : NonNegativeInteger ==
       ans : NonNegativeInteger := 0
       while um ~= 0 repeat
          ans := max(ans, degree(leadingCoefficient um, x))
          um := reductum um
       ans

    lifting(um : SUP, lvar : L OV, plist : L BP, vlist : L R, tlist : L P,
            listdeg : L NNI, gen_solv : SFF) : Union(L SUP,"failed") ==
    -- The factors of m (multivariate) are determined, when the
    --  univariate true factors are known and some coefficient determined
      nplist : List SUP := [map(coerce, pp)$SUPF2(R, P) for pp in plist]
      listdet : L SUP := []
      coeflist: L VTerm := []
      if not(empty? tlist) then
          ldcoef : DetCoef := npcoef(um, plist, tlist)
          if not empty?(listdet := ldcoef.deter) then
              if #listdet = #plist  then return listdet
              plist := ldcoef.nfacts
              nplist := [map(coerce, pp)$SUPF2(R, P) for pp in plist]
              um := (um exquo */[pol for pol in listdet])::SUP
              tlist := ldcoef.nlead
              coeflist := ldcoef.dterm
      sfu := gen_solv(plist)
      sfu case "failed" => "failed"
      ffl := lifting1(um, lvar, nplist, vlist, tlist, coeflist, listdeg,
                      sfu::SF)
      if ffl case "failed" then return "failed"
      -- FIXME: this may require sorting the result!
      append(listdet, ffl@L(SUP))

    if R has EuclideanDomain then

       import from GenExEuclid(R, BP)

       gen_solv(plist : L BP, pmod : R) : Union(SF, "failed") ==
           ldeg : L NNI := [degree(p)$BP for p in plist]
           du := reduce(_+, ldeg)
           tab := tablePow(du, pmod, plist)
           tab case "failed" => "failed"
           table : Table := tab
           (b : BP) : Union(L BP, "failed") +-> solveid(b, pmod, table)

       lifting(um : SUP, lvar : L OV, plist : L BP, vlist : L R, tlist : L P,
               listdeg : L NNI, pmod : R):Union(L SUP, "failed") ==
           lifting(um, lvar, plist, vlist, tlist, listdeg,
                   (lb : L BP) : Union(SF, "failed") +-> gen_solv(lb, pmod))

    -- normalDerivM(f, m, x) = the normalized (divided by m!) m-th
    -- derivative with respect to x of the multivariate polynomial f
    normalDerivM(g : P, m : Z, x : OV) : P ==
     multivariate(normalDeriv(univariate(g, x), m), x)

    normalDeriv(f : SUP, m : Z) : SUP ==
     (n1 : Z := degree f) < m => 0$SUP
     n1 = m => leadingCoefficient f :: SUP
     k := binomial(n1, m)
     ris : SUP := 0$SUP
     n : Z := n1
     while n>= m repeat
       while n1>n repeat
         k := (k*(n1-m)) quo n1
         n1 := n1-1
       ris := ris+monomial(k*leadingCoefficient f, (n-m)::NNI)
       f := reductum f
       n := degree f
     ris

    subslead(m : SUP, pol : P) : SUP ==
      dm : NNI := degree m
      monomial(pol, dm)+reductum m

    subscoef(um : SUP, lterm : L Term) : SUP ==
      dm : NNI := degree um
      new := monomial(leadingCoefficient um, dm)
      for k in dm-1..0 by -1 repeat
        i : NNI := k::NNI
        empty?(lterm) or lterm.first.expt ~= i =>
                                new := new+monomial(coefficient(um, i), i)
        new := new+monomial(lterm.first.pcoef, i)
        lterm := lterm.rest
      new

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