path: root/src/algebra/primelt.spad.pamphlet

\documentclass{article}
\usepackage{open-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)]
      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
        positive? degree(p, v) 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
          not one? degree(p := univariate(u::P, v)) => 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, 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 =>
          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}