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

)abbrev package NPCOEF NPCoef
++ Author : P.Gianni, revised May 1990
++ Description: 
++ Package for the determination of the coefficients in the lifting
++ process. Used by \spadtype{MultivariateLifting}.
++ This package will work for every euclidean domain R which has property
++ F, i.e. there exists a factor operation in \spad{R[x]}.
NPCoef(BP,E,OV,R,P) : C == T where
 
 OV   :   OrderedSet
 E    :   OrderedAbelianMonoidSup
 R    :   EuclideanDomain  -- with property "F"
 BP   :   UnivariatePolynomialCategory R
 P    :   PolynomialCategory(R,E,OV)
 
 Z       ==> Integer
 NNI     ==> NonNegativeInteger
 USP     ==> SparseUnivariatePolynomial(P)
 Term    ==> Record(expt:NNI,pcoef:P)
 Detc    ==> Record(valexp:NNI,valcoef:P,posit:NNI)
 VTerm   ==> List(Term)
 DetCoef ==> Record(deter:List(USP),dterm:List(VTerm),
                    nfacts:List(BP),nlead:List(P))
 TermC   ==> Record(coefu:P,detfacts:List(VTerm))
 TCoef   ==> List(TermC)
 
 C == with
      npcoef   :    (USP,List(BP),List(P))      ->   DetCoef
	++ npcoef \undocumented
      listexp  :              BP                ->   List(NNI)
	++ listexp \undocumented
 T == add
 
                 ----   Local  Functions  ----
  check      : (TermC,Vector P) -> Union(Detc,"failed")
  buildvect  : (List(VTerm),NNI) -> Vector(List(VTerm))
  buildtable : (Vector(P),List(List NNI),List P) -> TCoef
  modify : (TCoef,Detc) -> TCoef 
  constructp : VTerm -> USP

  npcoef(u:USP,factlist:List(BP),leadlist:List(P)) :DetCoef ==
    detcoef:List(VTerm):=empty();detufact:List(USP):=empty()
    lexp:List(List(NNI)):=[listexp(v) for v in factlist]
    ulist :Vector(P):=vector [coefficient(u,i) for i in 0..degree u]
    tablecoef:=buildtable(ulist,lexp,leadlist)
    detcoef:=[[[ep.first,lcu]$Term]  for ep in lexp for lcu in leadlist]
    ldtcf:=detcoef
    lexp:=[ep.rest for ep in lexp]
    ndet:NNI:=#factlist
    changed:Boolean:=true
    ltochange:List(NNI):=empty()
    ltodel:List(NNI):=empty()
    while changed and not one? ndet repeat
      changed :=false
      dt:=#tablecoef
      for i in 1..dt while not changed repeat
        (cf:=check(tablecoef.i,ulist)) case "failed" => "next i"
        ltochange:=cons(i,ltochange)
        celtf:Detc:=cf::Detc
        tablecoef:=modify(tablecoef,celtf)
        vpos:=celtf.posit
        vexp:=celtf.valexp
        nterm:=[vexp,celtf.valcoef]$Term
        detcoef.vpos:=cons(nterm,detcoef.vpos)
        lexp.vpos:=delete(lexp.vpos,position(vexp,lexp.vpos))
        if lexp.vpos=[] then
         ltodel:=cons(vpos,ltodel)
         ndet:=(ndet-1):NNI
         detufact:=cons(constructp(detcoef.vpos),detufact)
        changed:=true
      for i in ltochange repeat tablecoef:=delete(tablecoef,i)
      ltochange:=[]
    if ndet=1 then
     uu:=u exquo */[pol for pol in detufact]
     if uu case "failed" then return
       [empty(),ldtcf,factlist,leadlist]$DetCoef
     else  detufact:=cons(uu::USP,detufact)
    else
      ltodel:=sort(#1>#2,ltodel)
      for i in ltodel repeat
        detcoef:=delete(detcoef,i)
        factlist:=delete(factlist,i)
        leadlist:=delete(leadlist,i)
    [detufact,detcoef,factlist,leadlist]$DetCoef
 
 
  check(tterm:TermC,ulist:Vector(P)) : Union(Detc,"failed") ==
    cfu:P:=1$P;doit:NNI:=0;poselt:NNI:=0;pp:Union(P,"failed")
    termlist:List(VTerm):=tterm.detfacts
    vterm:VTerm:=empty()
    #termlist=1 =>
      vterm:=termlist.first
      for elterm in vterm while doit<2 repeat
        not zero?(cu1:=elterm.pcoef) => cfu:=cu1*cfu
        doit:=doit+1
        poselt:=position(elterm,vterm):NNI
      doit=2  or (pp:=tterm.coefu exquo cfu) case "failed" => "failed"
      [vterm.poselt.expt,pp::P,poselt]$Detc
    "failed"
 
  buildvect(lvterm:List(VTerm),n:NNI) : Vector(List(VTerm)) ==
    vtable:Vector(List(VTerm)):=new(n,empty())
    (#lvterm)=1 =>
      for term in lvterm.first repeat vtable.(term.expt+1):=[[term]]
      vtable
 
    vtable:=buildvect(lvterm.rest,n)
    ntable:Vector(List(VTerm)):=new(n,empty())
    for term in lvterm.first repeat
      nexp:=term.expt
      for i in 1..n while (nexp+i)<(n+1) repeat
        ntable.(nexp+i):=append(
                            [cons(term,lvterm) for lvterm in vtable.i],
                               ntable.(nexp+i))
    ntable
 
  buildtable(vu:Vector(P),lvect:List(List(NNI)),leadlist:List(P)):TCoef==
    nfact:NNI:=#leadlist
    table:TCoef:=empty()
    degu:=(#vu-1)::NNI
    prelim:List(VTerm):=[[[e,0$P]$Term for e in lv] for lv in lvect]
    for i in 1..nfact repeat prelim.i.first.pcoef:=leadlist.i
    partialv:Vector(List(VTerm)):=new(nfact,empty())
    partialv:=buildvect(prelim,degu)
    for i in 1..degu repeat
      empty? partialv.i => "next i"
      table:=cons([vu.i,partialv.i]$TermC, table)
    table
 
  modify(tablecoef:TCoef,cfter:Detc) : TCoef ==
    cfexp:=cfter.valexp;cfcoef:=cfter.valcoef;cfpos:=cfter.posit
    lterase:List(NNI):=empty()
    for cterm in tablecoef | not empty?(ctdet:=cterm.detfacts) repeat
      (+/[term.expt for term in ctdet.first])<cfexp => "next term"
      for celt in ctdet repeat
        if celt.cfpos.expt=cfexp then
          celt.cfpos.pcoef:=cfcoef
          if (and/[not zero? cc.pcoef for cc in celt]) then
            k:=position(celt,ctdet):NNI
            lterase:=cons(k,lterase)
            cterm.coefu:=(cterm.coefu - */[cc.pcoef for cc in celt])
      if not empty? lterase then
        lterase:=sort(#1>#2,lterase)
        for i in lterase repeat ctdet:=delete(ctdet,i)
        cterm.detfacts:=ctdet
        lterase:=empty()
    tablecoef
 
  listexp(up:BP) :List(NNI) ==
    degree up=0 => [0]
    [degree up,:listexp(reductum up)]
 
  constructp(lterm:VTerm):USP ==
    +/[monomial(term.pcoef,term.expt) for term in lterm]

