open-axiom repository from github
\documentclass{article}
\usepackage{open-axiom}
\begin{document}
\title{src/algebra algext.spad}
\author{Barry Trager, Manuel Bronstein, Clifton Williamson}
\maketitle
\begin{abstract}
\end{abstract}
\tableofcontents
\eject
\section{domain SAE SimpleAlgebraicExtension}
<<domain SAE SimpleAlgebraicExtension>>=
import UnivariatePolynomialCategory
import MonogenicAlgebra
)abbrev domain SAE SimpleAlgebraicExtension
++ Algebraic extension of a ring by a single polynomial
++ Author: Barry Trager, Manuel Bronstein, Clifton Williamson
++ Date Created: 1986
++ Date Last Updated: 9 May 1994
++ Description:
++ Domain which represents simple algebraic extensions of arbitrary
++ rings. The first argument to the domain, R, is the underlying ring,
++ the second argument is a domain of univariate polynomials over K,
++ while the last argument specifies the defining minimal polynomial.
++ The elements of the domain are canonically represented as polynomials
++ of degree less than that of the minimal polynomial with coefficients
++ in R. The second argument is both the type of the third argument and
++ the underlying representation used by \spadtype{SAE} itself.
++ Keywords: ring, algebraic, extension
++ Example: )r SAE INPUT
SimpleAlgebraicExtension(R:CommutativeRing,
UP:UnivariatePolynomialCategory R, M:UP): MonogenicAlgebra(R, UP) == add
--sqFr(pb): FactorS(Poly) from UnivPolySquareFree(Poly)
--degree(M) > 0 and M must be monic if R is not a field.
if (r := recip leadingCoefficient M) case "failed" then
error "Modulus cannot be made monic"
Rep := UP
x,y :$
c: R
mkDisc : Boolean -> Void
mkDiscMat: Boolean -> Void
M := r::R * M
d := degree M
d1 := subtractIfCan(d,1)::NonNegativeInteger
discmat:Matrix(R) := zero(d, d)
nodiscmat?:Reference(Boolean) := ref true
disc:Reference(R) := ref 0
nodisc?:Reference(Boolean) := ref true
bsis := [monomial(1, i)$Rep for i in 0..d1]$Vector(Rep)
if R has Finite then
size == size()$R ** d
random == represents([random()$R for i in 0..d1])
0 == 0$Rep
1 == 1$Rep
c * x == c *$Rep x
n:Integer * x == n *$Rep x
coerce(n:Integer):$ == coerce(n)$Rep
coerce(c) == monomial(c,0)$Rep
coerce(x):OutputForm == coerce(x)$Rep
lift(x) == x pretend Rep
reduce(p:UP):$ == (monicDivide(p,M)$Rep).remainder
x = y == x =$Rep y
x + y == x +$Rep y
- x == -$Rep x
x * y == reduce((x *$Rep y) pretend UP)
coordinates(x) == [coefficient(lift(x),i) for i in 0..d1]
represents(vect) == +/[monomial(vect.(i+1),i) for i in 0..d1]
definingPolynomial() == M
characteristic == characteristic$R
rank() == d::PositiveInteger
basis() == copy(bsis@Vector(Rep) pretend Vector($))
--!! I inserted 'copy' in the definition of 'basis' -- cjw 7/19/91
if R has Field then
minimalPolynomial x == squareFreePart characteristicPolynomial x
if R has Field then
coordinates(x:$,bas: Vector $) ==
(m := inverse transpose coordinates bas) case "failed" =>
error "coordinates: second argument must be a basis"
(m :: Matrix R) * coordinates(x)
else if R has IntegralDomain then
coordinates(x:$,bas: Vector $) ==
-- we work over the quotient field of R to invert a matrix
qf := Fraction R
imatqf := InnerMatrixQuotientFieldFunctions(R,Vector R,Vector R,_
Matrix R,qf,Vector qf,Vector qf,Matrix qf)
mat := transpose coordinates bas
(m := inverse(mat)$imatqf) case "failed" =>
error "coordinates: second argument must be a basis"
coordsQF := map(#1 :: qf,coordinates x)$VectorFunctions2(R,qf)
-- here are the coordinates as elements of the quotient field:
vecQF := (m :: Matrix qf) * coordsQF
vec : Vector R := new(d,0)
for i in 1..d repeat
xi := qelt(vecQF,i)
denom(xi) = 1 => qsetelt!(vec,i,numer xi)
error "coordinates: coordinates are not integral over ground ring"
vec
reducedSystem(m:Matrix $):Matrix(R) ==
reducedSystem(map(lift, m)$MatrixCategoryFunctions2($, Vector $,
Vector $, Matrix $, UP, Vector UP, Vector UP, Matrix UP))
reducedSystem(m:Matrix $, v:Vector $):Record(mat:Matrix R,vec:Vector R) ==
reducedSystem(map(lift, m)$MatrixCategoryFunctions2($, Vector $,
Vector $, Matrix $, UP, Vector UP, Vector UP, Matrix UP),
map(lift, v)$VectorFunctions2($, UP))
discriminant() ==
if deref nodisc? then mkDisc false
deref disc
mkDisc b ==
setref(nodisc?,b)
setref(disc,discriminant M)
traceMatrix() ==
if deref nodiscmat? then mkDiscMat false
discmat
mkDiscMat b ==
setref(nodiscmat?,b)
mr := minRowIndex discmat; mc := minColIndex discmat
for i in 0..d1 repeat
for j in 0..d1 repeat
qsetelt!(discmat,mr + i,mc + j,trace reduce monomial(1,i + j))
trace x == --this could be coded perhaps more efficiently
xn := x; ans := coefficient(lift xn, 0)
for n in 1..d1 repeat
(xn := generator() * xn; ans := coefficient(lift xn, n) + ans)
ans
if R has Finite then
index k ==
i:Integer := k rem size()
p:Integer := size()$R
ans:$ := 0
for j in 0.. while positive? i repeat
h := i rem p
-- index(p) = 0$R
if h ~= 0 then
-- here was a bug: "index" instead of
-- "coerce", otherwise it wouldn't work for
-- Rings R where "coerce: I-> R" is not surjective
a := index(h :: PositiveInteger)$R
ans := ans + reduce monomial(a, j)
i := i quo p
ans
lookup(z : $) : PositiveInteger ==
-- z = index lookup z, n = lookup index n
-- the answer is merely the Horner evaluation of the
-- representation with the size of R (as integers).
zero?(z) => size()$% pretend PositiveInteger
p : Integer := size()$R
co : Integer := lookup(leadingCoefficient z)$R
n : NonNegativeInteger := degree(z)
while not zero?(z := reductum z) repeat
co := co * p ** ((n - (n := degree z)) pretend
NonNegativeInteger) + lookup(leadingCoefficient z)$R
n = 0 => co pretend PositiveInteger
(co * p ** n) pretend PositiveInteger
--
-- KA:=BasicPolynomialFunctions(Poly)
-- minPoly(x) ==
-- ffe:= SqFr(resultant(M::KA, KA.var - lift(x)::KA)).fs.first
-- ffe.flag = "SQFR" => ffe.f
-- mdeg:= (degree(ffe.f) // K.characteristic)::Integer
-- mat:= Zero()::Matrix<mdeg+1,deg+mdeg+1>(K)
-- xi:=L.1; setelt(mat,1,1,K.1); setelt(mat,1,(deg+1),K.1)
-- for i in 1..mdeg repeat
-- xi:= x * xi; xp:= lift(xi)
-- while xp ~= KA.0 repeat
-- setelt(mat,(mdeg+1),(degree(xp)+1),LeadingCoef(xp))
-- xp:=reductum(xp)
-- setelt(mat,(mdeg+1),(deg+i+1),K.1)
-- EchelonLastRow(mat)
-- if and/(elt(mat,(i+1),j) = K.0 for j in 1..deg)
-- then return unitNormal(+/(elt(mat,(i+1),(deg+j+1))*(B::KA)**j
-- for j in 0..i)).a
-- ffe.f
@
\section{License}
<<license>>=
--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
--Copyright (C) 2007-2010, Gabriel Dos Reis.
--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 SAE SimpleAlgebraicExtension>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}