Initial population.

1 files changed, 214 insertions, 0 deletions

diff --git a/src/algebra/gpol.spad.pamphlet b/src/algebra/gpol.spad.pamphlet
new file mode 100644
index 00000000..a4563b03
--- /dev/null
+++ b/src/algebra/gpol.spad.pamphlet
@@ -0,0 +1,214 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/algebra gpol.spad}
+\author{Manuel Bronstein}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{domain LAUPOL LaurentPolynomial}
+<<domain LAUPOL LaurentPolynomial>>=
+)abbrev domain LAUPOL LaurentPolynomial
+++ Univariate polynomials with negative and positive exponents.
+++ Author: Manuel Bronstein
+++ Date Created: May 1988
+++ Date Last Updated: 26 Apr 1990
+LaurentPolynomial(R, UP): Exports == Implementation where
+  R : IntegralDomain
+  UP: UnivariatePolynomialCategory R
+ 
+  O   ==> OutputForm
+  B   ==> Boolean
+  N   ==> NonNegativeInteger
+  Z   ==> Integer
+  RF  ==> Fraction UP
+ 
+  Exports ==> Join(DifferentialExtension UP, IntegralDomain,
+          ConvertibleTo RF, FullyRetractableTo R, RetractableTo UP) with
+    monomial?          : %  -> B
+	++ monomial?(x) \undocumented
+    degree             : %  -> Z
+	++ degree(x) \undocumented
+    order              : %  -> Z
+	++ order(x) \undocumented
+    reductum           : %  -> %
+	++ reductum(x) \undocumented
+    leadingCoefficient : %  -> R
+	++ leadingCoefficient \undocumented
+    trailingCoefficient: %  -> R
+	++ trailingCoefficient \undocumented
+    coefficient        : (%, Z) -> R
+	++ coefficient(x,n) \undocumented
+    monomial           : (R, Z) -> %
+	++ monomial(x,n) \undocumented
+    if R has CharacteristicZero then CharacteristicZero
+    if R has CharacteristicNonZero then CharacteristicNonZero
+    if R has Field then
+      EuclideanDomain
+      separate: RF -> Record(polyPart:%, fracPart:RF)
+	++ separate(x) \undocumented
+ 
+  Implementation ==> add
+    Rep := Record(polypart: UP, order0: Z)
+ 
+    poly   : %  -> UP
+    check0 : (Z, UP) -> %
+    mkgpol : (Z, UP) -> %
+    gpol   : (UP, Z) -> %
+    toutput: (R, Z, O) -> O
+    monTerm: (R, Z, O) -> O
+ 
+    0                == [0, 0]
+    1                == [1, 0]
+    p = q            == p.order0 = q.order0 and p.polypart = q.polypart
+    poly p           == p.polypart
+    order p          == p.order0
+    gpol(p, n)       == [p, n]
+    monomial(r, n)   == check0(n, r::UP)
+    coerce(p:UP):%   == mkgpol(0, p)
+    reductum p       == check0(order p, reductum poly p)
+    n:Z * p:%        == check0(order p, n * poly p)
+    characteristic() == characteristic()$R
+    coerce(n:Z):%    == n::R::%
+    degree p         == degree(poly p)::Z + order p
+    monomial? p      == monomial? poly p
+    coerce(r:R):%    == gpol(r::UP, 0)
+    convert(p:%):RF  == poly(p) * (monomial(1, 1)$UP)::RF ** order p
+    p:% * q:%        == check0(order p + order q, poly p * poly q)
+    - p              == gpol(- poly p, order p)
+    check0(n, p)     == (zero? p => 0; gpol(p, n))
+    trailingCoefficient p   == coefficient(poly p, 0)
+    leadingCoefficient p    == leadingCoefficient poly p
+ 
+    coerce(p:%):O ==
+      zero? p => 0::Z::O
+      l := nil()$List(O)
+      v := monomial(1, 1)$UP :: O
+      while p ^= 0 repeat
+        l := concat(l, toutput(leadingCoefficient p, degree p, v))
+        p := reductum p
+      reduce("+", l)
+ 
+    coefficient(p, n) ==
+      (m := n - order p) < 0 => 0
+      coefficient(poly p, m::N)
+ 
+    differentiate(p:%, derivation:UP -> UP) ==
+      t := monomial(1, 1)$UP
+      mkgpol(order(p) - 1,
+              derivation(poly p) * t + order(p) * poly(p) * derivation t)
+ 
+    monTerm(r, n, v) ==
+      zero? n => r::O
+--      one? n => v
+      (n = 1) => v
+      v ** (n::O)
+ 
+    toutput(r, n, v) ==
+      mon := monTerm(r, n, v)
+--      zero? n or one? r => mon
+      zero? n or (r = 1) => mon
+      r = -1 => - mon
+      r::O * mon
+ 
+    recip p ==
+      (q := recip poly p) case "failed" => "failed"
+      gpol(q::UP, - order p)
+ 
+    p + q ==
+      zero? q => p
+      zero? p => q
+      (d := order p - order q) > 0 =>
+                      gpol(poly(p) * monomial(1, d::N) + poly q, order q)
+      d < 0 => gpol(poly(p) + poly(q) * monomial(1, (-d)::N), order p)
+      mkgpol(order p, poly(p) + poly q)
+ 
+    mkgpol(n, p) ==
+      zero? p => 0
+      d := order(p, monomial(1, 1)$UP)
+      gpol((p exquo monomial(1, d))::UP, n + d::Z)
+ 
+    p exquo q ==
+      (r := poly(p) exquo poly q) case "failed" => "failed"
+      check0(order p - order q, r::UP)
+ 
+    retractIfCan(p:%):Union(UP, "failed") ==
+      order(p) < 0 => error "Not retractable"
+      poly(p) * monomial(1, order(p)::N)$UP
+ 
+    retractIfCan(p:%):Union(R, "failed") ==
+      order(p) ^= 0 => "failed"
+      retractIfCan poly p
+ 
+    if R has Field then
+      gcd(p, q) == gcd(poly p, poly q)::%
+ 
+      separate f ==
+        n  := order(q := denom f, monomial(1, 1))
+        q  := (q exquo (tn := monomial(1, n)$UP))::UP
+        bc := extendedEuclidean(tn,q,numer f)::Record(coef1:UP,coef2:UP)
+        qr := divide(bc.coef1, q)
+        [mkgpol(-n, bc.coef2 + tn * qr.quotient), qr.remainder / q]
+ 
+-- returns (z, r) s.t. p = q z + r,
+-- and degree(r) < degree(q), order(r) >= min(order(p), order(q))
+      divide(p, q) ==
+        c  := min(order p, order q)
+        qr := divide(poly(p) * monomial(1, (order p - c)::N)$UP, poly q)
+        [mkgpol(c - order q, qr.quotient), mkgpol(c, qr.remainder)]
+ 
+      euclideanSize p == degree poly p
+
+      extendedEuclidean(a, b, c) ==
+        (bc := extendedEuclidean(poly a, poly b, poly c)) case "failed"
+          => "failed"
+        [mkgpol(order c - order a, bc.coef1),
+                                     mkgpol(order c - order b, bc.coef2)]
+
+@
+\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>>
+
+<<domain LAUPOL LaurentPolynomial>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}