diff options
author | dos-reis <gdr@axiomatics.org> | 2007-08-14 05:14:52 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2007-08-14 05:14:52 +0000 |
commit | ab8cc85adde879fb963c94d15675783f2cf4b183 (patch) | |
tree | c202482327f474583b750b2c45dedfc4e4312b1d /src/algebra/mlift.spad.pamphlet | |
download | open-axiom-ab8cc85adde879fb963c94d15675783f2cf4b183.tar.gz |
Initial population.
Diffstat (limited to 'src/algebra/mlift.spad.pamphlet')
-rw-r--r-- | src/algebra/mlift.spad.pamphlet | 277 |
1 files changed, 277 insertions, 0 deletions
diff --git a/src/algebra/mlift.spad.pamphlet b/src/algebra/mlift.spad.pamphlet new file mode 100644 index 00000000..4ec8d14c --- /dev/null +++ b/src/algebra/mlift.spad.pamphlet @@ -0,0 +1,277 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/algebra mlift.spad} +\author{Patrizia Gianni} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +\section{package MLIFT MultivariateLifting} +<<package MLIFT MultivariateLifting>>= +)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 : EuclideanDomain -- 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 + + C == with + corrPoly: (SUP,L OV,L R,L NNI,L SUP,Table,R) -> Union(L SUP,"failed") + ++ corrPoly(u,lv,lr,ln,lu,t,r) \undocumented + 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) \undocumented + lifting1: (SUP,L OV,L SUP,L R,L P,L VTerm,L NNI,Table,R) -> + Union(L SUP,"failed") + ++ lifting1(u,lv,lu,lr,lp,lt,ln,t,r) \undocumented + + T == add + GenExEuclid(R,BP) + NPCoef(BP,E,OV,R,P) + 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, + table:Table,pmod:R):Union(L SUP,"failed") == + -- The correction coefficients are evaluated recursively. + -- Extended Euclidean algorithm for the multivariate case. + + -- the polynomial is univariate -- + #lvar=0 => + lp:=solveid(map(ground,m)$SUPF2(P,R),pmod,table) + 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(eval(#1,y,a),f1) for f1 in flist] + um:=map(eval(#1,y,a),m) + flcoef:=corrPoly(um,lvar,fval.rest,ld.rest,listpolv,table,pmod) + 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(eval(normalDerivM(#1,l,y),y,a),diff)) = 0 => "next l" + fbeta := corrPoly(ddiff,lvar,fval.rest,ld.rest,listpolv,table,pmod) + 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,table:Table,pmod:R) :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] + mj := map(eval(#1,li,vlist),m) --m(x1,..,xj,aj+1,..,an + 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 leave "next var" + --Modulus Dk + mc:=map(normalDerivM(#1,k,x),mc) + (mc := map(eval(#1,[x],[v]),mc))=0 => "next k" + flalpha:=corrPoly(mc,subsvar.rest,subsval.rest, + ldeg.rest,conglist,table,pmod) + 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,pmod:R):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] + empty? tlist => + table:=tablePow(degree um,pmod,plist) + table case "failed" => error "Table construction failed in MLIFT" + lifting1(um,lvar,nplist,vlist,tlist,empty(),listdeg,table,pmod) + 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 + tab:=tablePow(degree um,pmod,plist.rest) + else tab:=tablePow(degree um,pmod,plist) + tab case "failed" => error "Table construction failed in MLIFT" + table:Table:=tab + ffl:=lifting1(um,lvar,nplist,vlist,tlist,ldcoef.dterm,listdeg,table,pmod) + if ffl case "failed" then return "failed" + append(listdet,ffl:: L SUP) + + -- 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 + +@ +\section{License} +<<license>>= +--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. +@ +<<*>>= +<<license>> + +<<package MLIFT MultivariateLifting>> +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document} |