Initial population.

1 files changed, 269 insertions, 0 deletions

diff --git a/src/algebra/primelt.spad.pamphlet b/src/algebra/primelt.spad.pamphlet
new file mode 100644
index 00000000..baee4e62
--- /dev/null
+++ b/src/algebra/primelt.spad.pamphlet
@@ -0,0 +1,269 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/algebra primelt.spad}
+\author{Manuel Bronstein}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{package PRIMELT PrimitiveElement}
+<<package PRIMELT PrimitiveElement>>=
+)abbrev package PRIMELT PrimitiveElement
+++ Computation of primitive elements.
+++ Author: Manuel Bronstein
+++ Date Created: 6 Jun 1990
+++ Date Last Updated: 25 April 1991
+++ Description:
+++   PrimitiveElement provides functions to compute primitive elements
+++   in algebraic extensions;
+++ Keywords: algebraic, extension, primitive.
+PrimitiveElement(F): Exports == Implementation where
+  F : Join(Field, CharacteristicZero)
+
+  SY  ==> Symbol
+  P   ==> Polynomial F
+  UP  ==> SparseUnivariatePolynomial F
+  RC  ==> Record(coef1: Integer, coef2: Integer, prim:UP)
+  REC ==> Record(coef: List Integer, poly:List UP, prim: UP)
+
+  Exports ==> with
+    primitiveElement: (P, SY, P, SY) -> RC
+      ++ primitiveElement(p1, a1, p2, a2) returns \spad{[c1, c2, q]}
+      ++ such that \spad{k(a1, a2) = k(a)}
+      ++ where \spad{a = c1 a1 + c2 a2, and q(a) = 0}.
+      ++ The pi's are the defining polynomials for the ai's.
+      ++ The p2 may involve a1, but p1 must not involve a2.
+      ++ This operation uses \spadfun{resultant}.
+    primitiveElement: (List P, List SY) -> REC
+      ++ primitiveElement([p1,...,pn], [a1,...,an]) returns
+      ++ \spad{[[c1,...,cn], [q1,...,qn], q]}
+      ++ such that then \spad{k(a1,...,an) = k(a)},
+      ++ where \spad{a = a1 c1 + ... + an cn},
+      ++ \spad{ai = qi(a)}, and \spad{q(a) = 0}.
+      ++ The pi's are the defining polynomials for the ai's.
+      ++ This operation uses the technique of
+      ++ \spadglossSee{groebner bases}{Groebner basis}.
+    primitiveElement: (List P, List SY, SY) -> REC
+      ++ primitiveElement([p1,...,pn], [a1,...,an], a) returns
+      ++ \spad{[[c1,...,cn], [q1,...,qn], q]}
+      ++ such that then \spad{k(a1,...,an) = k(a)},
+      ++ where \spad{a = a1 c1 + ... + an cn},
+      ++ \spad{ai = qi(a)}, and \spad{q(a) = 0}.
+      ++ The pi's are the defining polynomials for the ai's.
+      ++ This operation uses the technique of
+      ++ \spadglossSee{groebner bases}{Groebner basis}.
+
+  Implementation ==> add
+    import PolyGroebner(F)
+
+    multi     : (UP, SY) -> P
+    randomInts: (NonNegativeInteger, NonNegativeInteger) -> List Integer
+    findUniv  : (List P, SY, SY) -> Union(P, "failed")
+    incl?     : (List SY, List SY) -> Boolean
+    triangularLinearIfCan:(List P,List SY,SY) -> Union(List UP,"failed")
+    innerPrimitiveElement: (List P, List SY, SY) -> REC
+
+    multi(p, v)            == multivariate(map(#1, p), v)
+    randomInts(n, m)       == [symmetricRemainder(random()$Integer, m) for i in 1..n]
+    incl?(a, b)            == every?(member?(#1, b), a)
+    primitiveElement(l, v) == primitiveElement(l, v, new()$SY)
+
+    primitiveElement(p1, a1, p2, a2) ==
+--      one? degree(p2, a1) => [0, 1, univariate resultant(p1, p2, a1)]
+      (degree(p2, a1) = 1) => [0, 1, univariate resultant(p1, p2, a1)]
+      u := (new()$SY)::P
+      b := a2::P
+      for i in 10.. repeat
+        c := symmetricRemainder(random()$Integer, i)
+        w := u - c * b
+        r := univariate resultant(eval(p1, a1, w), eval(p2, a1, w), a2)
+        not zero? r and r = squareFreePart r => return [1, c, r]
+
+    findUniv(l, v, opt) ==
+      for p in l repeat
+        degree(p, v) > 0 and incl?(variables p, [v, opt]) => return p
+      "failed"
+
+    triangularLinearIfCan(l, lv, w) ==
+      (u := findUniv(l, w, w)) case "failed" => "failed"
+      pw := univariate(u::P)
+      ll := nil()$List(UP)
+      for v in lv repeat
+        ((u := findUniv(l, v, w)) case "failed") or
+          (degree(p := univariate(u::P, v)) ^= 1) => return "failed"
+        (bc := extendedEuclidean(univariate leadingCoefficient p, pw,1))
+           case "failed" => error "Should not happen"
+        ll := concat(map(#1,
+                (- univariate(coefficient(p,0)) * bc.coef1) rem pw), ll)
+      concat(map(#1, pw), reverse_! ll)
+
+    primitiveElement(l, vars, uu) ==
+      u    := uu::P
+      vv   := [v::P for v in vars]
+      elim := concat(vars, uu)
+      w    := uu::P
+      n    := #l
+      for i in 10.. repeat
+        cf := randomInts(n, i)
+        (tt := triangularLinearIfCan(lexGroebner(
+             concat(w - +/[c * t for c in cf for t in vv], l), elim),
+                vars, uu)) case List(UP) =>
+                   ltt := tt::List(UP)
+                   return([cf, rest ltt, first ltt])
+
+@
+\section{package FSPRMELT FunctionSpacePrimitiveElement}
+<<package FSPRMELT FunctionSpacePrimitiveElement>>=
+)abbrev package FSPRMELT FunctionSpacePrimitiveElement
+++ Computation of primitive elements.
+++ Author: Manuel Bronstein
+++ Date Created: 6 Jun 1990
+++ Date Last Updated: 25 April 1991
+++ Description:
+++   FunctionsSpacePrimitiveElement provides functions to compute
+++   primitive elements in functions spaces;
+++ Keywords: algebraic, extension, primitive.
+FunctionSpacePrimitiveElement(R, F): Exports == Implementation where
+  R: Join(IntegralDomain, OrderedSet, CharacteristicZero)
+  F: FunctionSpace R
+
+  SY  ==> Symbol
+  P   ==> Polynomial F
+  K   ==> Kernel F
+  UP  ==> SparseUnivariatePolynomial F
+  REC ==> Record(primelt:F, poly:List UP, prim:UP)
+
+  Exports ==> with
+    primitiveElement: List F -> Record(primelt:F, poly:List UP, prim:UP)
+      ++ primitiveElement([a1,...,an]) returns \spad{[a, [q1,...,qn], q]}
+      ++ such that then \spad{k(a1,...,an) = k(a)},
+      ++ \spad{ai = qi(a)}, and \spad{q(a) = 0}.
+      ++ This operation uses the technique of
+      ++ \spadglossSee{groebner bases}{Groebner basis}.
+    if F has AlgebraicallyClosedField then
+      primitiveElement: (F,F)->Record(primelt:F,pol1:UP,pol2:UP,prim:UP)
+        ++ primitiveElement(a1, a2) returns \spad{[a, q1, q2, q]}
+        ++ such that \spad{k(a1, a2) = k(a)},
+        ++ \spad{ai = qi(a)}, and \spad{q(a) = 0}.
+        ++ The minimal polynomial for a2 may involve a1, but the
+        ++ minimal polynomial for a1 may not involve a2;
+        ++ This operations uses \spadfun{resultant}.
+
+  Implementation ==> add
+    import PrimitiveElement(F)
+    import AlgebraicManipulations(R, F)
+    import PolynomialCategoryLifting(IndexedExponents K,
+                            K, R, SparseMultivariatePolynomial(R, K), P)
+
+    F2P: (F, List SY) -> P
+    K2P: (K, List SY) -> P
+
+    F2P(f, l) == inv(denom(f)::F) * map(K2P(#1, l), #1::F::P, numer f)
+
+    K2P(k, l) ==
+      ((v := symbolIfCan k) case SY) and member?(v::SY, l) => v::SY::P
+      k::F::P
+
+    primitiveElement l ==
+      u    := string(uu := new()$SY)
+      vars := [concat(u, string i)::SY for i in 1..#l]
+      vv   := [kernel(v)$K :: F for v in vars]
+      kers := [retract(a)@K for a in l]
+      pols := [F2P(subst(ratDenom((minPoly k) v, kers), kers, vv), vars)
+                                              for k in kers for v in vv]
+      rec := primitiveElement(pols, vars, uu)
+      [+/[c * a for c in rec.coef for a in l], rec.poly, rec.prim]
+
+    if F has AlgebraicallyClosedField then
+      import PolynomialCategoryQuotientFunctions(IndexedExponents K,
+                            K, R, SparseMultivariatePolynomial(R, K), F)
+
+      F2UP: (UP, K, UP) -> UP
+      getpoly: (UP, F) -> UP
+
+      F2UP(p, k, q) ==
+        ans:UP := 0
+        while not zero? p repeat
+          f   := univariate(leadingCoefficient p, k)
+          ans := ans + ((numer f) q)
+                       * monomial(inv(retract(denom f)@F), degree p)
+          p   := reductum p
+        ans
+
+      primitiveElement(a1, a2) ==
+        a   := (aa := new()$SY)::F
+        b   := (bb := new()$SY)::F
+        l   := [aa, bb]$List(SY)
+        p1  := minPoly(k1 := retract(a1)@K)
+        p2  := map(subst(ratDenom(#1, [k1]), [k1], [a]),
+                                                 minPoly(retract(a2)@K))
+        rec := primitiveElement(F2P(p1 a, l), aa, F2P(p2 b, l), bb)
+        w   := rec.coef1 * a1 + rec.coef2 * a2
+        g   := rootOf(rec.prim)
+        zero?(rec.coef1) =>
+          c2g := inv(rec.coef2 :: F) * g
+          r := gcd(p1, univariate(p2 c2g, retract(a)@K, p1))
+          q := getpoly(r, g)
+          [w, q, rec.coef2 * monomial(1, 1)$UP, rec.prim]
+        ic1 := inv(rec.coef1 :: F)
+        gg  := (ic1 * g)::UP - monomial(rec.coef2 * ic1, 1)$UP
+        kg  := retract(g)@K
+        r   := gcd(p1 gg, F2UP(p2, retract(a)@K, gg))
+        q   := getpoly(r, g)
+        [w, monomial(ic1, 1)$UP - rec.coef2 * ic1 * q, q, rec.prim]
+
+      getpoly(r, g) ==
+--        one? degree r =>
+        (degree r = 1) =>
+          k := retract(g)@K
+          univariate(-coefficient(r,0)/leadingCoefficient r,k,minPoly k)
+        error "GCD not of degree 1"
+
+@
+\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 PRIMELT PrimitiveElement>>
+<<package FSPRMELT FunctionSpacePrimitiveElement>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}