diff options
Diffstat (limited to 'src/algebra/catdef.spad.pamphlet')
| -rw-r--r-- | src/algebra/catdef.spad.pamphlet | 4565 |
1 files changed, 4565 insertions, 0 deletions
diff --git a/src/algebra/catdef.spad.pamphlet b/src/algebra/catdef.spad.pamphlet new file mode 100644 index 00000000..a6ec3810 --- /dev/null +++ b/src/algebra/catdef.spad.pamphlet @@ -0,0 +1,4565 @@ +\documentclass{article} +\usepackage{axiom} +\begin{document} +\title{\$SPAD/src/algebra catdef.spad} +\author{James Davenport, Lalo Gonzalez-Vega} +\maketitle +\begin{abstract} +\end{abstract} +\eject +\tableofcontents +\eject +\section{category ABELGRP AbelianGroup} +<<category ABELGRP AbelianGroup>>= +)abbrev category ABELGRP AbelianGroup +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The class of abelian groups, i.e. additive monoids where +++ each element has an additive inverse. +++ +++ Axioms: +++ \spad{-(-x) = x} +++ \spad{x+(-x) = 0} +-- following domain must be compiled with subsumption disabled +AbelianGroup(): Category == CancellationAbelianMonoid with + --operations + "-": % -> % ++ -x is the additive inverse of x. + "-": (%,%) -> % ++ x-y is the difference of x and y + ++ i.e. \spad{x + (-y)}. + -- subsumes the partial subtraction from previous + "*": (Integer,%) -> % ++ n*x is the product of x by the integer n. + add + (x:% - y:%):% == x+(-y) + subtractIfCan(x:%, y:%):Union(%, "failed") == (x-y) :: Union(%,"failed") + n:NonNegativeInteger * x:% == (n::Integer) * x + import RepeatedDoubling(%) + if not (% has Ring) then + n:Integer * x:% == + zero? n => 0 + n>0 => double(n pretend PositiveInteger,x) + double((-n) pretend PositiveInteger,-x) + +@ +\section{ABELGRP.lsp BOOTSTRAP} +{\bf ABELGRP} depends on a chain of +files. We need to break this cycle to build the algebra. So we keep a +cached copy of the translated {\bf ABELGRP} category which we can write +into the {\bf MID} directory. We compile the lisp code and copy the +{\bf ABELGRP.o} file to the {\bf OUT} directory. This is eventually +forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<ABELGRP.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |AbelianGroup;AL| (QUOTE NIL)) + +(DEFUN |AbelianGroup| NIL + (LET (#:G82664) + (COND + (|AbelianGroup;AL|) + (T (SETQ |AbelianGroup;AL| (|AbelianGroup;|)))))) + +(DEFUN |AbelianGroup;| NIL + (PROG (#1=#:G82662) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|CancellationAbelianMonoid|) + (|mkCategory| + (QUOTE |domain|) + (QUOTE ( + ((|-| (|$| |$|)) T) + ((|-| (|$| |$| |$|)) T) + ((|*| (|$| (|Integer|) |$|)) T))) + NIL + (QUOTE ((|Integer|))) + NIL)) + |AbelianGroup|) + (SETELT #1# 0 (QUOTE (|AbelianGroup|))))))) + +(MAKEPROP (QUOTE |AbelianGroup|) (QUOTE NILADIC) T) + +@ +\section{ABELGRP-.lsp BOOTSTRAP} +{\bf ABELGRP-} depends on a chain of files. +We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf ABELGRP-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf ABELGRP-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<ABELGRP-.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(DEFUN |ABELGRP-;-;3S;1| (|x| |y| |$|) + (SPADCALL |x| (SPADCALL |y| (QREFELT |$| 7)) (QREFELT |$| 8))) + +(DEFUN |ABELGRP-;subtractIfCan;2SU;2| (|x| |y| |$|) + (CONS 0 (SPADCALL |x| |y| (QREFELT |$| 10)))) + +(DEFUN |ABELGRP-;*;Nni2S;3| (|n| |x| |$|) + (SPADCALL |n| |x| (QREFELT |$| 14))) + +(DEFUN |ABELGRP-;*;I2S;4| (|n| |x| |$|) + (COND + ((ZEROP |n|) (|spadConstant| |$| 17)) + ((|<| 0 |n|) (SPADCALL |n| |x| (QREFELT |$| 20))) + ((QUOTE T) + (SPADCALL (|-| |n|) (SPADCALL |x| (QREFELT |$| 7)) (QREFELT |$| 20))))) + +(DEFUN |AbelianGroup&| (|#1|) + (PROG (|DV$1| |dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |DV$1| (|devaluate| |#1|) . #1=(|AbelianGroup&|)) + (LETT |dv$| (LIST (QUOTE |AbelianGroup&|) |DV$1|) . #1#) + (LETT |$| (GETREFV 22) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|stuffDomainSlots| |$|) + (QSETREFV |$| 6 |#1|) + (COND + ((|HasCategory| |#1| (QUOTE (|Ring|)))) + ((QUOTE T) + (QSETREFV |$| 21 + (CONS (|dispatchFunction| |ABELGRP-;*;I2S;4|) |$|)))) + |$|)))) + +(MAKEPROP + (QUOTE |AbelianGroup&|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL NIL + (|local| |#1|) + (0 . |-|) + (5 . |+|) + |ABELGRP-;-;3S;1| + (11 . |-|) + (|Union| |$| (QUOTE "failed")) + |ABELGRP-;subtractIfCan;2SU;2| + (|Integer|) + (17 . |*|) + (|NonNegativeInteger|) + |ABELGRP-;*;Nni2S;3| + (23 . |Zero|) + (|PositiveInteger|) + (|RepeatedDoubling| 6) + (27 . |double|) + (33 . |*|))) + (QUOTE #(|subtractIfCan| 39 |-| 45 |*| 51)) + (QUOTE NIL) + (CONS + (|makeByteWordVec2| 1 (QUOTE NIL)) + (CONS + (QUOTE #()) + (CONS + (QUOTE #()) + (|makeByteWordVec2| 21 + (QUOTE (1 6 0 0 7 2 6 0 0 0 8 2 6 0 0 0 10 2 6 0 13 0 14 0 6 0 17 + 2 19 6 18 6 20 2 0 0 13 0 21 2 0 11 0 0 12 2 0 0 0 0 9 2 + 0 0 13 0 21 2 0 0 15 0 16)))))) + (QUOTE |lookupComplete|))) + +@ +\section{category ABELMON AbelianMonoid} +<<category ABELMON AbelianMonoid>>= +)abbrev category ABELMON AbelianMonoid +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The class of multiplicative monoids, i.e. semigroups with an +++ additive identity element. +++ +++ Axioms: +++ \spad{leftIdentity("+":(%,%)->%,0)}\tab{30}\spad{ 0+x=x } +++ \spad{rightIdentity("+":(%,%)->%,0)}\tab{30}\spad{ x+0=x } +-- following domain must be compiled with subsumption disabled +-- define SourceLevelSubset to be EQUAL +AbelianMonoid(): Category == AbelianSemiGroup with + --operations + 0: constant -> % + ++ 0 is the additive identity element. + sample: constant -> % + ++ sample yields a value of type % + zero?: % -> Boolean + ++ zero?(x) tests if x is equal to 0. + "*": (NonNegativeInteger,%) -> % + ++ n * x is left-multiplication by a non negative integer + add + import RepeatedDoubling(%) + zero? x == x = 0 + n:PositiveInteger * x:% == (n::NonNegativeInteger) * x + sample() == 0 + if not (% has Ring) then + n:NonNegativeInteger * x:% == + zero? n => 0 + double(n pretend PositiveInteger,x) + +@ +\section{ABELMON.lsp BOOTSTRAP} +{\bf ABELMON} which needs +{\bf ABELSG} which needs +{\bf SETCAT} which needs +{\bf SINT} which needs +{\bf UFD} which needs +{\bf GCDDOM} which needs +{\bf COMRING} which needs +{\bf RING} which needs +{\bf RNG} which needs +{\bf ABELGRP} which needs +{\bf CABMON} which needs +{\bf ABELMON}. +We break this chain with {\bf ABELMON.lsp} which we +cache here. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf ABELMON} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf ABELMON.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<ABELMON.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |AbelianMonoid;AL| (QUOTE NIL)) + +(DEFUN |AbelianMonoid| NIL + (LET (#:G82597) + (COND + (|AbelianMonoid;AL|) + (T (SETQ |AbelianMonoid;AL| (|AbelianMonoid;|)))))) + +(DEFUN |AbelianMonoid;| NIL + (PROG (#1=#:G82595) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|AbelianSemiGroup|) + (|mkCategory| + (QUOTE |domain|) + (QUOTE ( + ((|Zero| (|$|) |constant|) T) + ((|sample| (|$|) |constant|) T) + ((|zero?| ((|Boolean|) |$|)) T) + ((|*| (|$| (|NonNegativeInteger|) |$|)) T))) + NIL + (QUOTE ((|NonNegativeInteger|) (|Boolean|))) + NIL)) + |AbelianMonoid|) + (SETELT #1# 0 (QUOTE (|AbelianMonoid|))))))) + +(MAKEPROP (QUOTE |AbelianMonoid|) (QUOTE NILADIC) T) + +@ +\section{ABELMON-.lsp BOOTSTRAP} +{\bf ABELMON-} which needs +{\bf ABELSG} which needs +{\bf SETCAT} which needs +{\bf SINT} which needs +{\bf UFD} which needs +{\bf GCDDOM} which needs +{\bf COMRING} which needs +{\bf RING} which needs +{\bf RNG} which needs +{\bf ABELGRP} which needs +{\bf CABMON} which needs +{\bf ABELMON-}. +We break this chain with {\bf ABELMON-.lsp} which we +cache here. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf ABELMON-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf ABELMON-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<ABELMON-.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(DEFUN |ABELMON-;zero?;SB;1| (|x| |$|) + (SPADCALL |x| (|spadConstant| |$| 7) (QREFELT |$| 9))) + +(DEFUN |ABELMON-;*;Pi2S;2| (|n| |x| |$|) + (SPADCALL |n| |x| (QREFELT |$| 12))) + +(DEFUN |ABELMON-;sample;S;3| (|$|) + (|spadConstant| |$| 7)) + +(DEFUN |ABELMON-;*;Nni2S;4| (|n| |x| |$|) + (COND + ((ZEROP |n|) (|spadConstant| |$| 7)) + ((QUOTE T) (SPADCALL |n| |x| (QREFELT |$| 17))))) + +(DEFUN |AbelianMonoid&| (|#1|) + (PROG (|DV$1| |dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |DV$1| (|devaluate| |#1|) . #1=(|AbelianMonoid&|)) + (LETT |dv$| (LIST (QUOTE |AbelianMonoid&|) |DV$1|) . #1#) + (LETT |$| (GETREFV 19) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|stuffDomainSlots| |$|) + (QSETREFV |$| 6 |#1|) + (COND + ((|HasCategory| |#1| (QUOTE (|Ring|)))) + ((QUOTE T) + (QSETREFV |$| 18 + (CONS (|dispatchFunction| |ABELMON-;*;Nni2S;4|) |$|)))) |$|)))) + +(MAKEPROP + (QUOTE |AbelianMonoid&|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL NIL + (|local| |#1|) + (0 . |Zero|) + (|Boolean|) + (4 . |=|) + |ABELMON-;zero?;SB;1| + (|NonNegativeInteger|) + (10 . |*|) + (|PositiveInteger|) + |ABELMON-;*;Pi2S;2| + |ABELMON-;sample;S;3| + (|RepeatedDoubling| 6) + (16 . |double|) + (22 . |*|))) + (QUOTE #(|zero?| 28 |sample| 33 |*| 37)) + (QUOTE NIL) + (CONS + (|makeByteWordVec2| 1 (QUOTE NIL)) + (CONS + (QUOTE #()) + (CONS + (QUOTE #()) + (|makeByteWordVec2| 18 + (QUOTE (0 6 0 7 2 6 8 0 0 9 2 6 0 11 0 12 2 16 6 13 6 17 2 0 0 11 + 0 18 1 0 8 0 10 0 0 0 15 2 0 0 11 0 18 2 0 0 13 0 14)))))) + (QUOTE |lookupComplete|))) + +@ +\section{category ABELSG AbelianSemiGroup} +<<category ABELSG AbelianSemiGroup>>= +)abbrev category ABELSG AbelianSemiGroup +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ the class of all additive (commutative) semigroups, i.e. +++ a set with a commutative and associative operation \spadop{+}. +++ +++ Axioms: +++ \spad{associative("+":(%,%)->%)}\tab{30}\spad{ (x+y)+z = x+(y+z) } +++ \spad{commutative("+":(%,%)->%)}\tab{30}\spad{ x+y = y+x } +AbelianSemiGroup(): Category == SetCategory with + --operations + "+": (%,%) -> % ++ x+y computes the sum of x and y. + "*": (PositiveInteger,%) -> % + ++ n*x computes the left-multiplication of x by the positive integer n. + ++ This is equivalent to adding x to itself n times. + add + import RepeatedDoubling(%) + if not (% has Ring) then + n:PositiveInteger * x:% == double(n,x) + +@ +\section{ABELSG.lsp BOOTSTRAP} +{\bf ABELSG} needs +{\bf SETCAT} which needs +{\bf SINT} which needs +{\bf UFD} which needs +{\bf GCDDOM} which needs +{\bf COMRING} which needs +{\bf RING} which needs +{\bf RNG} which needs +{\bf ABELGRP} which needs +{\bf CABMON} which needs +{\bf ABELMON} which needs +{\bf ABELSG}. +We break this chain with {\bf ABELSG.lsp} which we +cache here. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf ABELSG} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf ABELSG.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<ABELSG.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |AbelianSemiGroup;AL| (QUOTE NIL)) + +(DEFUN |AbelianSemiGroup| NIL + (LET (#:G82568) + (COND + (|AbelianSemiGroup;AL|) + (T (SETQ |AbelianSemiGroup;AL| (|AbelianSemiGroup;|)))))) + +(DEFUN |AbelianSemiGroup;| NIL + (PROG (#1=#:G82566) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|SetCategory|) + (|mkCategory| + (QUOTE |domain|) + (QUOTE ( + ((|+| (|$| |$| |$|)) T) + ((|*| (|$| (|PositiveInteger|) |$|)) T))) + NIL + (QUOTE ((|PositiveInteger|))) + NIL)) + |AbelianSemiGroup|) + (SETELT #1# 0 (QUOTE (|AbelianSemiGroup|))))))) + +(MAKEPROP (QUOTE |AbelianSemiGroup|) (QUOTE NILADIC) T) +@ +\section{ABELSG-.lsp BOOTSTRAP} +{\bf ABELSG-} needs +{\bf SETCAT} which needs +{\bf SINT} which needs +{\bf UFD} which needs +{\bf GCDDOM} which needs +{\bf COMRING} which needs +{\bf RING} which needs +{\bf RNG} which needs +{\bf ABELGRP} which needs +{\bf CABMON} which needs +{\bf ABELMON} which needs +{\bf ABELSG-}. +We break this chain with {\bf ABELSG-.lsp} which we +cache here. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf ABELSG-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf ABELSG-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<ABELSG-.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(DEFUN |ABELSG-;*;Pi2S;1| (|n| |x| |$|) (SPADCALL |n| |x| (QREFELT |$| 9))) + +(DEFUN |AbelianSemiGroup&| (|#1|) + (PROG (|DV$1| |dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |DV$1| (|devaluate| |#1|) . #1=(|AbelianSemiGroup&|)) + (LETT |dv$| (LIST (QUOTE |AbelianSemiGroup&|) |DV$1|) . #1#) + (LETT |$| (GETREFV 11) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|stuffDomainSlots| |$|) + (QSETREFV |$| 6 |#1|) + (COND + ((|HasCategory| |#1| (QUOTE (|Ring|)))) + ((QUOTE T) + (QSETREFV |$| 10 + (CONS (|dispatchFunction| |ABELSG-;*;Pi2S;1|) |$|)))) + |$|)))) + +(MAKEPROP + (QUOTE |AbelianSemiGroup&|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL NIL + (|local| |#1|) + (|PositiveInteger|) + (|RepeatedDoubling| 6) + (0 . |double|) + (6 . |*|))) + (QUOTE #(|*| 12)) + (QUOTE NIL) + (CONS + (|makeByteWordVec2| 1 (QUOTE NIL)) + (CONS + (QUOTE #()) + (CONS + (QUOTE #()) + (|makeByteWordVec2| 10 + (QUOTE (2 8 6 7 6 9 2 0 0 7 0 10 2 0 0 7 0 10)))))) + (QUOTE |lookupComplete|))) +@ +\section{category ALGEBRA Algebra} +<<category ALGEBRA Algebra>>= +)abbrev category ALGEBRA Algebra +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The category of associative algebras (modules which are themselves rings). +++ +++ Axioms: +++ \spad{(b+c)::% = (b::%) + (c::%)} +++ \spad{(b*c)::% = (b::%) * (c::%)} +++ \spad{(1::R)::% = 1::%} +++ \spad{b*x = (b::%)*x} +++ \spad{r*(a*b) = (r*a)*b = a*(r*b)} +Algebra(R:CommutativeRing): Category == + Join(Ring, Module R) with + --operations + coerce: R -> % + ++ coerce(r) maps the ring element r to a member of the algebra. + add + coerce(x:R):% == x * 1$% + +@ +\section{category BASTYPE BasicType} +<<category BASTYPE BasicType>>= +)abbrev category BASTYPE BasicType +--% BasicType +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ \spadtype{BasicType} is the basic category for describing a collection +++ of elements with \spadop{=} (equality). +BasicType(): Category == with + "=": (%,%) -> Boolean ++ x=y tests if x and y are equal. + "~=": (%,%) -> Boolean ++ x~=y tests if x and y are not equal. + add + _~_=(x:%,y:%) : Boolean == not(x=y) + +@ +\section{category BMODULE BiModule} +<<category BMODULE BiModule>>= +)abbrev category BMODULE BiModule +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A \spadtype{BiModule} is both a left and right module with respect +++ to potentially different rings. +++ +++ Axiom: +++ \spad{ r*(x*s) = (r*x)*s } +BiModule(R:Ring,S:Ring):Category == + Join(LeftModule(R),RightModule(S)) with + leftUnitary ++ \spad{1 * x = x} + rightUnitary ++ \spad{x * 1 = x} + +@ +\section{category CABMON CancellationAbelianMonoid} +<<category CABMON CancellationAbelianMonoid>>= +)abbrev category CABMON CancellationAbelianMonoid +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: Davenport & Trager I +++ Description: +++ This is an \spadtype{AbelianMonoid} with the cancellation property, i.e. +++ \spad{ a+b = a+c => b=c }. +++ This is formalised by the partial subtraction operator, +++ which satisfies the axioms listed below: +++ +++ Axioms: +++ \spad{c = a+b <=> c-b = a} +CancellationAbelianMonoid(): Category == AbelianMonoid with + --operations + subtractIfCan: (%,%) -> Union(%,"failed") + ++ subtractIfCan(x, y) returns an element z such that \spad{z+y=x} + ++ or "failed" if no such element exists. + +@ +\section{CABMON.lsp BOOTSTRAP} +{\bf CABMON} which needs +{\bf ABELMON} which needs +{\bf ABELSG} which needs +{\bf SETCAT} which needs +{\bf SINT} which needs +{\bf UFD} which needs +{\bf GCDDOM} which needs +{\bf COMRING} which needs +{\bf RING} which needs +{\bf RNG} which needs +{\bf ABELGRP} which needs +{\bf CABMON}. +We break this chain with {\bf CABMON.lsp} which we +cache here. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf CABMON} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf CABMON.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<CABMON.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |CancellationAbelianMonoid;AL| (QUOTE NIL)) + +(DEFUN |CancellationAbelianMonoid| NIL + (LET (#:G82646) + (COND + (|CancellationAbelianMonoid;AL|) + (T + (SETQ + |CancellationAbelianMonoid;AL| + (|CancellationAbelianMonoid;|)))))) + +(DEFUN |CancellationAbelianMonoid;| NIL + (PROG (#1=#:G82644) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|AbelianMonoid|) + (|mkCategory| + (QUOTE |domain|) + (QUOTE (((|subtractIfCan| ((|Union| |$| "failed") |$| |$|)) T))) + NIL + (QUOTE NIL) + NIL)) + |CancellationAbelianMonoid|) + (SETELT #1# 0 (QUOTE (|CancellationAbelianMonoid|))))))) + +(MAKEPROP (QUOTE |CancellationAbelianMonoid|) (QUOTE NILADIC) T) + +@ +\section{category CHARNZ CharacteristicNonZero} +<<category CHARNZ CharacteristicNonZero>>= +)abbrev category CHARNZ CharacteristicNonZero +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ Rings of Characteristic Non Zero +CharacteristicNonZero():Category == Ring with + charthRoot: % -> Union(%,"failed") + ++ charthRoot(x) returns the pth root of x + ++ where p is the characteristic of the ring. + +@ +\section{category CHARZ CharacteristicZero} +<<category CHARZ CharacteristicZero>>= +)abbrev category CHARZ CharacteristicZero +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ Rings of Characteristic Zero. +CharacteristicZero():Category == Ring + +@ +\section{category COMRING CommutativeRing} +<<category COMRING CommutativeRing>>= +)abbrev category COMRING CommutativeRing +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The category of commutative rings with unity, i.e. rings where +++ \spadop{*} is commutative, and which have a multiplicative identity. +++ element. +--CommutativeRing():Category == Join(Ring,BiModule(%:Ring,%:Ring)) with +CommutativeRing():Category == Join(Ring,BiModule(%,%)) with + commutative("*") ++ multiplication is commutative. + +@ +\section{COMRING.lsp BOOTSTRAP} +{\bf COMRING} depends on itself. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf COMRING} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf COMRING.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<COMRING.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |CommutativeRing;AL| (QUOTE NIL)) + +(DEFUN |CommutativeRing| NIL + (LET (#:G82892) + (COND + (|CommutativeRing;AL|) + (T (SETQ |CommutativeRing;AL| (|CommutativeRing;|)))))) + +(DEFUN |CommutativeRing;| NIL + (PROG (#1=#:G82890) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|Ring|) + (|BiModule| (QUOTE |$|) (QUOTE |$|)) + (|mkCategory| + (QUOTE |package|) + NIL + (QUOTE (((|commutative| "*") T))) + (QUOTE NIL) + NIL)) + |CommutativeRing|) + (SETELT #1# 0 (QUOTE (|CommutativeRing|))))))) + +(MAKEPROP (QUOTE |CommutativeRing|) (QUOTE NILADIC) T) + +@ +\section{category DIFRING DifferentialRing} +<<category DIFRING DifferentialRing>>= +)abbrev category DIFRING DifferentialRing +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ An ordinary differential ring, that is, a ring with an operation +++ \spadfun{differentiate}. +++ +++ Axioms: +++ \spad{differentiate(x+y) = differentiate(x)+differentiate(y)} +++ \spad{differentiate(x*y) = x*differentiate(y) + differentiate(x)*y} + +DifferentialRing(): Category == Ring with + differentiate: % -> % + ++ differentiate(x) returns the derivative of x. + ++ This function is a simple differential operator + ++ where no variable needs to be specified. + D: % -> % + ++ D(x) returns the derivative of x. + ++ This function is a simple differential operator + ++ where no variable needs to be specified. + differentiate: (%, NonNegativeInteger) -> % + ++ differentiate(x, n) returns the n-th derivative of x. + D: (%, NonNegativeInteger) -> % + ++ D(x, n) returns the n-th derivative of x. + add + D r == differentiate r + differentiate(r, n) == + for i in 1..n repeat r := differentiate r + r + D(r,n) == differentiate(r,n) + +@ +\section{DIFRING.lsp BOOTSTRAP} +{\bf DIFRING} needs {\bf INT} which needs {\bf DIFRING}. +We need to break this cycle to build the algebra. So we keep a +cached copy of the translated {\bf DIFRING} category which we can write +into the {\bf MID} directory. We compile the lisp code and copy the +{\bf DIFRING.o} file to the {\bf OUT} directory. This is eventually +forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<DIFRING.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |DifferentialRing;AL| (QUOTE NIL)) + +(DEFUN |DifferentialRing| NIL + (LET (#:G84565) + (COND + (|DifferentialRing;AL|) + (T (SETQ |DifferentialRing;AL| (|DifferentialRing;|)))))) + +(DEFUN |DifferentialRing;| NIL + (PROG (#1=#:G84563) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|Ring|) + (|mkCategory| + (QUOTE |domain|) + (QUOTE + (((|differentiate| (|$| |$|)) T) + ((D (|$| |$|)) T) + ((|differentiate| (|$| |$| (|NonNegativeInteger|))) T) + ((D (|$| |$| (|NonNegativeInteger|))) T))) + NIL + (QUOTE ((|NonNegativeInteger|))) + NIL)) + |DifferentialRing|) + (SETELT #1# 0 (QUOTE (|DifferentialRing|))))))) + +(MAKEPROP (QUOTE |DifferentialRing|) (QUOTE NILADIC) T) + +@ +\section{DIFRING-.lsp BOOTSTRAP} +{\bf DIFRING-} needs {\bf DIFRING}. +We need to break this cycle to build the algebra. So we keep a +cached copy of the translated {\bf DIFRING-} category which we can write +into the {\bf MID} directory. We compile the lisp code and copy the +{\bf DIFRING-.o} file to the {\bf OUT} directory. This is eventually +forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<DIFRING-.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(DEFUN |DIFRING-;D;2S;1| (|r| |$|) + (SPADCALL |r| (QREFELT |$| 7))) + +(DEFUN |DIFRING-;differentiate;SNniS;2| (|r| |n| |$|) + (PROG (|i|) + (RETURN + (SEQ + (SEQ + (LETT |i| 1 |DIFRING-;differentiate;SNniS;2|) + G190 + (COND ((QSGREATERP |i| |n|) (GO G191))) + (SEQ + (EXIT + (LETT |r| + (SPADCALL |r| (QREFELT |$| 7)) + |DIFRING-;differentiate;SNniS;2|))) + (LETT |i| (QSADD1 |i|) |DIFRING-;differentiate;SNniS;2|) + (GO G190) + G191 + (EXIT NIL)) + (EXIT |r|))))) + +(DEFUN |DIFRING-;D;SNniS;3| (|r| |n| |$|) + (SPADCALL |r| |n| (QREFELT |$| 11))) + +(DEFUN |DifferentialRing&| (|#1|) + (PROG (|DV$1| |dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |DV$1| (|devaluate| |#1|) . #1=(|DifferentialRing&|)) + (LETT |dv$| (LIST (QUOTE |DifferentialRing&|) |DV$1|) . #1#) + (LETT |$| (GETREFV 13) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|stuffDomainSlots| |$|) + (QSETREFV |$| 6 |#1|) + |$|)))) + +(MAKEPROP + (QUOTE |DifferentialRing&|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL NIL + (|local| |#1|) + (0 . |differentiate|) + |DIFRING-;D;2S;1| + (|NonNegativeInteger|) + |DIFRING-;differentiate;SNniS;2| + (5 . |differentiate|) + |DIFRING-;D;SNniS;3|)) + (QUOTE #(|differentiate| 11 D 17)) + (QUOTE NIL) + (CONS + (|makeByteWordVec2| 1 (QUOTE NIL)) + (CONS + (QUOTE #()) + (CONS + (QUOTE #()) + (|makeByteWordVec2| 12 + (QUOTE + (1 6 0 0 7 2 6 0 0 9 11 2 0 0 0 9 10 2 0 0 0 9 12 1 0 0 0 8)))))) + (QUOTE |lookupComplete|))) + +@ +\section{category DIFEXT DifferentialExtension} +<<category DIFEXT DifferentialExtension>>= +)abbrev category DIFEXT DifferentialExtension +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ Differential extensions of a ring R. +++ Given a differentiation on R, extend it to a differentiation on %. + +DifferentialExtension(R:Ring): Category == Ring with + --operations + differentiate: (%, R -> R) -> % + ++ differentiate(x, deriv) differentiates x extending + ++ the derivation deriv on R. + differentiate: (%, R -> R, NonNegativeInteger) -> % + ++ differentiate(x, deriv, n) differentiate x n times + ++ using a derivation which extends deriv on R. + D: (%, R -> R) -> % + ++ D(x, deriv) differentiates x extending + ++ the derivation deriv on R. + D: (%, R -> R, NonNegativeInteger) -> % + ++ D(x, deriv, n) differentiate x n times + ++ using a derivation which extends deriv on R. + if R has DifferentialRing then DifferentialRing + if R has PartialDifferentialRing(Symbol) then + PartialDifferentialRing(Symbol) + add + differentiate(x:%, derivation: R -> R, n:NonNegativeInteger):% == + for i in 1..n repeat x := differentiate(x, derivation) + x + D(x:%, derivation: R -> R) == differentiate(x, derivation) + D(x:%, derivation: R -> R, n:NonNegativeInteger) == + differentiate(x, derivation, n) + + if R has DifferentialRing then + differentiate x == differentiate(x, differentiate$R) + + if R has PartialDifferentialRing Symbol then + differentiate(x:%, v:Symbol):% == + differentiate(x, differentiate(#1, v)$R) + +@ +\section{category DIVRING DivisionRing} +<<category DIVRING DivisionRing>>= +)abbrev category DIVRING DivisionRing +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A division ring (sometimes called a skew field), +++ i.e. a not necessarily commutative ring where +++ all non-zero elements have multiplicative inverses. + +DivisionRing(): Category == + Join(EntireRing, Algebra Fraction Integer) with + "**": (%,Integer) -> % + ++ x**n returns x raised to the integer power n. + "^" : (%,Integer) -> % + ++ x^n returns x raised to the integer power n. + inv : % -> % + ++ inv x returns the multiplicative inverse of x. + ++ Error: if x is 0. +-- Q-algebra is a lie, should be conditional on characteristic 0, +-- but knownInfo cannot handle the following commented +-- if % has CharacteristicZero then Algebra Fraction Integer + add + n: Integer + x: % + _^(x:%, n:Integer):% == x ** n + import RepeatedSquaring(%) + x ** n: Integer == + zero? n => 1 + zero? x => + n<0 => error "division by zero" + x + n<0 => + expt(inv x,(-n) pretend PositiveInteger) + expt(x,n pretend PositiveInteger) +-- if % has CharacteristicZero() then + q:Fraction(Integer) * x:% == numer(q) * inv(denom(q)::%) * x + +@ +\section{DIVRING.lsp BOOTSTRAP} +{\bf DIVRING} depends on {\bf QFCAT} which eventually depends on +{\bf DIVRING}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf DIVRING} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf DIVRING.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<DIVRING.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |DivisionRing;AL| (QUOTE NIL)) + +(DEFUN |DivisionRing| NIL + (LET (#:G84035) + (COND + (|DivisionRing;AL|) + (T (SETQ |DivisionRing;AL| (|DivisionRing;|)))))) + +(DEFUN |DivisionRing;| NIL + (PROG (#1=#:G84033) + (RETURN + (PROG1 + (LETT #1# + (|sublisV| + (PAIR + (QUOTE (#2=#:G84032)) + (LIST (QUOTE (|Fraction| (|Integer|))))) + (|Join| + (|EntireRing|) + (|Algebra| (QUOTE #2#)) + (|mkCategory| + (QUOTE |domain|) + (QUOTE ( + ((|**| (|$| |$| (|Integer|))) T) + ((|^| (|$| |$| (|Integer|))) T) + ((|inv| (|$| |$|)) T))) + NIL + (QUOTE ((|Integer|))) + NIL))) + |DivisionRing|) + (SETELT #1# 0 (QUOTE (|DivisionRing|))))))) + +(MAKEPROP (QUOTE |DivisionRing|) (QUOTE NILADIC) T) + +@ +\section{DIVRING-.lsp BOOTSTRAP} +{\bf DIVRING-} depends on {\bf DIVRING}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf DIVRING-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf DIVRING-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<DIVRING-.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(DEFUN |DIVRING-;^;SIS;1| (|x| |n| |$|) + (SPADCALL |x| |n| (QREFELT |$| 8))) + +(DEFUN |DIVRING-;**;SIS;2| (|x| |n| |$|) + (COND + ((ZEROP |n|) (|spadConstant| |$| 10)) + ((SPADCALL |x| (QREFELT |$| 12)) + (COND + ((|<| |n| 0) (|error| "division by zero")) + ((QUOTE T) |x|))) + ((|<| |n| 0) + (SPADCALL (SPADCALL |x| (QREFELT |$| 14)) (|-| |n|) (QREFELT |$| 17))) + ((QUOTE T) (SPADCALL |x| |n| (QREFELT |$| 17))))) + +(DEFUN |DIVRING-;*;F2S;3| (|q| |x| |$|) + (SPADCALL + (SPADCALL + (SPADCALL |q| (QREFELT |$| 20)) + (SPADCALL + (SPADCALL (SPADCALL |q| (QREFELT |$| 21)) (QREFELT |$| 22)) + (QREFELT |$| 14)) + (QREFELT |$| 23)) + |x| + (QREFELT |$| 24))) + +(DEFUN |DivisionRing&| (|#1|) + (PROG (|DV$1| |dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |DV$1| (|devaluate| |#1|) . #1=(|DivisionRing&|)) + (LETT |dv$| (LIST (QUOTE |DivisionRing&|) |DV$1|) . #1#) + (LETT |$| (GETREFV 27) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|stuffDomainSlots| |$|) + (QSETREFV |$| 6 |#1|) + |$|)))) + +(MAKEPROP + (QUOTE |DivisionRing&|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL NIL + (|local| |#1|) + (|Integer|) + (0 . |**|) + |DIVRING-;^;SIS;1| + (6 . |One|) + (|Boolean|) + (10 . |zero?|) + (15 . |Zero|) + (19 . |inv|) + (|PositiveInteger|) + (|RepeatedSquaring| 6) + (24 . |expt|) + |DIVRING-;**;SIS;2| + (|Fraction| 7) + (30 . |numer|) + (35 . |denom|) + (40 . |coerce|) + (45 . |*|) + (51 . |*|) + |DIVRING-;*;F2S;3| + (|NonNegativeInteger|))) + (QUOTE #(|^| 57 |**| 63 |*| 69)) + (QUOTE NIL) + (CONS + (|makeByteWordVec2| 1 (QUOTE NIL)) + (CONS + (QUOTE #()) + (CONS + (QUOTE #()) + (|makeByteWordVec2| 25 + (QUOTE + (2 6 0 0 7 8 0 6 0 10 1 6 11 0 12 0 6 0 13 1 6 0 0 14 2 16 6 + 6 15 17 1 19 7 0 20 1 19 7 0 21 1 6 0 7 22 2 6 0 7 0 23 2 6 + 0 0 0 24 2 0 0 0 7 9 2 0 0 0 7 18 2 0 0 19 0 25)))))) + (QUOTE |lookupComplete|))) + +@ +\section{category ENTIRER EntireRing} +<<category ENTIRER EntireRing>>= +)abbrev category ENTIRER EntireRing +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ Entire Rings (non-commutative Integral Domains), i.e. a ring +++ not necessarily commutative which has no zero divisors. +++ +++ Axioms: +++ \spad{ab=0 => a=0 or b=0} -- known as noZeroDivisors +++ \spad{not(1=0)} +--EntireRing():Category == Join(Ring,BiModule(%:Ring,%:Ring)) with +EntireRing():Category == Join(Ring,BiModule(%,%)) with + noZeroDivisors ++ if a product is zero then one of the factors + ++ must be zero. + +@ +\section{ENTIRER.lsp BOOTSTRAP} +{\bf ENTIRER} depends on itself. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf ENTIRER} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf ENTIRER.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<ENTIRER.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |EntireRing;AL| (QUOTE NIL)) + +(DEFUN |EntireRing| NIL + (LET (#:G82841) + (COND + (|EntireRing;AL|) + (T (SETQ |EntireRing;AL| (|EntireRing;|)))))) + +(DEFUN |EntireRing;| NIL + (PROG (#1=#:G82839) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|Ring|) + (|BiModule| (QUOTE |$|) (QUOTE |$|)) + (|mkCategory| + (QUOTE |package|) + NIL + (QUOTE ((|noZeroDivisors| T))) + (QUOTE NIL) + NIL)) + |EntireRing|) + (SETELT #1# 0 (QUOTE (|EntireRing|))))))) + +(MAKEPROP (QUOTE |EntireRing|) (QUOTE NILADIC) T) + +@ +\section{category EUCDOM EuclideanDomain} +<<category EUCDOM EuclideanDomain>>= +)abbrev category EUCDOM EuclideanDomain +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A constructive euclidean domain, i.e. one can divide producing +++ a quotient and a remainder where the remainder is either zero +++ or is smaller (\spadfun{euclideanSize}) than the divisor. +++ +++ Conditional attributes: +++ multiplicativeValuation\tab{25}\spad{Size(a*b)=Size(a)*Size(b)} +++ additiveValuation\tab{25}\spad{Size(a*b)=Size(a)+Size(b)} + +EuclideanDomain(): Category == PrincipalIdealDomain with + --operations + sizeLess?: (%,%) -> Boolean + ++ sizeLess?(x,y) tests whether x is strictly + ++ smaller than y with respect to the \spadfunFrom{euclideanSize}{EuclideanDomain}. + euclideanSize: % -> NonNegativeInteger + ++ euclideanSize(x) returns the euclidean size of the element x. + ++ Error: if x is zero. + divide: (%,%) -> Record(quotient:%,remainder:%) + ++ divide(x,y) divides x by y producing a record containing a + ++ \spad{quotient} and \spad{remainder}, + ++ where the remainder is smaller (see \spadfunFrom{sizeLess?}{EuclideanDomain}) + ++ than the divisor y. + "quo" : (%,%) -> % + ++ x quo y is the same as \spad{divide(x,y).quotient}. + ++ See \spadfunFrom{divide}{EuclideanDomain}. + "rem": (%,%) -> % + ++ x rem y is the same as \spad{divide(x,y).remainder}. + ++ See \spadfunFrom{divide}{EuclideanDomain}. + extendedEuclidean: (%,%) -> Record(coef1:%,coef2:%,generator:%) + -- formerly called princIdeal + ++ extendedEuclidean(x,y) returns a record rec where + ++ \spad{rec.coef1*x+rec.coef2*y = rec.generator} and + ++ rec.generator is a gcd of x and y. + ++ The gcd is unique only + ++ up to associates if \spadatt{canonicalUnitNormal} is not asserted. + ++ \spadfun{principalIdeal} provides a version of this operation + ++ which accepts an arbitrary length list of arguments. + extendedEuclidean: (%,%,%) -> Union(Record(coef1:%,coef2:%),"failed") + -- formerly called expressIdealElt + ++ extendedEuclidean(x,y,z) either returns a record rec + ++ where \spad{rec.coef1*x+rec.coef2*y=z} or returns "failed" + ++ if z cannot be expressed as a linear combination of x and y. + multiEuclidean: (List %,%) -> Union(List %,"failed") + ++ multiEuclidean([f1,...,fn],z) returns a list of coefficients + ++ \spad{[a1, ..., an]} such that + ++ \spad{ z / prod fi = sum aj/fj}. + ++ If no such list of coefficients exists, "failed" is returned. + add + -- declarations + x,y,z: % + l: List % + -- definitions + sizeLess?(x,y) == + zero? y => false + zero? x => true + euclideanSize(x)<euclideanSize(y) + x quo y == divide(x,y).quotient --divide must be user-supplied + x rem y == divide(x,y).remainder + x exquo y == + zero? y => "failed" + qr:=divide(x,y) + zero?(qr.remainder) => qr.quotient + "failed" + gcd(x,y) == --Euclidean Algorithm + x:=unitCanonical x + y:=unitCanonical y + while not zero? y repeat + (x,y):= (y,x rem y) + y:=unitCanonical y -- this doesn't affect the + -- correctness of Euclid's algorithm, + -- but + -- a) may improve performance + -- b) ensures gcd(x,y)=gcd(y,x) + -- if canonicalUnitNormal + x + IdealElt ==> Record(coef1:%,coef2:%,generator:%) + unitNormalizeIdealElt(s:IdealElt):IdealElt == + (u,c,a):=unitNormal(s.generator) +-- one? a => s + (a = 1) => s + [a*s.coef1,a*s.coef2,c]$IdealElt + extendedEuclidean(x,y) == --Extended Euclidean Algorithm + s1:=unitNormalizeIdealElt([1$%,0$%,x]$IdealElt) + s2:=unitNormalizeIdealElt([0$%,1$%,y]$IdealElt) + zero? y => s1 + zero? x => s2 + while not zero?(s2.generator) repeat + qr:= divide(s1.generator, s2.generator) + s3:=[s1.coef1 - qr.quotient * s2.coef1, + s1.coef2 - qr.quotient * s2.coef2, qr.remainder]$IdealElt + s1:=s2 + s2:=unitNormalizeIdealElt s3 + if not(zero?(s1.coef1)) and not sizeLess?(s1.coef1,y) + then + qr:= divide(s1.coef1,y) + s1.coef1:= qr.remainder + s1.coef2:= s1.coef2 + qr.quotient * x + s1 := unitNormalizeIdealElt s1 + s1 + + TwoCoefs ==> Record(coef1:%,coef2:%) + extendedEuclidean(x,y,z) == + zero? z => [0,0]$TwoCoefs + s:= extendedEuclidean(x,y) + (w:= z exquo s.generator) case "failed" => "failed" + zero? y => + [s.coef1 * w, s.coef2 * w]$TwoCoefs + qr:= divide((s.coef1 * w), y) + [qr.remainder, s.coef2 * w + qr.quotient * x]$TwoCoefs + principalIdeal l == + l = [] => error "empty list passed to principalIdeal" + rest l = [] => + uca:=unitNormal(first l) + [[uca.unit],uca.canonical] + rest rest l = [] => + u:= extendedEuclidean(first l,second l) + [[u.coef1, u.coef2], u.generator] + v:=principalIdeal rest l + u:= extendedEuclidean(first l,v.generator) + [[u.coef1,:[u.coef2*vv for vv in v.coef]],u.generator] + expressIdealMember(l,z) == + z = 0 => [0 for v in l] + pid := principalIdeal l + (q := z exquo (pid.generator)) case "failed" => "failed" + [q*v for v in pid.coef] + multiEuclidean(l,z) == + n := #l + zero? n => error "empty list passed to multiEuclidean" + n = 1 => [z] + l1 := copy l + l2 := split!(l1, n quo 2) + u:= extendedEuclidean(*/l1, */l2, z) + u case "failed" => "failed" + v1 := multiEuclidean(l1,u.coef2) + v1 case "failed" => "failed" + v2 := multiEuclidean(l2,u.coef1) + v2 case "failed" => "failed" + concat(v1,v2) + +@ +\section{EUCDOM.lsp BOOTSTRAP} +{\bf EUCDOM} depends on {\bf INT} which depends on {\bf EUCDOM}. +We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf EUCDOM} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf EUCDOM.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +\subsection{The Lisp Implementation} +\subsubsection{EUCDOM;VersionCheck} +This implements the bootstrap code for {\bf EuclideanDomain}. +The call to {\bf VERSIONCHECK} is a legacy check to ensure that +we did not load algebra code from a previous system version (which +would not run due to major surgical changes in the system) without +recompiling. +<<EUCDOM;VersionCheck>>= +(|/VERSIONCHECK| 2) + +@ +\subsubsection{The Domain Cache Variable} +We create a variable which is formed by concatenating the string +``{\bf ;AL}'' to the domain name forming, in this case, +``{\bf EuclideanDomain;AL}''. The variable has the initial value +at load time of a list of one element, {\bf NIL}. This list is +a data structure that will be modified to hold an executable +function. This function is created the first time the domain is +used which it replaces the {\bf NIL}. +<<EuclideanDomain;AL>>= +(SETQ |EuclideanDomain;AL| (QUOTE NIL)) + +@ +\subsubsection{The Domain Function} +When you call a domain the code is pretty simple at the top +level. This code will check to see if this domain has ever been +used. It does this by checking the value of the cached domain +variable (which is the domain name {\bf EuclideanDomain} concatenated +with the string ``{\bf ;AL}'' to form the cache variable name which +is {\bf EuclideanDomain;AL}). + +If this value is NIL we have never executed this function +before. If it is not NIL we have executed this function before and +we need only return the cached function which was stored in the +cache variable. + +If this is the first time this function is called, the cache +variable is NIL and we execute the other branch of the conditional. +This calls a function which +\begin{enumerate} +\item creates a procedure +\item returns the procedure as a value. +\end{enumerate} +This procedure replaces the cached variable {\bf EuclideanDomain;AL} +value so it will be non-NIL the second time this domain is used. +Thus the work of building the domain only happens once. + +If this function has never been called before we call the +<<EuclideanDomain>>= +(DEFUN |EuclideanDomain| NIL + (LET (#:G83585) + (COND + (|EuclideanDomain;AL|) + (T (SETQ |EuclideanDomain;AL| (|EuclideanDomain;|)))))) + +@ +\subsubsection{The First Call Domain Function} +<<EuclideanDomain;>>= +(DEFUN |EuclideanDomain;| NIL + (PROG (#1=#:G83583) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|PrincipalIdealDomain|) + (|mkCategory| + (QUOTE |domain|) + (QUOTE ( + ((|sizeLess?| ((|Boolean|) |$| |$|)) T) + ((|euclideanSize| ((|NonNegativeInteger|) |$|)) T) + ((|divide| + ((|Record| + (|:| |quotient| |$|) + (|:| |remainder| |$|)) + |$| |$|)) T) + ((|quo| (|$| |$| |$|)) T) + ((|rem| (|$| |$| |$|)) T) + ((|extendedEuclidean| + ((|Record| + (|:| |coef1| |$|) + (|:| |coef2| |$|) + (|:| |generator| |$|)) + |$| |$|)) T) + ((|extendedEuclidean| + ((|Union| + (|Record| (|:| |coef1| |$|) (|:| |coef2| |$|)) + "failed") + |$| |$| |$|)) T) + ((|multiEuclidean| + ((|Union| + (|List| |$|) + "failed") + (|List| |$|) |$|)) T))) + NIL + (QUOTE ((|List| |$|) (|NonNegativeInteger|) (|Boolean|))) + NIL)) + |EuclideanDomain|) + (SETELT #1# 0 (QUOTE (|EuclideanDomain|))))))) + +@ +\subsubsection{EUCDOM;MAKEPROP} +<<EUCDOM;MAKEPROP>>= +(MAKEPROP (QUOTE |EuclideanDomain|) (QUOTE NILADIC) T) + +@ +<<EUCDOM.lsp BOOTSTRAP>>= +<<EUCDOM;VersionCheck>> +<<EuclideanDomain;AL>> +<<EuclideanDomain>> +<<EuclideanDomain;>> +<<EUCDOM;MAKEPROP>> +@ +\section{EUCDOM-.lsp BOOTSTRAP} +{\bf EUCDOM-} depends on {\bf EUCDOM}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf EUCDOM-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf EUCDOM-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +\subsection{The Lisp Implementation} +\subsubsection{EUCDOM-;VersionCheck} +This implements the bootstrap code for {\bf EuclideanDomain}. +The call to {\bf VERSIONCHECK} is a legacy check to ensure that +we did not load algebra code from a previous system version (which +would not run due to major surgical changes in the system) without +recompiling. +<<EUCDOM-;VersionCheck>>= +(|/VERSIONCHECK| 2) + +@ +\subsubsection{EUCDOM-;sizeLess?;2SB;1} +<<EUCDOM-;sizeLess?;2SB;1>>= +(DEFUN |EUCDOM-;sizeLess?;2SB;1| (|x| |y| |$|) + (COND + ((SPADCALL |y| (QREFELT |$| 8)) (QUOTE NIL)) + ((SPADCALL |x| (QREFELT |$| 8)) (QUOTE T)) + ((QUOTE T) + (|<| (SPADCALL |x| (QREFELT |$| 10)) (SPADCALL |y| (QREFELT |$| 10)))))) + +@ + +\subsubsection{EUCDOM-;quo;3S;2} +<<EUCDOM-;quo;3S;2>>= +(DEFUN |EUCDOM-;quo;3S;2| (|x| |y| |$|) + (QCAR (SPADCALL |x| |y| (QREFELT |$| 13)))) + +@ +\subsubsection{EUCDOM-;rem;3S;3} +<<EUCDOM-;rem;3S;3>>= +(DEFUN |EUCDOM-;rem;3S;3| (|x| |y| |$|) + (QCDR (SPADCALL |x| |y| (QREFELT |$| 13)))) + +@ +\subsubsection{EUCDOM-;exquo;2SU;4} +<<EUCDOM-;exquo;2SU;4>>= +(DEFUN |EUCDOM-;exquo;2SU;4| (|x| |y| |$|) + (PROG (|qr|) + (RETURN + (SEQ + (COND + ((SPADCALL |y| (QREFELT |$| 8)) (CONS 1 "failed")) + ((QUOTE T) + (SEQ + (LETT |qr| + (SPADCALL |x| |y| (QREFELT |$| 13)) + |EUCDOM-;exquo;2SU;4|) + (EXIT + (COND + ((SPADCALL (QCDR |qr|) (QREFELT |$| 8)) (CONS 0 (QCAR |qr|))) + ((QUOTE T) (CONS 1 "failed"))))))))))) + +@ +\subsubsection{EUCDOM-;gcd;3S;5} +<<EUCDOM-;gcd;3S;5>>= +(DEFUN |EUCDOM-;gcd;3S;5| (|x| |y| |$|) + (PROG (|#G13| |#G14|) + (RETURN + (SEQ + (LETT |x| (SPADCALL |x| (QREFELT |$| 18)) |EUCDOM-;gcd;3S;5|) + (LETT |y| (SPADCALL |y| (QREFELT |$| 18)) |EUCDOM-;gcd;3S;5|) + (SEQ G190 + (COND + ((NULL + (COND + ((SPADCALL |y| (QREFELT |$| 8)) (QUOTE NIL)) + ((QUOTE T) (QUOTE T)))) + (GO G191))) + (SEQ + (PROGN + (LETT |#G13| |y| |EUCDOM-;gcd;3S;5|) + (LETT |#G14| (SPADCALL |x| |y| (QREFELT |$| 19)) |EUCDOM-;gcd;3S;5|) + (LETT |x| |#G13| |EUCDOM-;gcd;3S;5|) + (LETT |y| |#G14| |EUCDOM-;gcd;3S;5|)) + (EXIT + (LETT |y| (SPADCALL |y| (QREFELT |$| 18)) |EUCDOM-;gcd;3S;5|))) + NIL + (GO G190) + G191 + (EXIT NIL)) + (EXIT |x|))))) + +@ +\subsubsection{EUCDOM-;unitNormalizeIdealElt} +<<EUCDOM-;unitNormalizeIdealElt>>= +(DEFUN |EUCDOM-;unitNormalizeIdealElt| (|s| |$|) + (PROG (|#G16| |u| |c| |a|) + (RETURN + (SEQ + (PROGN + (LETT |#G16| (SPADCALL (QVELT |s| 2) (QREFELT |$| 22)) |EUCDOM-;unitNormalizeIdealElt|) + (LETT |u| (QVELT |#G16| 0) |EUCDOM-;unitNormalizeIdealElt|) + (LETT |c| (QVELT |#G16| 1) |EUCDOM-;unitNormalizeIdealElt|) + (LETT |a| (QVELT |#G16| 2) |EUCDOM-;unitNormalizeIdealElt|) + |#G16|) + (EXIT + (COND + ((SPADCALL |a| (QREFELT |$| 23)) |s|) + ((QUOTE T) + (VECTOR + (SPADCALL |a| (QVELT |s| 0) (QREFELT |$| 24)) + (SPADCALL |a| (QVELT |s| 1) (QREFELT |$| 24)) + |c|)))))))) + +@ +\subsubsection{EUCDOM-;extendedEuclidean;2SR;7} +<<EUCDOM-;extendedEuclidean;2SR;7>>= +(DEFUN |EUCDOM-;extendedEuclidean;2SR;7| (|x| |y| |$|) + (PROG (|s3| |s2| |qr| |s1|) + (RETURN + (SEQ + (LETT |s1| + (|EUCDOM-;unitNormalizeIdealElt| + (VECTOR (|spadConstant| |$| 25) (|spadConstant| |$| 26) |x|) |$|) + |EUCDOM-;extendedEuclidean;2SR;7|) + (LETT |s2| + (|EUCDOM-;unitNormalizeIdealElt| + (VECTOR (|spadConstant| |$| 26) (|spadConstant| |$| 25) |y|) |$|) + |EUCDOM-;extendedEuclidean;2SR;7|) + (EXIT + (COND + ((SPADCALL |y| (QREFELT |$| 8)) |s1|) + ((SPADCALL |x| (QREFELT |$| 8)) |s2|) + ((QUOTE T) + (SEQ + (SEQ G190 + (COND + ((NULL + (COND + ((SPADCALL (QVELT |s2| 2) (QREFELT |$| 8)) + (QUOTE NIL)) + ((QUOTE T) (QUOTE T)))) + (GO G191))) + (SEQ + (LETT |qr| + (SPADCALL (QVELT |s1| 2) (QVELT |s2| 2) (QREFELT |$| 13)) + |EUCDOM-;extendedEuclidean;2SR;7|) + (LETT |s3| + (VECTOR + (SPADCALL + (QVELT |s1| 0) + (SPADCALL + (QCAR |qr|) + (QVELT |s2| 0) + (QREFELT |$| 24)) + (QREFELT |$| 27)) + (SPADCALL + (QVELT |s1| 1) + (SPADCALL + (QCAR |qr|) + (QVELT |s2| 1) + (QREFELT |$| 24)) + (QREFELT |$| 27)) + (QCDR |qr|)) + |EUCDOM-;extendedEuclidean;2SR;7|) + (LETT |s1| |s2| |EUCDOM-;extendedEuclidean;2SR;7|) + (EXIT + (LETT |s2| + (|EUCDOM-;unitNormalizeIdealElt| |s3| |$|) + |EUCDOM-;extendedEuclidean;2SR;7|))) + NIL + (GO G190) + G191 + (EXIT NIL)) + (COND + ((NULL (SPADCALL (QVELT |s1| 0) (QREFELT |$| 8))) + (COND + ((NULL (SPADCALL (QVELT |s1| 0) |y| (QREFELT |$| 28))) + (SEQ + (LETT |qr| + (SPADCALL (QVELT |s1| 0) |y| (QREFELT |$| 13)) + |EUCDOM-;extendedEuclidean;2SR;7|) + (QSETVELT |s1| 0 (QCDR |qr|)) + (QSETVELT |s1| 1 + (SPADCALL + (QVELT |s1| 1) + (SPADCALL (QCAR |qr|) |x| (QREFELT |$| 24)) + (QREFELT |$| 29))) + (EXIT + (LETT |s1| + (|EUCDOM-;unitNormalizeIdealElt| |s1| |$|) + |EUCDOM-;extendedEuclidean;2SR;7|))))))) + (EXIT |s1|))))))))) + +@ +\subsubsection{EUCDOM-;extendedEuclidean;3SU;8} +<<EUCDOM-;extendedEuclidean;3SU;8>>= +(DEFUN |EUCDOM-;extendedEuclidean;3SU;8| (|x| |y| |z| |$|) + (PROG (|s| |w| |qr|) + (RETURN + (SEQ + (COND + ((SPADCALL |z| (QREFELT |$| 8)) + (CONS 0 (CONS (|spadConstant| |$| 26) (|spadConstant| |$| 26)))) + ((QUOTE T) + (SEQ + (LETT |s| + (SPADCALL |x| |y| (QREFELT |$| 32)) + |EUCDOM-;extendedEuclidean;3SU;8|) + (LETT |w| + (SPADCALL |z| (QVELT |s| 2) (QREFELT |$| 33)) + |EUCDOM-;extendedEuclidean;3SU;8|) + (EXIT + (COND + ((QEQCAR |w| 1) (CONS 1 "failed")) + ((SPADCALL |y| (QREFELT |$| 8)) + (CONS 0 + (CONS + (SPADCALL (QVELT |s| 0) (QCDR |w|) (QREFELT |$| 24)) + (SPADCALL (QVELT |s| 1) (QCDR |w|) (QREFELT |$| 24))))) + ((QUOTE T) + (SEQ + (LETT |qr| + (SPADCALL + (SPADCALL (QVELT |s| 0) (QCDR |w|) (QREFELT |$| 24)) + |y| + (QREFELT |$| 13)) + |EUCDOM-;extendedEuclidean;3SU;8|) + (EXIT + (CONS + 0 + (CONS + (QCDR |qr|) + (SPADCALL + (SPADCALL + (QVELT |s| 1) + (QCDR |w|) + (QREFELT |$| 24)) + (SPADCALL + (QCAR |qr|) + |x| + (QREFELT |$| 24)) + (QREFELT |$| 29)))))))))))))))) + +@ +\subsubsection{EUCDOM-;principalIdeal;LR;9} +<<EUCDOM-;principalIdeal;LR;9>>= +(DEFUN |EUCDOM-;principalIdeal;LR;9| (|l| |$|) + (PROG (|uca| |v| |u| #1=#:G83663 |vv| #2=#:G83664) + (RETURN + (SEQ + (COND + ((SPADCALL |l| NIL (QREFELT |$| 38)) + (|error| "empty list passed to principalIdeal")) + ((SPADCALL (CDR |l|) NIL (QREFELT |$| 38)) + (SEQ + (LETT |uca| + (SPADCALL (|SPADfirst| |l|) (QREFELT |$| 22)) + |EUCDOM-;principalIdeal;LR;9|) + (EXIT (CONS (LIST (QVELT |uca| 0)) (QVELT |uca| 1))))) + ((SPADCALL (CDR (CDR |l|)) NIL (QREFELT |$| 38)) + (SEQ + (LETT |u| + (SPADCALL + (|SPADfirst| |l|) + (SPADCALL |l| (QREFELT |$| 39)) + (QREFELT |$| 32)) + |EUCDOM-;principalIdeal;LR;9|) + (EXIT + (CONS (LIST (QVELT |u| 0) (QVELT |u| 1)) (QVELT |u| 2))))) + ((QUOTE T) + (SEQ + (LETT |v| + (SPADCALL (CDR |l|) (QREFELT |$| 42)) + |EUCDOM-;principalIdeal;LR;9|) + (LETT |u| + (SPADCALL (|SPADfirst| |l|) (QCDR |v|) (QREFELT |$| 32)) + |EUCDOM-;principalIdeal;LR;9|) + (EXIT + (CONS + (CONS + (QVELT |u| 0) + (PROGN + (LETT #1# NIL |EUCDOM-;principalIdeal;LR;9|) + (SEQ + (LETT |vv| NIL |EUCDOM-;principalIdeal;LR;9|) + (LETT #2# (QCAR |v|) |EUCDOM-;principalIdeal;LR;9|) + G190 + (COND + ((OR + (ATOM #2#) + (PROGN + (LETT |vv| + (CAR #2#) + |EUCDOM-;principalIdeal;LR;9|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #1# + (CONS + (SPADCALL + (QVELT |u| 1) + |vv| + (QREFELT |$| 24)) + #1#) + |EUCDOM-;principalIdeal;LR;9|))) + (LETT #2# (CDR #2#) |EUCDOM-;principalIdeal;LR;9|) + (GO G190) + G191 + (EXIT (NREVERSE0 #1#))))) + (QVELT |u| 2)))))))))) +@ +\subsubsection{EUCDOM-;expressIdealMember;LSU;10} +<<EUCDOM-;expressIdealMember;LSU;10>>= +(DEFUN |EUCDOM-;expressIdealMember;LSU;10| (|l| |z| |$|) + (PROG (#1=#:G83681 #2=#:G83682 |pid| |q| #3=#:G83679 |v| #4=#:G83680) + (RETURN + (SEQ + (COND + ((SPADCALL |z| (|spadConstant| |$| 26) (QREFELT |$| 44)) + (CONS + 0 + (PROGN + (LETT #1# NIL |EUCDOM-;expressIdealMember;LSU;10|) + (SEQ + (LETT |v| NIL |EUCDOM-;expressIdealMember;LSU;10|) + (LETT #2# |l| |EUCDOM-;expressIdealMember;LSU;10|) + G190 + (COND + ((OR + (ATOM #2#) + (PROGN + (LETT |v| + (CAR #2#) + |EUCDOM-;expressIdealMember;LSU;10|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #1# + (CONS (|spadConstant| |$| 26) #1#) + |EUCDOM-;expressIdealMember;LSU;10|))) + (LETT #2# (CDR #2#) |EUCDOM-;expressIdealMember;LSU;10|) + (GO G190) + G191 + (EXIT (NREVERSE0 #1#)))))) + ((QUOTE T) + (SEQ + (LETT |pid| + (SPADCALL |l| (QREFELT |$| 42)) + |EUCDOM-;expressIdealMember;LSU;10|) + (LETT |q| + (SPADCALL |z| (QCDR |pid|) (QREFELT |$| 33)) + |EUCDOM-;expressIdealMember;LSU;10|) + (EXIT + (COND + ((QEQCAR |q| 1) (CONS 1 "failed")) + ((QUOTE T) + (CONS + 0 + (PROGN + (LETT #3# NIL |EUCDOM-;expressIdealMember;LSU;10|) + (SEQ + (LETT |v| NIL |EUCDOM-;expressIdealMember;LSU;10|) + (LETT #4# (QCAR |pid|) |EUCDOM-;expressIdealMember;LSU;10|) + G190 + (COND + ((OR + (ATOM #4#) + (PROGN + (LETT |v| + (CAR #4#) + |EUCDOM-;expressIdealMember;LSU;10|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #3# + (CONS + (SPADCALL (QCDR |q|) |v| (QREFELT |$| 24)) + #3#) + |EUCDOM-;expressIdealMember;LSU;10|))) + (LETT #4# + (CDR #4#) + |EUCDOM-;expressIdealMember;LSU;10|) + (GO G190) + G191 + (EXIT (NREVERSE0 #3#))))))))))))))) + +@ +\subsubsection{EUCDOM-;multiEuclidean;LSU;11} +<<EUCDOM-;multiEuclidean;LSU;11>>= +(DEFUN |EUCDOM-;multiEuclidean;LSU;11| (|l| |z| |$|) + (PROG (|n| |l1| |l2| #1=#:G83565 #2=#:G83702 #3=#:G83688 #4=#:G83686 + #5=#:G83687 #6=#:G83566 #7=#:G83701 #8=#:G83691 #9=#:G83689 + #10=#:G83690 |u| |v1| |v2|) + (RETURN + (SEQ + (LETT |n| (LENGTH |l|) |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT + (COND + ((ZEROP |n|) (|error| "empty list passed to multiEuclidean")) + ((EQL |n| 1) (CONS 0 (LIST |z|))) + ((QUOTE T) + (SEQ + (LETT |l1| + (SPADCALL |l| (QREFELT |$| 47)) + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT |l2| + (SPADCALL |l1| (QUOTIENT2 |n| 2) (QREFELT |$| 49)) + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT |u| + (SPADCALL + (PROGN + (LETT #5# NIL |EUCDOM-;multiEuclidean;LSU;11|) + (SEQ + (LETT #1# NIL |EUCDOM-;multiEuclidean;LSU;11|) + (LETT #2# |l1| |EUCDOM-;multiEuclidean;LSU;11|) + G190 + (COND + ((OR + (ATOM #2#) + (PROGN + (LETT #1# + (CAR #2#) + |EUCDOM-;multiEuclidean;LSU;11|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (PROGN + (LETT #3# #1# |EUCDOM-;multiEuclidean;LSU;11|) + (COND + (#5# + (LETT #4# + (SPADCALL #4# #3# (QREFELT |$| 24)) + |EUCDOM-;multiEuclidean;LSU;11|)) + ((QUOTE T) + (PROGN + (LETT #4# + #3# + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT #5# + (QUOTE T) + |EUCDOM-;multiEuclidean;LSU;11|))))))) + (LETT #2# (CDR #2#) |EUCDOM-;multiEuclidean;LSU;11|) + (GO G190) + G191 + (EXIT NIL)) + (COND (#5# #4#) ((QUOTE T) (|spadConstant| |$| 25)))) + (PROGN + (LETT #10# NIL |EUCDOM-;multiEuclidean;LSU;11|) + (SEQ + (LETT #6# NIL |EUCDOM-;multiEuclidean;LSU;11|) + (LETT #7# |l2| |EUCDOM-;multiEuclidean;LSU;11|) + G190 + (COND + ((OR + (ATOM #7#) + (PROGN + (LETT #6# + (CAR #7#) + |EUCDOM-;multiEuclidean;LSU;11|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (PROGN + (LETT #8# #6# |EUCDOM-;multiEuclidean;LSU;11|) + (COND + (#10# + (LETT #9# + (SPADCALL #9# #8# (QREFELT |$| 24)) + |EUCDOM-;multiEuclidean;LSU;11|)) + ((QUOTE T) + (PROGN + (LETT #9# + #8# + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT #10# + (QUOTE T) + |EUCDOM-;multiEuclidean;LSU;11|))))))) + (LETT #7# (CDR #7#) |EUCDOM-;multiEuclidean;LSU;11|) + (GO G190) + G191 + (EXIT NIL)) + (COND + (#10# #9#) + ((QUOTE T) (|spadConstant| |$| 25)))) + |z| + (QREFELT |$| 50)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT + (COND + ((QEQCAR |u| 1) (CONS 1 "failed")) + ((QUOTE T) + (SEQ + (LETT |v1| + (SPADCALL |l1| (QCDR (QCDR |u|)) (QREFELT |$| 51)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT + (COND + ((QEQCAR |v1| 1) (CONS 1 "failed")) + ((QUOTE T) + (SEQ + (LETT |v2| + (SPADCALL + |l2| + (QCAR (QCDR |u|)) + (QREFELT |$| 51)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT + (COND + ((QEQCAR |v2| 1) (CONS 1 "failed")) + ((QUOTE T) + (CONS + 0 + (SPADCALL + (QCDR |v1|) + (QCDR |v2|) + (QREFELT |$| 52)))))))))))))))))))))) + +@ +\subsubsection{EuclideanDomain\&} +<<EuclideanDomainAmp>>= +(DEFUN |EuclideanDomain&| (|#1|) + (PROG (|DV$1| |dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |DV$1| (|devaluate| |#1|) . #1=(|EuclideanDomain&|)) + (LETT |dv$| (LIST (QUOTE |EuclideanDomain&|) |DV$1|) . #1#) + (LETT |$| (GETREFV 54) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|stuffDomainSlots| |$|) + (QSETREFV |$| 6 |#1|) + |$|)))) + +@ +\subsubsection{EUCDOM-;MAKEPROP} +<<EUCDOM-;MAKEPROP>>= +(MAKEPROP + (QUOTE |EuclideanDomain&|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL NIL + (|local| |#1|) + (|Boolean|) + (0 . |zero?|) + (|NonNegativeInteger|) + (5 . |euclideanSize|) + |EUCDOM-;sizeLess?;2SB;1| + (|Record| (|:| |quotient| |$|) (|:| |remainder| |$|)) + (10 . |divide|) + |EUCDOM-;quo;3S;2| + |EUCDOM-;rem;3S;3| + (|Union| |$| (QUOTE "failed")) + |EUCDOM-;exquo;2SU;4| + (16 . |unitCanonical|) + (21 . |rem|) + |EUCDOM-;gcd;3S;5| + (|Record| (|:| |unit| |$|) (|:| |canonical| |$|) (|:| |associate| |$|)) + (27 . |unitNormal|) + (32 . |one?|) + (37 . |*|) + (43 . |One|) + (47 . |Zero|) + (51 . |-|) + (57 . |sizeLess?|) + (63 . |+|) + (|Record| (|:| |coef1| |$|) (|:| |coef2| |$|) (|:| |generator| |$|)) + |EUCDOM-;extendedEuclidean;2SR;7| + (69 . |extendedEuclidean|) + (75 . |exquo|) + (|Record| (|:| |coef1| |$|) (|:| |coef2| |$|)) + (|Union| 34 (QUOTE "failed")) + |EUCDOM-;extendedEuclidean;3SU;8| + (|List| 6) + (81 . |=|) + (87 . |second|) + (|Record| (|:| |coef| 41) (|:| |generator| |$|)) + (|List| |$|) + (92 . |principalIdeal|) + |EUCDOM-;principalIdeal;LR;9| + (97 . |=|) + (|Union| 41 (QUOTE "failed")) + |EUCDOM-;expressIdealMember;LSU;10| + (103 . |copy|) + (|Integer|) + (108 . |split!|) + (114 . |extendedEuclidean|) + (121 . |multiEuclidean|) + (127 . |concat|) + |EUCDOM-;multiEuclidean;LSU;11|)) + (QUOTE + #(|sizeLess?| 133 |rem| 139 |quo| 145 |principalIdeal| 151 + |multiEuclidean| 156 |gcd| 162 |extendedEuclidean| 168 |exquo| 181 + |expressIdealMember| 187)) + (QUOTE NIL) + (CONS + (|makeByteWordVec2| 1 (QUOTE NIL)) + (CONS + (QUOTE #()) + (CONS + (QUOTE #()) + (|makeByteWordVec2| 53 + (QUOTE + (1 6 7 0 8 1 6 9 0 10 2 6 12 0 0 13 1 6 0 0 18 2 6 0 0 0 19 1 6 + 21 0 22 1 6 7 0 23 2 6 0 0 0 24 0 6 0 25 0 6 0 26 2 6 0 0 0 27 + 2 6 7 0 0 28 2 6 0 0 0 29 2 6 30 0 0 32 2 6 16 0 0 33 2 37 7 0 + 0 38 1 37 6 0 39 1 6 40 41 42 2 6 7 0 0 44 1 37 0 0 47 2 37 0 0 + 48 49 3 6 35 0 0 0 50 2 6 45 41 0 51 2 37 0 0 0 52 2 0 7 0 0 11 + 2 0 0 0 0 15 2 0 0 0 0 14 1 0 40 41 43 2 0 45 41 0 53 2 0 0 0 0 + 20 3 0 35 0 0 0 36 2 0 30 0 0 31 2 0 16 0 0 17 2 0 45 41 0 + 46)))))) + (QUOTE |lookupComplete|))) + +@ +<<EUCDOM-.lsp BOOTSTRAP>>= + +<<EUCDOM-;VersionCheck>> +<<EUCDOM-;sizeLess?;2SB;1>> +<<EUCDOM-;quo;3S;2>> +<<EUCDOM-;rem;3S;3>> +<<EUCDOM-;exquo;2SU;4>> +<<EUCDOM-;gcd;3S;5>> +<<EUCDOM-;unitNormalizeIdealElt>> +<<EUCDOM-;extendedEuclidean;2SR;7>> +<<EUCDOM-;extendedEuclidean;3SU;8>> +<<EUCDOM-;principalIdeal;LR;9>> +<<EUCDOM-;expressIdealMember;LSU;10>> +<<EUCDOM-;multiEuclidean;LSU;11>> +<<EuclideanDomainAmp>> +<<EUCDOM-;MAKEPROP>> +@ +\section{category FIELD Field} +<<category FIELD Field>>= +)abbrev category FIELD Field +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The category of commutative fields, i.e. commutative rings +++ where all non-zero elements have multiplicative inverses. +++ The \spadfun{factor} operation while trivial is useful to have defined. +++ +++ Axioms: +++ \spad{a*(b/a) = b} +++ \spad{inv(a) = 1/a} + +Field(): Category == Join(EuclideanDomain,UniqueFactorizationDomain, + DivisionRing) with + --operations + "/": (%,%) -> % + ++ x/y divides the element x by the element y. + ++ Error: if y is 0. + canonicalUnitNormal ++ either 0 or 1. + canonicalsClosed ++ since \spad{0*0=0}, \spad{1*1=1} + add + --declarations + x,y: % + n: Integer + -- definitions + UCA ==> Record(unit:%,canonical:%,associate:%) + unitNormal(x) == + if zero? x then [1$%,0$%,1$%]$UCA else [x,1$%,inv(x)]$UCA + unitCanonical(x) == if zero? x then x else 1 + associates?(x,y) == if zero? x then zero? y else not(zero? y) + inv x ==((u:=recip x) case "failed" => error "not invertible"; u) + x exquo y == (y=0 => "failed"; x / y) + gcd(x,y) == 1 + euclideanSize(x) == 0 + prime? x == false + squareFree x == x::Factored(%) + factor x == x::Factored(%) + x / y == (zero? y => error "catdef: division by zero"; x * inv(y)) + divide(x,y) == [x / y,0] + +@ +\section{category FINITE Finite} +<<category FINITE Finite>>= +)abbrev category FINITE Finite +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The category of domains composed of a finite set of elements. +++ We include the functions \spadfun{lookup} and \spadfun{index} to give a bijection +++ between the finite set and an initial segment of positive integers. +++ +++ Axioms: +++ \spad{lookup(index(n)) = n} +++ \spad{index(lookup(s)) = s} + +Finite(): Category == SetCategory with + --operations + size: () -> NonNegativeInteger + ++ size() returns the number of elements in the set. + index: PositiveInteger -> % + ++ index(i) takes a positive integer i less than or equal + ++ to \spad{size()} and + ++ returns the \spad{i}-th element of the set. This operation establishs a bijection + ++ between the elements of the finite set and \spad{1..size()}. + lookup: % -> PositiveInteger + ++ lookup(x) returns a positive integer such that + ++ \spad{x = index lookup x}. + random: () -> % + ++ random() returns a random element from the set. + +@ +\section{category FLINEXP FullyLinearlyExplicitRingOver} +<<category FLINEXP FullyLinearlyExplicitRingOver>>= +)abbrev category FLINEXP FullyLinearlyExplicitRingOver +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ S is \spadtype{FullyLinearlyExplicitRingOver R} means that S is a +++ \spadtype{LinearlyExplicitRingOver R} and, in addition, if R is a +++ \spadtype{LinearlyExplicitRingOver Integer}, then so is S +FullyLinearlyExplicitRingOver(R:Ring):Category == + LinearlyExplicitRingOver R with + if (R has LinearlyExplicitRingOver Integer) then + LinearlyExplicitRingOver Integer + add + if not(R is Integer) then + if (R has LinearlyExplicitRingOver Integer) then + reducedSystem(m:Matrix %):Matrix(Integer) == + reducedSystem(reducedSystem(m)@Matrix(R)) + + reducedSystem(m:Matrix %, v:Vector %): + Record(mat:Matrix(Integer), vec:Vector(Integer)) == + rec := reducedSystem(m, v)@Record(mat:Matrix R, vec:Vector R) + reducedSystem(rec.mat, rec.vec) + +@ +\section{category GCDDOM GcdDomain} +<<category GCDDOM GcdDomain>>= +)abbrev category GCDDOM GcdDomain +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: Davenport & Trager 1 +++ Description: +++ This category describes domains where +++ \spadfun{gcd} can be computed but where there is no guarantee +++ of the existence of \spadfun{factor} operation for factorisation into irreducibles. +++ However, if such a \spadfun{factor} operation exist, factorization will be +++ unique up to order and units. + +GcdDomain(): Category == IntegralDomain with + --operations + gcd: (%,%) -> % + ++ gcd(x,y) returns the greatest common divisor of x and y. + -- gcd(x,y) = gcd(y,x) in the presence of canonicalUnitNormal, + -- but not necessarily elsewhere + gcd: List(%) -> % + ++ gcd(l) returns the common gcd of the elements in the list l. + lcm: (%,%) -> % + ++ lcm(x,y) returns the least common multiple of x and y. + -- lcm(x,y) = lcm(y,x) in the presence of canonicalUnitNormal, + -- but not necessarily elsewhere + lcm: List(%) -> % + ++ lcm(l) returns the least common multiple of the elements of the list l. + gcdPolynomial: (SparseUnivariatePolynomial %, SparseUnivariatePolynomial %) -> + SparseUnivariatePolynomial % + ++ gcdPolynomial(p,q) returns the greatest common divisor (gcd) of + ++ univariate polynomials over the domain + add + lcm(x: %,y: %) == + y = 0 => 0 + x = 0 => 0 + LCM : Union(%,"failed") := y exquo gcd(x,y) + LCM case % => x * LCM + error "bad gcd in lcm computation" + lcm(l:List %) == reduce(lcm,l,1,0) + gcd(l:List %) == reduce(gcd,l,0,1) + SUP ==> SparseUnivariatePolynomial + gcdPolynomial(p1,p2) == + zero? p1 => unitCanonical p2 + zero? p2 => unitCanonical p1 + c1:= content(p1); c2:= content(p2) + p1:= (p1 exquo c1)::SUP % + p2:= (p2 exquo c2)::SUP % + if (e1:=minimumDegree p1) > 0 then p1:=(p1 exquo monomial(1,e1))::SUP % + if (e2:=minimumDegree p2) > 0 then p2:=(p2 exquo monomial(1,e2))::SUP % + e1:=min(e1,e2); c1:=gcd(c1,c2) + p1:= + degree p1 = 0 or degree p2 = 0 => monomial(c1,0) + p:= subResultantGcd(p1,p2) + degree p = 0 => monomial(c1,0) + c2:= gcd(leadingCoefficient p1,leadingCoefficient p2) + unitCanonical(c1 * primitivePart(((c2*p) exquo leadingCoefficient p)::SUP %)) + zero? e1 => p1 + monomial(1,e1)*p1 + +@ +\section{GCDDOM.lsp BOOTSTRAP} +{\bf GCDDOM} needs +{\bf COMRING} which needs +{\bf RING} which needs +{\bf RNG} which needs +{\bf ABELGRP} which needs +{\bf CABMON} which needs +{\bf ABELMON} which needs +{\bf ABELSG} which needs +{\bf SETCAT} which needs +{\bf SINT} which needs +{\bf UFD} which needs +{\bf GCDDOM}. +We break this chain with {\bf GCDDOM.lsp} which we +cache here. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf GCDDOM} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf GCDDOM.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<GCDDOM.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |GcdDomain;AL| (QUOTE NIL)) + +(DEFUN |GcdDomain| NIL + (LET (#:G83171) + (COND + (|GcdDomain;AL|) + (T (SETQ |GcdDomain;AL| (|GcdDomain;|)))))) + +(DEFUN |GcdDomain;| NIL + (PROG (#1=#:G83169) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|IntegralDomain|) + (|mkCategory| + (QUOTE |domain|) + (QUOTE ( + ((|gcd| (|$| |$| |$|)) T) + ((|gcd| (|$| (|List| |$|))) T) + ((|lcm| (|$| |$| |$|)) T) + ((|lcm| (|$| (|List| |$|))) T) + ((|gcdPolynomial| + ((|SparseUnivariatePolynomial| |$|) + (|SparseUnivariatePolynomial| |$|) + (|SparseUnivariatePolynomial| |$|))) + T))) + NIL + (QUOTE ((|SparseUnivariatePolynomial| |$|) (|List| |$|))) + NIL)) + |GcdDomain|) + (SETELT #1# 0 (QUOTE (|GcdDomain|))))))) + +(MAKEPROP (QUOTE |GcdDomain|) (QUOTE NILADIC) T) + +@ +\section{GCDDOM-.lsp BOOTSTRAP} +{\bf GCDDOM-} depends on {\bf GCDDOM}. +We break this chain with {\bf GCDDOM-.lsp} which we +cache here. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf GCDDOM-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf GCDDOM-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<GCDDOM-.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(DEFUN |GCDDOM-;lcm;3S;1| (|x| |y| |$|) + (PROG (LCM) + (RETURN + (SEQ + (COND + ((OR + (SPADCALL |y| (|spadConstant| |$| 7) (QREFELT |$| 9)) + (SPADCALL |x| (|spadConstant| |$| 7) (QREFELT |$| 9))) + (|spadConstant| |$| 7)) + ((QUOTE T) + (SEQ + (LETT LCM + (SPADCALL |y| + (SPADCALL |x| |y| (QREFELT |$| 10)) + (QREFELT |$| 12)) + |GCDDOM-;lcm;3S;1|) + (EXIT + (COND + ((QEQCAR LCM 0) (SPADCALL |x| (QCDR LCM) (QREFELT |$| 13))) + ((QUOTE T) (|error| "bad gcd in lcm computation"))))))))))) + +(DEFUN |GCDDOM-;lcm;LS;2| (|l| |$|) + (SPADCALL + (ELT |$| 15) + |l| + (|spadConstant| |$| 16) + (|spadConstant| |$| 7) + (QREFELT |$| 19))) + +(DEFUN |GCDDOM-;gcd;LS;3| (|l| |$|) + (SPADCALL + (ELT |$| 10) + |l| + (|spadConstant| |$| 7) + (|spadConstant| |$| 16) + (QREFELT |$| 19))) + +(DEFUN |GCDDOM-;gcdPolynomial;3Sup;4| (|p1| |p2| |$|) + (PROG (|e2| |e1| |c1| |p| |c2| #1=#:G83191) + (RETURN + (SEQ + (COND + ((SPADCALL |p1| (QREFELT |$| 24)) (SPADCALL |p2| (QREFELT |$| 25))) + ((SPADCALL |p2| (QREFELT |$| 24)) (SPADCALL |p1| (QREFELT |$| 25))) + ((QUOTE T) + (SEQ + (LETT |c1| + (SPADCALL |p1| (QREFELT |$| 26)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |c2| + (SPADCALL |p2| (QREFELT |$| 26)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |p1| + (PROG2 + (LETT #1# + (SPADCALL |p1| |c1| (QREFELT |$| 27)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (QCDR #1#) + (|check-union| + (QEQCAR #1# 0) + (|SparseUnivariatePolynomial| (QREFELT |$| 6)) + #1#)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |p2| + (PROG2 + (LETT #1# + (SPADCALL |p2| |c2| (QREFELT |$| 27)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (QCDR #1#) + (|check-union| + (QEQCAR #1# 0) + (|SparseUnivariatePolynomial| (QREFELT |$| 6)) + #1#)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (SEQ + (LETT |e1| + (SPADCALL |p1| (QREFELT |$| 29)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT + (COND + ((|<| 0 |e1|) + (LETT |p1| + (PROG2 + (LETT #1# + (SPADCALL |p1| + (SPADCALL + (|spadConstant| |$| 16) |e1| (QREFELT |$| 32)) + (QREFELT |$| 33)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (QCDR #1#) + (|check-union| + (QEQCAR #1# 0) + (|SparseUnivariatePolynomial| (QREFELT |$| 6)) + #1#)) + |GCDDOM-;gcdPolynomial;3Sup;4|))))) + (SEQ + (LETT |e2| + (SPADCALL |p2| (QREFELT |$| 29)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT + (COND + ((|<| 0 |e2|) + (LETT |p2| + (PROG2 + (LETT #1# + (SPADCALL |p2| + (SPADCALL + (|spadConstant| |$| 16) + |e2| + (QREFELT |$| 32)) + (QREFELT |$| 33)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (QCDR #1#) + (|check-union| + (QEQCAR #1# 0) + (|SparseUnivariatePolynomial| (QREFELT |$| 6)) + #1#)) + |GCDDOM-;gcdPolynomial;3Sup;4|))))) + (LETT |e1| + (MIN |e1| |e2|) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |c1| + (SPADCALL |c1| |c2| (QREFELT |$| 10)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |p1| + (COND + ((OR + (EQL (SPADCALL |p1| (QREFELT |$| 34)) 0) + (EQL (SPADCALL |p2| (QREFELT |$| 34)) 0)) + (SPADCALL |c1| 0 (QREFELT |$| 32))) + ((QUOTE T) + (SEQ + (LETT |p| + (SPADCALL |p1| |p2| (QREFELT |$| 35)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT + (COND + ((EQL (SPADCALL |p| (QREFELT |$| 34)) 0) + (SPADCALL |c1| 0 (QREFELT |$| 32))) + ((QUOTE T) + (SEQ + (LETT |c2| + (SPADCALL + (SPADCALL |p1| (QREFELT |$| 36)) + (SPADCALL |p2| (QREFELT |$| 36)) + (QREFELT |$| 10)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT + (SPADCALL + (SPADCALL |c1| + (SPADCALL + (PROG2 + (LETT #1# + (SPADCALL + (SPADCALL + |c2| + |p| + (QREFELT |$| 37)) + (SPADCALL |p| (QREFELT |$| 36)) + (QREFELT |$| 27)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (QCDR #1#) + (|check-union| + (QEQCAR #1# 0) + (|SparseUnivariatePolynomial| + (QREFELT |$| 6)) + #1#)) + (QREFELT |$| 38)) + (QREFELT |$| 37)) + (QREFELT |$| 25)))))))))) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT (COND ((ZEROP |e1|) |p1|) ((QUOTE T) (SPADCALL (SPADCALL (|spadConstant| |$| 16) |e1| (QREFELT |$| 32)) |p1| (QREFELT |$| 39)))))))))))) + +(DEFUN |GcdDomain&| (|#1|) + (PROG (|DV$1| |dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |DV$1| (|devaluate| |#1|) . #1=(|GcdDomain&|)) + (LETT |dv$| (LIST (QUOTE |GcdDomain&|) |DV$1|) . #1#) + (LETT |$| (GETREFV 42) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|stuffDomainSlots| |$|) + (QSETREFV |$| 6 |#1|) + |$|)))) + +(MAKEPROP + (QUOTE |GcdDomain&|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL NIL + (|local| |#1|) + (0 . |Zero|) + (|Boolean|) + (4 . |=|) + (10 . |gcd|) + (|Union| |$| (QUOTE "failed")) + (16 . |exquo|) + (22 . |*|) + |GCDDOM-;lcm;3S;1| + (28 . |lcm|) + (34 . |One|) + (|Mapping| 6 6 6) + (|List| 6) + (38 . |reduce|) + (|List| |$|) + |GCDDOM-;lcm;LS;2| + |GCDDOM-;gcd;LS;3| + (|SparseUnivariatePolynomial| 6) + (46 . |zero?|) + (51 . |unitCanonical|) + (56 . |content|) + (61 . |exquo|) + (|NonNegativeInteger|) + (67 . |minimumDegree|) + (72 . |Zero|) + (76 . |One|) + (80 . |monomial|) + (86 . |exquo|) + (92 . |degree|) + (97 . |subResultantGcd|) + (103 . |leadingCoefficient|) + (108 . |*|) + (114 . |primitivePart|) + (119 . |*|) + (|SparseUnivariatePolynomial| |$|) + |GCDDOM-;gcdPolynomial;3Sup;4|)) + (QUOTE #(|lcm| 125 |gcdPolynomial| 136 |gcd| 142)) + (QUOTE NIL) + (CONS + (|makeByteWordVec2| 1 (QUOTE NIL)) + (CONS + (QUOTE #()) + (CONS + (QUOTE #()) + (|makeByteWordVec2| 41 + (QUOTE (0 6 0 7 2 6 8 0 0 9 2 6 0 0 0 10 2 6 11 0 0 12 2 6 0 0 0 + 13 2 6 0 0 0 15 0 6 0 16 4 18 6 17 0 6 6 19 1 23 8 0 24 + 1 23 0 0 25 1 23 6 0 26 2 23 11 0 6 27 1 23 28 0 29 0 23 + 0 30 0 23 0 31 2 23 0 6 28 32 2 23 11 0 0 33 1 23 28 0 + 34 2 23 0 0 0 35 1 23 6 0 36 2 23 0 6 0 37 1 23 0 0 38 2 + 23 0 0 0 39 1 0 0 20 21 2 0 0 0 0 14 2 0 40 40 40 41 1 0 + 0 20 22)))))) + (QUOTE |lookupComplete|))) + +@ +\section{category GROUP Group} +<<category GROUP Group>>= +)abbrev category GROUP Group +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The class of multiplicative groups, i.e. monoids with +++ multiplicative inverses. +++ +++ Axioms: +++ \spad{leftInverse("*":(%,%)->%,inv)}\tab{30}\spad{ inv(x)*x = 1 } +++ \spad{rightInverse("*":(%,%)->%,inv)}\tab{30}\spad{ x*inv(x) = 1 } +Group(): Category == Monoid with + --operations + inv: % -> % ++ inv(x) returns the inverse of x. + "/": (%,%) -> % ++ x/y is the same as x times the inverse of y. + "**": (%,Integer) -> % ++ x**n returns x raised to the integer power n. + "^": (%,Integer) -> % ++ x^n returns x raised to the integer power n. + unitsKnown ++ unitsKnown asserts that recip only returns + ++ "failed" for non-units. + conjugate: (%,%) -> % + ++ conjugate(p,q) computes \spad{inv(q) * p * q}; this is 'right action + ++ by conjugation'. + commutator: (%,%) -> % + ++ commutator(p,q) computes \spad{inv(p) * inv(q) * p * q}. + add + import RepeatedSquaring(%) + x:% / y:% == x*inv(y) + recip(x:%) == inv(x) + _^(x:%, n:Integer):% == x ** n + x:% ** n:Integer == + zero? n => 1 + n<0 => expt(inv(x),(-n) pretend PositiveInteger) + expt(x,n pretend PositiveInteger) + conjugate(p,q) == inv(q) * p * q + commutator(p,q) == inv(p) * inv(q) * p * q + +@ +\section{category INTDOM IntegralDomain} +<<category INTDOM IntegralDomain>>= +)abbrev category INTDOM IntegralDomain +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: Davenport & Trager I +++ Description: +++ The category of commutative integral domains, i.e. commutative +++ rings with no zero divisors. +++ +++ Conditional attributes: +++ canonicalUnitNormal\tab{20}the canonical field is the same for all associates +++ canonicalsClosed\tab{20}the product of two canonicals is itself canonical + +IntegralDomain(): Category == +-- Join(CommutativeRing, Algebra(%:CommutativeRing), EntireRing) with + Join(CommutativeRing, Algebra(%), EntireRing) with + --operations + "exquo": (%,%) -> Union(%,"failed") + ++ exquo(a,b) either returns an element c such that + ++ \spad{c*b=a} or "failed" if no such element can be found. + unitNormal: % -> Record(unit:%,canonical:%,associate:%) + ++ unitNormal(x) tries to choose a canonical element + ++ from the associate class of x. + ++ The attribute canonicalUnitNormal, if asserted, means that + ++ the "canonical" element is the same across all associates of x + ++ if \spad{unitNormal(x) = [u,c,a]} then + ++ \spad{u*c = x}, \spad{a*u = 1}. + unitCanonical: % -> % + ++ \spad{unitCanonical(x)} returns \spad{unitNormal(x).canonical}. + associates?: (%,%) -> Boolean + ++ associates?(x,y) tests whether x and y are associates, i.e. + ++ differ by a unit factor. + unit?: % -> Boolean + ++ unit?(x) tests whether x is a unit, i.e. is invertible. + add + -- declaration + x,y: % + -- definitions + UCA ==> Record(unit:%,canonical:%,associate:%) + if not (% has Field) then + unitNormal(x) == [1$%,x,1$%]$UCA -- the non-canonical definition + unitCanonical(x) == unitNormal(x).canonical -- always true + recip(x) == if zero? x then "failed" else _exquo(1$%,x) + unit?(x) == (recip x case "failed" => false; true) + if % has canonicalUnitNormal then + associates?(x,y) == + (unitNormal x).canonical = (unitNormal y).canonical + else + associates?(x,y) == + zero? x => zero? y + zero? y => false + x exquo y case "failed" => false + y exquo x case "failed" => false + true + +@ +\section{INTDOM.lsp BOOTSTRAP} +{\bf INTDOM} depends on itself. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf INTDOM} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf INTDOM.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<INTDOM.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |IntegralDomain;AL| (QUOTE NIL)) + +(DEFUN |IntegralDomain| NIL + (LET (#:G83060) + (COND + (|IntegralDomain;AL|) + (T (SETQ |IntegralDomain;AL| (|IntegralDomain;|)))))) + +(DEFUN |IntegralDomain;| NIL + (PROG (#1=#:G83058) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|CommutativeRing|) + (|Algebra| (QUOTE |$|)) + (|EntireRing|) + (|mkCategory| + (QUOTE |domain|) + (QUOTE ( + ((|exquo| ((|Union| |$| "failed") |$| |$|)) T) + ((|unitNormal| + ((|Record| + (|:| |unit| |$|) + (|:| |canonical| |$|) + (|:| |associate| |$|)) |$|)) T) + ((|unitCanonical| (|$| |$|)) T) + ((|associates?| ((|Boolean|) |$| |$|)) T) + ((|unit?| ((|Boolean|) |$|)) T))) + NIL + (QUOTE ((|Boolean|))) + NIL)) + |IntegralDomain|) + (SETELT #1# 0 (QUOTE (|IntegralDomain|))))))) + +(MAKEPROP (QUOTE |IntegralDomain|) (QUOTE NILADIC) T) + +@ +\section{INTDOM-.lsp BOOTSTRAP} +{\bf INTDOM-} depends on {\bf INTDOM}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf INTDOM-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf INTDOM-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<INTDOM-.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(DEFUN |INTDOM-;unitNormal;SR;1| (|x| |$|) + (VECTOR (|spadConstant| |$| 7) |x| (|spadConstant| |$| 7))) + +(DEFUN |INTDOM-;unitCanonical;2S;2| (|x| |$|) + (QVELT (SPADCALL |x| (QREFELT |$| 10)) 1)) + +(DEFUN |INTDOM-;recip;SU;3| (|x| |$|) + (COND + ((SPADCALL |x| (QREFELT |$| 13)) (CONS 1 "failed")) + ((QUOTE T) (SPADCALL (|spadConstant| |$| 7) |x| (QREFELT |$| 15))))) + +(DEFUN |INTDOM-;unit?;SB;4| (|x| |$|) + (COND + ((QEQCAR (SPADCALL |x| (QREFELT |$| 17)) 1) (QUOTE NIL)) + ((QUOTE T) (QUOTE T)))) + +(DEFUN |INTDOM-;associates?;2SB;5| (|x| |y| |$|) + (SPADCALL + (QVELT (SPADCALL |x| (QREFELT |$| 10)) 1) + (QVELT (SPADCALL |y| (QREFELT |$| 10)) 1) + (QREFELT |$| 19))) + +(DEFUN |INTDOM-;associates?;2SB;6| (|x| |y| |$|) + (COND + ((SPADCALL |x| (QREFELT |$| 13)) (SPADCALL |y| (QREFELT |$| 13))) + ((OR + (SPADCALL |y| (QREFELT |$| 13)) + (OR + (QEQCAR (SPADCALL |x| |y| (QREFELT |$| 15)) 1) + (QEQCAR (SPADCALL |y| |x| (QREFELT |$| 15)) 1))) + (QUOTE NIL)) + ((QUOTE T) (QUOTE T)))) + +(DEFUN |IntegralDomain&| (|#1|) + (PROG (|DV$1| |dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |DV$1| (|devaluate| |#1|) . #1=(|IntegralDomain&|)) + (LETT |dv$| (LIST (QUOTE |IntegralDomain&|) |DV$1|) . #1#) + (LETT |$| (GETREFV 21) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|stuffDomainSlots| |$|) + (QSETREFV |$| 6 |#1|) + (COND + ((|HasCategory| |#1| (QUOTE (|Field|)))) + ((QUOTE T) + (QSETREFV |$| 9 + (CONS (|dispatchFunction| |INTDOM-;unitNormal;SR;1|) |$|)))) + (COND + ((|HasAttribute| |#1| (QUOTE |canonicalUnitNormal|)) + (QSETREFV |$| 20 + (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;5|) |$|))) + ((QUOTE T) + (QSETREFV |$| 20 + (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;6|) |$|)))) + |$|)))) + +(MAKEPROP + (QUOTE |IntegralDomain&|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL NIL + (|local| |#1|) + (0 . |One|) + (|Record| (|:| |unit| |$|) (|:| |canonical| |$|) (|:| |associate| |$|)) + (4 . |unitNormal|) + (9 . |unitNormal|) + |INTDOM-;unitCanonical;2S;2| + (|Boolean|) + (14 . |zero?|) + (|Union| |$| (QUOTE "failed")) + (19 . |exquo|) + |INTDOM-;recip;SU;3| + (25 . |recip|) + |INTDOM-;unit?;SB;4| + (30 . |=|) + (36 . |associates?|))) + (QUOTE + #(|unitNormal| 42 |unitCanonical| 47 |unit?| 52 |recip| 57 + |associates?| 62)) + (QUOTE NIL) + (CONS + (|makeByteWordVec2| 1 (QUOTE NIL)) + (CONS + (QUOTE #()) + (CONS + (QUOTE #()) + (|makeByteWordVec2| 20 + (QUOTE + (0 6 0 7 1 0 8 0 9 1 6 8 0 10 1 6 12 0 13 2 6 14 0 0 15 1 6 14 + 0 17 2 6 12 0 0 19 2 0 12 0 0 20 1 0 8 0 9 1 0 0 0 11 1 0 12 0 + 18 1 0 14 0 16 2 0 12 0 0 20)))))) + (QUOTE |lookupComplete|))) + +@ +\section{category LMODULE LeftModule} +<<category LMODULE LeftModule>>= +)abbrev category LMODULE LeftModule +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The category of left modules over an rng (ring not necessarily with unit). +++ This is an abelian group which supports left multiplation by elements of +++ the rng. +++ +++ Axioms: +++ \spad{ (a*b)*x = a*(b*x) } +++ \spad{ (a+b)*x = (a*x)+(b*x) } +++ \spad{ a*(x+y) = (a*x)+(a*y) } +LeftModule(R:Rng):Category == AbelianGroup with + --operations + "*": (R,%) -> % ++ r*x returns the left multiplication of the module element x + ++ by the ring element r. + +@ +\section{category LINEXP LinearlyExplicitRingOver} +<<category LINEXP LinearlyExplicitRingOver>>= +)abbrev category LINEXP LinearlyExplicitRingOver +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ An extension ring with an explicit linear dependence test. +LinearlyExplicitRingOver(R:Ring): Category == Ring with + reducedSystem: Matrix % -> Matrix R + ++ reducedSystem(A) returns a matrix B such that \spad{A x = 0} and \spad{B x = 0} + ++ have the same solutions in R. + reducedSystem: (Matrix %,Vector %) -> Record(mat:Matrix R,vec:Vector R) + ++ reducedSystem(A, v) returns a matrix B and a vector w such that + ++ \spad{A x = v} and \spad{B x = w} have the same solutions in R. + +@ +\section{category MODULE Module} +<<category MODULE Module>>= +)abbrev category MODULE Module +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The category of modules over a commutative ring. +++ +++ Axioms: +++ \spad{1*x = x} +++ \spad{(a*b)*x = a*(b*x)} +++ \spad{(a+b)*x = (a*x)+(b*x)} +++ \spad{a*(x+y) = (a*x)+(a*y)} +Module(R:CommutativeRing): Category == BiModule(R,R) + add + if not(R is %) then x:%*r:R == r*x + +@ +\section{category MONOID Monoid} +<<category MONOID Monoid>>= +)abbrev category MONOID Monoid +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The class of multiplicative monoids, i.e. semigroups with a +++ multiplicative identity element. +++ +++ Axioms: +++ \spad{leftIdentity("*":(%,%)->%,1)}\tab{30}\spad{1*x=x} +++ \spad{rightIdentity("*":(%,%)->%,1)}\tab{30}\spad{x*1=x} +++ +++ Conditional attributes: +++ unitsKnown\tab{15}\spadfun{recip} only returns "failed" on non-units +Monoid(): Category == SemiGroup with + --operations + 1: constant -> % ++ 1 is the multiplicative identity. + sample: constant -> % ++ sample yields a value of type % + one?: % -> Boolean ++ one?(x) tests if x is equal to 1. + "**": (%,NonNegativeInteger) -> % ++ x**n returns the repeated product + ++ of x n times, i.e. exponentiation. + "^" : (%,NonNegativeInteger) -> % ++ x^n returns the repeated product + ++ of x n times, i.e. exponentiation. + recip: % -> Union(%,"failed") + ++ recip(x) tries to compute the multiplicative inverse for x + ++ or "failed" if it cannot find the inverse (see unitsKnown). + add + import RepeatedSquaring(%) + _^(x:%, n:NonNegativeInteger):% == x ** n + one? x == x = 1 + sample() == 1 + recip x == +-- one? x => x + (x = 1) => x + "failed" + x:% ** n:NonNegativeInteger == + zero? n => 1 + expt(x,n pretend PositiveInteger) + +@ +\section{MONOID.lsp BOOTSTRAP} +{\bf MONOID} depends on itself. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf MONOID} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf MONOID.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<MONOID.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |Monoid;AL| (QUOTE NIL)) + +(DEFUN |Monoid| NIL + (LET (#:G82434) + (COND + (|Monoid;AL|) + (T (SETQ |Monoid;AL| (|Monoid;|)))))) + +(DEFUN |Monoid;| NIL + (PROG (#1=#:G82432) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|SemiGroup|) + (|mkCategory| + (QUOTE |domain|) + (QUOTE ( + ((|One| (|$|) |constant|) T) + ((|sample| (|$|) |constant|) T) + ((|one?| ((|Boolean|) |$|)) T) + ((|**| (|$| |$| (|NonNegativeInteger|))) T) + ((|^| (|$| |$| (|NonNegativeInteger|))) T) + ((|recip| ((|Union| |$| "failed") |$|)) T))) + NIL + (QUOTE ((|NonNegativeInteger|) (|Boolean|))) + NIL)) + |Monoid|) + (SETELT #1# 0 (QUOTE (|Monoid|))))))) + +(MAKEPROP (QUOTE |Monoid|) (QUOTE NILADIC) T) + +@ +\section{MONOID-.lsp BOOTSTRAP} +{\bf MONOID-} depends on {\bf MONOID}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf MONOID-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf MONOID-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<MONOID-.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(DEFUN |MONOID-;^;SNniS;1| (|x| |n| |$|) + (SPADCALL |x| |n| (QREFELT |$| 8))) + +(DEFUN |MONOID-;one?;SB;2| (|x| |$|) + (SPADCALL |x| (|spadConstant| |$| 10) (QREFELT |$| 12))) + +(DEFUN |MONOID-;sample;S;3| (|$|) + (|spadConstant| |$| 10)) + +(DEFUN |MONOID-;recip;SU;4| (|x| |$|) + (COND + ((SPADCALL |x| (QREFELT |$| 15)) (CONS 0 |x|)) + ((QUOTE T) (CONS 1 "failed")))) + +(DEFUN |MONOID-;**;SNniS;5| (|x| |n| |$|) + (COND + ((ZEROP |n|) (|spadConstant| |$| 10)) + ((QUOTE T) (SPADCALL |x| |n| (QREFELT |$| 20))))) + +(DEFUN |Monoid&| (|#1|) + (PROG (|DV$1| |dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |DV$1| (|devaluate| |#1|) . #1=(|Monoid&|)) + (LETT |dv$| (LIST (QUOTE |Monoid&|) |DV$1|) . #1#) + (LETT |$| (GETREFV 22) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|stuffDomainSlots| |$|) + (QSETREFV |$| 6 |#1|) + |$|)))) + +(MAKEPROP + (QUOTE |Monoid&|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL NIL + (|local| |#1|) + (|NonNegativeInteger|) + (0 . |**|) + |MONOID-;^;SNniS;1| + (6 . |One|) + (|Boolean|) + (10 . |=|) + |MONOID-;one?;SB;2| + |MONOID-;sample;S;3| + (16 . |one?|) + (|Union| |$| (QUOTE "failed")) + |MONOID-;recip;SU;4| + (|PositiveInteger|) + (|RepeatedSquaring| 6) + (21 . |expt|) + |MONOID-;**;SNniS;5|)) + (QUOTE #(|sample| 27 |recip| 31 |one?| 36 |^| 41 |**| 47)) + (QUOTE NIL) + (CONS + (|makeByteWordVec2| 1 (QUOTE NIL)) + (CONS + (QUOTE #()) + (CONS + (QUOTE #()) + (|makeByteWordVec2| 21 + (QUOTE + (2 6 0 0 7 8 0 6 0 10 2 6 11 0 0 12 1 6 11 0 15 2 19 6 6 18 20 + 0 0 0 14 1 0 16 0 17 1 0 11 0 13 2 0 0 0 7 9 2 0 0 0 7 21)))))) + (QUOTE |lookupComplete|))) + +@ +\section{category OAGROUP OrderedAbelianGroup} +<<category OAGROUP OrderedAbelianGroup>>= +)abbrev category OAGROUP OrderedAbelianGroup +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ Ordered sets which are also abelian groups, such that the addition preserves +++ the ordering. + +OrderedAbelianGroup(): Category == + Join(OrderedCancellationAbelianMonoid, AbelianGroup) + +@ +\section{category OAMON OrderedAbelianMonoid} +<<category OAMON OrderedAbelianMonoid>>= +)abbrev category OAMON OrderedAbelianMonoid +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ Ordered sets which are also abelian monoids, such that the addition +++ preserves the ordering. + +OrderedAbelianMonoid(): Category == + Join(OrderedAbelianSemiGroup, AbelianMonoid) + +@ +\section{category OAMONS OrderedAbelianMonoidSup} +<<category OAMONS OrderedAbelianMonoidSup>>= +)abbrev category OAMONS OrderedAbelianMonoidSup +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This domain is an OrderedAbelianMonoid with a \spadfun{sup} operation added. +++ The purpose of the \spadfun{sup} operator in this domain is to act as a supremum +++ with respect to the partial order imposed by \spadop{-}, rather than with respect to +++ the total \spad{>} order (since that is "max"). +++ +++ Axioms: +++ \spad{sup(a,b)-a \~~= "failed"} +++ \spad{sup(a,b)-b \~~= "failed"} +++ \spad{x-a \~~= "failed" and x-b \~~= "failed" => x >= sup(a,b)} + +OrderedAbelianMonoidSup(): Category == OrderedCancellationAbelianMonoid with + --operation + sup: (%,%) -> % + ++ sup(x,y) returns the least element from which both + ++ x and y can be subtracted. + +@ +\section{category OASGP OrderedAbelianSemiGroup} +<<category OASGP OrderedAbelianSemiGroup>>= +)abbrev category OASGP OrderedAbelianSemiGroup +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ Ordered sets which are also abelian semigroups, such that the addition +++ preserves the ordering. +++ \spad{ x < y => x+z < y+z} + +OrderedAbelianSemiGroup(): Category == Join(OrderedSet, AbelianMonoid) + +@ +\section{category OCAMON OrderedCancellationAbelianMonoid} +<<category OCAMON OrderedCancellationAbelianMonoid>>= +)abbrev category OCAMON OrderedCancellationAbelianMonoid +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ Ordered sets which are also abelian cancellation monoids, such that the addition +++ preserves the ordering. + +OrderedCancellationAbelianMonoid(): Category == + Join(OrderedAbelianMonoid, CancellationAbelianMonoid) + +@ +\section{category ORDFIN OrderedFinite} +<<category ORDFIN OrderedFinite>>= +)abbrev category ORDFIN OrderedFinite +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ Ordered finite sets. + +OrderedFinite(): Category == Join(OrderedSet, Finite) + +@ +\section{category OINTDOM OrderedIntegralDomain} +<<category OINTDOM OrderedIntegralDomain>>= +)abbrev category OINTDOM OrderedIntegralDomain +++ Author: JH Davenport (after L Gonzalez-Vega) +++ Date Created: 30.1.96 +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ Description: +++ The category of ordered commutative integral domains, where ordering +++ and the arithmetic operations are compatible +++ + +OrderedIntegralDomain(): Category == + Join(IntegralDomain, OrderedRing) + +@ +\section{OINTDOM.lsp BOOTSTRAP} +{\bf OINTDOM} depends on itself. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf OINTDOM} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf OINTDOM.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<OINTDOM.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |OrderedIntegralDomain;AL| (QUOTE NIL)) + +(DEFUN |OrderedIntegralDomain| NIL + (LET (#:G84531) + (COND + (|OrderedIntegralDomain;AL|) + (T (SETQ |OrderedIntegralDomain;AL| (|OrderedIntegralDomain;|)))))) + +(DEFUN |OrderedIntegralDomain;| NIL + (PROG (#1=#:G84529) + (RETURN + (PROG1 + (LETT #1# + (|Join| (|IntegralDomain|) (|OrderedRing|)) |OrderedIntegralDomain|) + (SETELT #1# 0 (QUOTE (|OrderedIntegralDomain|))))))) + +(MAKEPROP (QUOTE |OrderedIntegralDomain|) (QUOTE NILADIC) T) + +@ +\section{category ORDMON OrderedMonoid} +<<category ORDMON OrderedMonoid>>= +)abbrev category ORDMON OrderedMonoid +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ Ordered sets which are also monoids, such that multiplication +++ preserves the ordering. +++ +++ Axioms: +++ \spad{x < y => x*z < y*z} +++ \spad{x < y => z*x < z*y} + +OrderedMonoid(): Category == Join(OrderedSet, Monoid) + +@ +\section{category ORDRING OrderedRing} +<<category ORDRING OrderedRing>>= +)abbrev category ORDRING OrderedRing +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ Ordered sets which are also rings, that is, domains where the ring +++ operations are compatible with the ordering. +++ +++ Axiom: +++ \spad{0<a and b<c => ab< ac} + +OrderedRing(): Category == Join(OrderedAbelianGroup,Ring,Monoid) with + positive?: % -> Boolean + ++ positive?(x) tests whether x is strictly greater than 0. + negative?: % -> Boolean + ++ negative?(x) tests whether x is strictly less than 0. + sign : % -> Integer + ++ sign(x) is 1 if x is positive, -1 if x is negative, 0 if x equals 0. + abs : % -> % + ++ abs(x) returns the absolute value of x. + add + positive? x == x>0 + negative? x == x<0 + sign x == + positive? x => 1 + negative? x => -1 + zero? x => 0 + error "x satisfies neither positive?, negative? or zero?" + abs x == + positive? x => x + negative? x => -x + zero? x => 0 + error "x satisfies neither positive?, negative? or zero?" + +@ +\section{ORDRING.lsp BOOTSTRAP} +{\bf ORDRING} depends on {\bf INT}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf ORDRING} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf ORDRING.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Technically I can't justify this bootstrap stanza based on the lattice +since {\bf INT} is already bootstrapped. However using {\bf INT} naked +generates a "value stack overflow" error suggesting an infinite recursive +loop. This code is here to experiment with breaking that loop. + +Note that this code is not included in the generated catdef.spad file. + +<<ORDRING.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |OrderedRing;AL| (QUOTE NIL)) + +(DEFUN |OrderedRing| NIL + (LET (#:G84457) + (COND + (|OrderedRing;AL|) + (T (SETQ |OrderedRing;AL| (|OrderedRing;|)))))) + +(DEFUN |OrderedRing;| NIL + (PROG (#1=#:G84455) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|OrderedAbelianGroup|) + (|Ring|) + (|Monoid|) + (|mkCategory| + (QUOTE |domain|) + (QUOTE ( + ((|positive?| ((|Boolean|) |$|)) T) + ((|negative?| ((|Boolean|) |$|)) T) + ((|sign| ((|Integer|) |$|)) T) + ((|abs| (|$| |$|)) T))) + NIL + (QUOTE ((|Integer|) (|Boolean|))) + NIL)) + |OrderedRing|) + (SETELT #1# 0 (QUOTE (|OrderedRing|))))))) + +(MAKEPROP (QUOTE |OrderedRing|) (QUOTE NILADIC) T) + +@ +\section{ORDRING-.lsp BOOTSTRAP} +{\bf ORDRING-} depends on {\bf ORDRING}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf ORDRING-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf ORDRING-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<ORDRING-.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(DEFUN |ORDRING-;positive?;SB;1| (|x| |$|) + (SPADCALL (|spadConstant| |$| 7) |x| (QREFELT |$| 9))) + +(DEFUN |ORDRING-;negative?;SB;2| (|x| |$|) + (SPADCALL |x| (|spadConstant| |$| 7) (QREFELT |$| 9))) + +(DEFUN |ORDRING-;sign;SI;3| (|x| |$|) + (COND + ((SPADCALL |x| (QREFELT |$| 12)) 1) + ((SPADCALL |x| (QREFELT |$| 13)) -1) + ((SPADCALL |x| (QREFELT |$| 15)) 0) + ((QUOTE T) + (|error| "x satisfies neither positive?, negative? or zero?")))) + +(DEFUN |ORDRING-;abs;2S;4| (|x| |$|) + (COND + ((SPADCALL |x| (QREFELT |$| 12)) |x|) + ((SPADCALL |x| (QREFELT |$| 13)) (SPADCALL |x| (QREFELT |$| 18))) + ((SPADCALL |x| (QREFELT |$| 15)) (|spadConstant| |$| 7)) + ((QUOTE T) + (|error| "x satisfies neither positive?, negative? or zero?")))) + +(DEFUN |OrderedRing&| (|#1|) + (PROG (|DV$1| |dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |DV$1| (|devaluate| |#1|) . #1=(|OrderedRing&|)) + (LETT |dv$| (LIST (QUOTE |OrderedRing&|) |DV$1|) . #1#) + (LETT |$| (GETREFV 20) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|stuffDomainSlots| |$|) + (QSETREFV |$| 6 |#1|) + |$|)))) + +(MAKEPROP + (QUOTE |OrderedRing&|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL NIL + (|local| |#1|) + (0 . |Zero|) + (|Boolean|) + (4 . |<|) + |ORDRING-;positive?;SB;1| + |ORDRING-;negative?;SB;2| + (10 . |positive?|) + (15 . |negative?|) + (20 . |One|) + (24 . |zero?|) + (|Integer|) + |ORDRING-;sign;SI;3| + (29 . |-|) + |ORDRING-;abs;2S;4|)) + (QUOTE #(|sign| 34 |positive?| 39 |negative?| 44 |abs| 49)) + (QUOTE NIL) + (CONS + (|makeByteWordVec2| 1 (QUOTE NIL)) + (CONS + (QUOTE #()) + (CONS + (QUOTE #()) + (|makeByteWordVec2| 19 + (QUOTE + (0 6 0 7 2 6 8 0 0 9 1 6 8 0 12 1 6 8 0 13 0 6 0 14 1 6 8 0 15 + 1 6 0 0 18 1 0 16 0 17 1 0 8 0 10 1 0 8 0 11 1 0 0 0 19)))))) + (QUOTE |lookupComplete|))) +@ +\section{category ORDSET OrderedSet} +<<category ORDSET OrderedSet>>= +)abbrev category ORDSET OrderedSet +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The class of totally ordered sets, that is, sets such that for each pair of elements \spad{(a,b)} +++ exactly one of the following relations holds \spad{a<b or a=b or b<a} +++ and the relation is transitive, i.e. \spad{a<b and b<c => a<c}. + +OrderedSet(): Category == SetCategory with + --operations + "<": (%,%) -> Boolean + ++ x < y is a strict total ordering on the elements of the set. + ">": (%, %) -> Boolean + ++ x > y is a greater than test. + ">=": (%, %) -> Boolean + ++ x >= y is a greater than or equal test. + "<=": (%, %) -> Boolean + ++ x <= y is a less than or equal test. + + max: (%,%) -> % + ++ max(x,y) returns the maximum of x and y relative to "<". + min: (%,%) -> % + ++ min(x,y) returns the minimum of x and y relative to "<". + add + --declarations + x,y: % + --definitions + -- These really ought to become some sort of macro + max(x,y) == + x > y => x + y + min(x,y) == + x > y => y + x + ((x: %) > (y: %)) : Boolean == y < x + ((x: %) >= (y: %)) : Boolean == not (x < y) + ((x: %) <= (y: %)) : Boolean == not (y < x) + +@ +\section{category PDRING PartialDifferentialRing} +<<category PDRING PartialDifferentialRing>>= +)abbrev category PDRING PartialDifferentialRing +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A partial differential ring with differentiations indexed by a parameter type S. +++ +++ Axioms: +++ \spad{differentiate(x+y,e) = differentiate(x,e)+differentiate(y,e)} +++ \spad{differentiate(x*y,e) = x*differentiate(y,e) + differentiate(x,e)*y} + +PartialDifferentialRing(S:SetCategory): Category == Ring with + differentiate: (%, S) -> % + ++ differentiate(x,v) computes the partial derivative of x + ++ with respect to v. + differentiate: (%, List S) -> % + ++ differentiate(x,[s1,...sn]) computes successive partial derivatives, + ++ i.e. \spad{differentiate(...differentiate(x, s1)..., sn)}. + differentiate: (%, S, NonNegativeInteger) -> % + ++ differentiate(x, s, n) computes multiple partial derivatives, i.e. + ++ n-th derivative of x with respect to s. + differentiate: (%, List S, List NonNegativeInteger) -> % + ++ differentiate(x, [s1,...,sn], [n1,...,nn]) computes + ++ multiple partial derivatives, i.e. + D: (%, S) -> % + ++ D(x,v) computes the partial derivative of x + ++ with respect to v. + D: (%, List S) -> % + ++ D(x,[s1,...sn]) computes successive partial derivatives, + ++ i.e. \spad{D(...D(x, s1)..., sn)}. + D: (%, S, NonNegativeInteger) -> % + ++ D(x, s, n) computes multiple partial derivatives, i.e. + ++ n-th derivative of x with respect to s. + D: (%, List S, List NonNegativeInteger) -> % + ++ D(x, [s1,...,sn], [n1,...,nn]) computes + ++ multiple partial derivatives, i.e. + ++ \spad{D(...D(x, s1, n1)..., sn, nn)}. + add + differentiate(r:%, l:List S) == + for s in l repeat r := differentiate(r, s) + r + + differentiate(r:%, s:S, n:NonNegativeInteger) == + for i in 1..n repeat r := differentiate(r, s) + r + + differentiate(r:%, ls:List S, ln:List NonNegativeInteger) == + for s in ls for n in ln repeat r := differentiate(r, s, n) + r + + D(r:%, v:S) == differentiate(r,v) + D(r:%, lv:List S) == differentiate(r,lv) + D(r:%, v:S, n:NonNegativeInteger) == differentiate(r,v,n) + D(r:%, lv:List S, ln:List NonNegativeInteger) == differentiate(r, lv, ln) + +@ +\section{category PFECAT PolynomialFactorizationExplicit} +<<category PFECAT PolynomialFactorizationExplicit>>= +)abbrev category PFECAT PolynomialFactorizationExplicit +++ Author: James Davenport +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This is the category of domains that know "enough" about +++ themselves in order to factor univariate polynomials over themselves. +++ This will be used in future releases for supporting factorization +++ over finitely generated coefficient fields, it is not yet available +++ in the current release of axiom. + +PolynomialFactorizationExplicit(): Category == Definition where + P ==> SparseUnivariatePolynomial % + Definition ==> + UniqueFactorizationDomain with + -- operations + squareFreePolynomial: P -> Factored(P) + ++ squareFreePolynomial(p) returns the + ++ square-free factorization of the + ++ univariate polynomial p. + factorPolynomial: P -> Factored(P) + ++ factorPolynomial(p) returns the factorization + ++ into irreducibles of the univariate polynomial p. + factorSquareFreePolynomial: P -> Factored(P) + ++ factorSquareFreePolynomial(p) factors the + ++ univariate polynomial p into irreducibles + ++ where p is known to be square free + ++ and primitive with respect to its main variable. + gcdPolynomial: (P, P) -> P + ++ gcdPolynomial(p,q) returns the gcd of the univariate + ++ polynomials p qnd q. + -- defaults to Euclidean, but should be implemented via + -- modular or p-adic methods. + solveLinearPolynomialEquation: (List P, P) -> Union(List P,"failed") + ++ solveLinearPolynomialEquation([f1, ..., fn], g) + ++ (where the fi are relatively prime to each other) + ++ returns a list of ai such that + ++ \spad{g/prod fi = sum ai/fi} + ++ or returns "failed" if no such list of ai's exists. + if % has CharacteristicNonZero then + conditionP: Matrix % -> Union(Vector %,"failed") + ++ conditionP(m) returns a vector of elements, not all zero, + ++ whose \spad{p}-th powers (p is the characteristic of the domain) + ++ are a solution of the homogenous linear system represented + ++ by m, or "failed" is there is no such vector. + charthRoot: % -> Union(%,"failed") + ++ charthRoot(r) returns the \spad{p}-th root of r, or "failed" + ++ if none exists in the domain. + -- this is a special case of conditionP, but often the one we want + add + gcdPolynomial(f,g) == + zero? f => g + zero? g => f + cf:=content f + if not one? cf then f:=(f exquo cf)::P + cg:=content g + if not one? cg then g:=(g exquo cg)::P + ans:=subResultantGcd(f,g)$P + gcd(cf,cg)*(ans exquo content ans)::P + if % has CharacteristicNonZero then + charthRoot f == + -- to take p'th root of f, solve the system X-fY=0, + -- so solution is [x,y] + -- with x^p=X and y^p=Y, then (x/y)^p = f + zero? f => 0 + m:Matrix % := matrix [[1,-f]] + ans:= conditionP m + ans case "failed" => "failed" + (ans.1) exquo (ans.2) + if % has Field then + solveLinearPolynomialEquation(lf,g) == + multiEuclidean(lf,g)$P + else solveLinearPolynomialEquation(lf,g) == + LPE ==> LinearPolynomialEquationByFractions % + solveLinearPolynomialEquationByFractions(lf,g)$LPE + +@ +\section{category PID PrincipalIdealDomain} +<<category PID PrincipalIdealDomain>>= +)abbrev category PID PrincipalIdealDomain +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The category of constructive principal ideal domains, i.e. +++ where a single generator can be constructively found for +++ any ideal given by a finite set of generators. +++ Note that this constructive definition only implies that +++ finitely generated ideals are principal. It is not clear +++ what we would mean by an infinitely generated ideal. + +PrincipalIdealDomain(): Category == GcdDomain with + --operations + principalIdeal: List % -> Record(coef:List %,generator:%) + ++ principalIdeal([f1,...,fn]) returns a record whose + ++ generator component is a generator of the ideal + ++ generated by \spad{[f1,...,fn]} whose coef component satisfies + ++ \spad{generator = sum (input.i * coef.i)} + expressIdealMember: (List %,%) -> Union(List %,"failed") + ++ expressIdealMember([f1,...,fn],h) returns a representation + ++ of h as a linear combination of the fi or "failed" if h + ++ is not in the ideal generated by the fi. + +@ +\section{category RMODULE RightModule} +<<category RMODULE RightModule>>= +)abbrev category RMODULE RightModule +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The category of right modules over an rng (ring not necessarily with unit). +++ This is an abelian group which supports right multiplation by elements of +++ the rng. +++ +++ Axioms: +++ \spad{ x*(a*b) = (x*a)*b } +++ \spad{ x*(a+b) = (x*a)+(x*b) } +++ \spad{ (x+y)*x = (x*a)+(y*a) } +RightModule(R:Rng):Category == AbelianGroup with + --operations + "*": (%,R) -> % ++ x*r returns the right multiplication of the module element x + ++ by the ring element r. + +@ +\section{category RING Ring} +<<category RING Ring>>= +)abbrev category RING Ring +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The category of rings with unity, always associative, but +++ not necessarily commutative. + +--Ring(): Category == Join(Rng,Monoid,LeftModule(%:Rng)) with +Ring(): Category == Join(Rng,Monoid,LeftModule(%)) with + --operations + characteristic: () -> NonNegativeInteger + ++ characteristic() returns the characteristic of the ring + ++ this is the smallest positive integer n such that + ++ \spad{n*x=0} for all x in the ring, or zero if no such n + ++ exists. + --We can not make this a constant, since some domains are mutable + coerce: Integer -> % + ++ coerce(i) converts the integer i to a member of the given domain. +-- recip: % -> Union(%,"failed") -- inherited from Monoid + unitsKnown + ++ recip truly yields + ++ reciprocal or "failed" if not a unit. + ++ Note: \spad{recip(0) = "failed"}. + add + n:Integer + coerce(n) == n * 1$% + +@ +\section{RING.lsp BOOTSTRAP} +{\bf RING} depends on itself. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf RING} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf RING.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<RING.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |Ring;AL| (QUOTE NIL)) + +(DEFUN |Ring| NIL + (LET (#:G82789) + (COND + (|Ring;AL|) + (T (SETQ |Ring;AL| (|Ring;|)))))) + +(DEFUN |Ring;| NIL + (PROG (#1=#:G82787) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|Rng|) + (|Monoid|) + (|LeftModule| (QUOTE |$|)) + (|mkCategory| + (QUOTE |domain|) + (QUOTE ( + ((|characteristic| ((|NonNegativeInteger|))) T) + ((|coerce| (|$| (|Integer|))) T))) + (QUOTE ((|unitsKnown| T))) + (QUOTE ((|Integer|) (|NonNegativeInteger|))) + NIL)) + |Ring|) + (SETELT #1# 0 (QUOTE (|Ring|))))))) + +(MAKEPROP (QUOTE |Ring|) (QUOTE NILADIC) T) + +@ +\section{RING-.lsp BOOTSTRAP} +{\bf RING-} depends on {\bf RING}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf RING-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf RING-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<RING-.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(DEFUN |RING-;coerce;IS;1| (|n| |$|) + (SPADCALL |n| (|spadConstant| |$| 7) (QREFELT |$| 9))) + +(DEFUN |Ring&| (|#1|) + (PROG (|DV$1| |dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |DV$1| (|devaluate| |#1|) . #1=(|Ring&|)) + (LETT |dv$| (LIST (QUOTE |Ring&|) |DV$1|) . #1#) + (LETT |$| (GETREFV 12) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|stuffDomainSlots| |$|) + (QSETREFV |$| 6 |#1|) + |$|)))) + +(MAKEPROP + (QUOTE |Ring&|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL NIL + (|local| |#1|) + (0 . |One|) + (|Integer|) + (4 . |*|) + |RING-;coerce;IS;1| + (|OutputForm|))) + (QUOTE #(|coerce| 10)) + (QUOTE NIL) + (CONS + (|makeByteWordVec2| 1 (QUOTE NIL)) + (CONS + (QUOTE #()) + (CONS + (QUOTE #()) + (|makeByteWordVec2| 10 (QUOTE (0 6 0 7 2 6 0 8 0 9 1 0 0 8 10)))))) + (QUOTE |lookupComplete|))) + +@ +\section{category RNG Rng} +<<category RNG Rng>>= +)abbrev category RNG Rng +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The category of associative rings, not necessarily commutative, and not +++ necessarily with a 1. This is a combination of an abelian group +++ and a semigroup, with multiplication distributing over addition. +++ +++ Axioms: +++ \spad{ x*(y+z) = x*y + x*z} +++ \spad{ (x+y)*z = x*z + y*z } +++ +++ Conditional attributes: +++ \spadnoZeroDivisors\tab{25}\spad{ ab = 0 => a=0 or b=0} +Rng(): Category == Join(AbelianGroup,SemiGroup) + +@ +\section{RNG.lsp BOOTSTRAP} +{\bf RNG} depends on a chain of +files. We need to break this cycle to build the algebra. So we keep a +cached copy of the translated {\bf RNG} category which we can write +into the {\bf MID} directory. We compile the lisp code and copy the +{\bf RNG.o} file to the {\bf OUT} directory. This is eventually +forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<RNG.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |Rng;AL| (QUOTE NIL)) + +(DEFUN |Rng| NIL + (LET (#:G82722) + (COND + (|Rng;AL|) + (T (SETQ |Rng;AL| (|Rng;|)))))) + +(DEFUN |Rng;| NIL + (PROG (#1=#:G82720) + (RETURN + (PROG1 + (LETT #1# (|Join| (|AbelianGroup|) (|SemiGroup|)) |Rng|) + (SETELT #1# 0 (QUOTE (|Rng|))))))) + +(MAKEPROP (QUOTE |Rng|) (QUOTE NILADIC) T) + +@ +\section{category SGROUP SemiGroup} +<<category SGROUP SemiGroup>>= +)abbrev category SGROUP SemiGroup +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ the class of all multiplicative semigroups, i.e. a set +++ with an associative operation \spadop{*}. +++ +++ Axioms: +++ \spad{associative("*":(%,%)->%)}\tab{30}\spad{ (x*y)*z = x*(y*z)} +++ +++ Conditional attributes: +++ \spad{commutative("*":(%,%)->%)}\tab{30}\spad{ x*y = y*x } +SemiGroup(): Category == SetCategory with + --operations + "*": (%,%) -> % ++ x*y returns the product of x and y. + "**": (%,PositiveInteger) -> % ++ x**n returns the repeated product + ++ of x n times, i.e. exponentiation. + "^": (%,PositiveInteger) -> % ++ x^n returns the repeated product + ++ of x n times, i.e. exponentiation. + add + import RepeatedSquaring(%) + x:% ** n:PositiveInteger == expt(x,n) + _^(x:%, n:PositiveInteger):% == x ** n + +@ +\section{category SETCAT SetCategory} +<<category SETCAT SetCategory>>= +)abbrev category SETCAT SetCategory +++ Author: +++ Date Created: +++ Date Last Updated: +++ 09/09/92 RSS added latex and hash +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ \spadtype{SetCategory} is the basic category for describing a collection +++ of elements with \spadop{=} (equality) and \spadfun{coerce} to output form. +++ +++ Conditional Attributes: +++ canonical\tab{15}data structure equality is the same as \spadop{=} +SetCategory(): Category == Join(BasicType,CoercibleTo OutputForm) with + --operations + hash: % -> SingleInteger ++ hash(s) calculates a hash code for s. + latex: % -> String ++ latex(s) returns a LaTeX-printable output + ++ representation of s. + add + hash(s : %): SingleInteger == 0$SingleInteger + latex(s : %): String == "\mbox{\bf Unimplemented}" + +@ +\section{SETCAT.lsp BOOTSTRAP} +{\bf SETCAT} needs +{\bf SINT} which needs +{\bf UFD} which needs +{\bf GCDDOM} which needs +{\bf COMRING} which needs +{\bf RING} which needs +{\bf RNG} which needs +{\bf ABELGRP} which needs +{\bf CABMON} which needs +{\bf ABELMON} which needs +{\bf ABELSG} which needs +{\bf SETCAT}. We break this chain with {\bf SETCAT.lsp} which we +cache here. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf SETCAT} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf SETCAT.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<SETCAT.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |SetCategory;AL| (QUOTE NIL)) + +(DEFUN |SetCategory| NIL + (LET (#:G82359) + (COND + (|SetCategory;AL|) + (T (SETQ |SetCategory;AL| (|SetCategory;|)))))) + +(DEFUN |SetCategory;| NIL + (PROG (#1=#:G82357) + (RETURN + (PROG1 + (LETT #1# + (|sublisV| + (PAIR + (QUOTE (#2=#:G82356)) + (LIST (QUOTE (|OutputForm|)))) + (|Join| + (|BasicType|) + (|CoercibleTo| (QUOTE #2#)) + (|mkCategory| + (QUOTE |domain|) + (QUOTE ( + ((|hash| ((|SingleInteger|) |$|)) T) + ((|latex| ((|String|) |$|)) T))) + NIL + (QUOTE ((|String|) (|SingleInteger|))) + NIL))) + |SetCategory|) + (SETELT #1# 0 (QUOTE (|SetCategory|))))))) + +(MAKEPROP (QUOTE |SetCategory|) (QUOTE NILADIC) T) + +@ +\section{SETCAT-.lsp BOOTSTRAP} +{\bf SETCAT-} is the implementation of the operations exported +by {\bf SETCAT}. It comes into existance whenever {\bf SETCAT} +gets compiled by Axiom. However this will not happen at the +lisp level so we also cache this information here. See the +explanation under the {\bf SETCAT.lsp} section for more details. + +Note that this code is not included in the generated catdef.spad file. + +<<SETCAT-.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(PUT + (QUOTE |SETCAT-;hash;SSi;1|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM (|s|) 0))) + +(DEFUN |SETCAT-;hash;SSi;1| (|s| |$|) 0) + +(PUT + (QUOTE |SETCAT-;latex;SS;2|) + (QUOTE |SPADreplace|) + (QUOTE (XLAM (|s|) "\\mbox{\\bf Unimplemented}"))) + +(DEFUN |SETCAT-;latex;SS;2| (|s| |$|) + "\\mbox{\\bf Unimplemented}") + +(DEFUN |SetCategory&| (|#1|) + (PROG (|DV$1| |dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |DV$1| (|devaluate| |#1|) . #1=(|SetCategory&|)) + (LETT |dv$| (LIST (QUOTE |SetCategory&|) |DV$1|) . #1#) + (LETT |$| (GETREFV 11) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|stuffDomainSlots| |$|) + (QSETREFV |$| 6 |#1|) + |$|)))) + +(MAKEPROP + (QUOTE |SetCategory&|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL NIL + (|local| |#1|) + (|SingleInteger|) + |SETCAT-;hash;SSi;1| + (|String|) + |SETCAT-;latex;SS;2|)) + (QUOTE + #(|latex| 0 |hash| 5)) + (QUOTE NIL) + (CONS + (|makeByteWordVec2| 1 (QUOTE NIL)) + (CONS + (QUOTE #()) + (CONS + (QUOTE #()) + (|makeByteWordVec2| + 10 + (QUOTE (1 0 9 0 10 1 0 7 0 8)))))) + (QUOTE |lookupComplete|))) + +@ +\section{category STEP StepThrough} +<<category STEP StepThrough>>= +)abbrev category STEP StepThrough +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A class of objects which can be 'stepped through'. +++ Repeated applications of \spadfun{nextItem} is guaranteed never to +++ return duplicate items and only return "failed" after exhausting +++ all elements of the domain. +++ This assumes that the sequence starts with \spad{init()}. +++ For infinite domains, repeated application +++ of \spadfun{nextItem} is not required to reach all possible domain elements +++ starting from any initial element. +++ +++ Conditional attributes: +++ infinite\tab{15}repeated \spad{nextItem}'s are never "failed". +StepThrough(): Category == SetCategory with + --operations + init: constant -> % + ++ init() chooses an initial object for stepping. + nextItem: % -> Union(%,"failed") + ++ nextItem(x) returns the next item, or "failed" if domain is exhausted. + +@ +\section{category UFD UniqueFactorizationDomain} +<<category UFD UniqueFactorizationDomain>>= +)abbrev category UFD UniqueFactorizationDomain +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A constructive unique factorization domain, i.e. where +++ we can constructively factor members into a product of +++ a finite number of irreducible elements. + +UniqueFactorizationDomain(): Category == GcdDomain with + --operations + prime?: % -> Boolean + ++ prime?(x) tests if x can never be written as the product of two + ++ non-units of the ring, + ++ i.e., x is an irreducible element. + squareFree : % -> Factored(%) + ++ squareFree(x) returns the square-free factorization of x + ++ i.e. such that the factors are pairwise relatively prime + ++ and each has multiple prime factors. + squareFreePart: % -> % + ++ squareFreePart(x) returns a product of prime factors of + ++ x each taken with multiplicity one. + factor: % -> Factored(%) + ++ factor(x) returns the factorization of x into irreducibles. + add + squareFreePart x == + unit(s := squareFree x) * _*/[f.factor for f in factors s] + + prime? x == # factorList factor x = 1 + +@ +\section{UFD.lsp BOOTSTRAP} +{\bf UFD} needs +{\bf GCDDOM} which needs +{\bf COMRING} which needs +{\bf RING} which needs +{\bf RNG} which needs +{\bf ABELGRP} which needs +{\bf CABMON} which needs +{\bf ABELMON} which needs +{\bf ABELSG} which needs +{\bf SETCAT} which needs +{\bf SINT} which needs +{\bf UFD}. +We need to break this cycle to build the algebra. So we keep a +cached copy of the translated {\bf UFD} category which we can write +into the {\bf MID} directory. We compile the lisp code and copy the +{\bf UFD.o} file to the {\bf OUT} directory. This is eventually +forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<UFD.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(SETQ |UniqueFactorizationDomain;AL| (QUOTE NIL)) + +(DEFUN |UniqueFactorizationDomain| NIL + (LET (#:G83334) + (COND + (|UniqueFactorizationDomain;AL|) + (T + (SETQ + |UniqueFactorizationDomain;AL| + (|UniqueFactorizationDomain;|)))))) + +(DEFUN |UniqueFactorizationDomain;| NIL + (PROG (#1=#:G83332) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|GcdDomain|) + (|mkCategory| + (QUOTE |domain|) + (QUOTE ( + ((|prime?| ((|Boolean|) |$|)) T) + ((|squareFree| ((|Factored| |$|) |$|)) T) + ((|squareFreePart| (|$| |$|)) T) + ((|factor| ((|Factored| |$|) |$|)) T))) + NIL + (QUOTE ((|Factored| |$|) (|Boolean|))) + NIL)) + |UniqueFactorizationDomain|) + (SETELT #1# 0 (QUOTE (|UniqueFactorizationDomain|))))))) + +(MAKEPROP (QUOTE |UniqueFactorizationDomain|) (QUOTE NILADIC) T) + +@ +\section{UFD-.lsp BOOTSTRAP} +{\bf UFD-} needs {\bf UFD}. +We need to break this cycle to build the algebra. So we keep a +cached copy of the translated {\bf UFD-} category which we can write +into the {\bf MID} directory. We compile the lisp code and copy the +{\bf UFD-.o} file to the {\bf OUT} directory. This is eventually +forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<<UFD-.lsp BOOTSTRAP>>= + +(|/VERSIONCHECK| 2) + +(DEFUN |UFD-;squareFreePart;2S;1| (|x| |$|) + (PROG (|s| |f| #1=#:G83349 #2=#:G83347 #3=#:G83345 #4=#:G83346) + (RETURN + (SEQ + (SPADCALL + (SPADCALL + (LETT |s| + (SPADCALL |x| (QREFELT |$| 8)) + |UFD-;squareFreePart;2S;1|) + (QREFELT |$| 10)) + (PROGN + (LETT #4# NIL |UFD-;squareFreePart;2S;1|) + (SEQ + (LETT |f| NIL |UFD-;squareFreePart;2S;1|) + (LETT #1# + (SPADCALL |s| (QREFELT |$| 13)) + |UFD-;squareFreePart;2S;1|) + G190 + (COND + ((OR + (ATOM #1#) + (PROGN + (LETT |f| (CAR #1#) |UFD-;squareFreePart;2S;1|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (PROGN + (LETT #2# (QCAR |f|) |UFD-;squareFreePart;2S;1|) + (COND + (#4# + (LETT #3# + (SPADCALL #3# #2# (QREFELT |$| 14)) + |UFD-;squareFreePart;2S;1|)) + ((QUOTE T) + (PROGN + (LETT #3# #2# |UFD-;squareFreePart;2S;1|) + (LETT #4# (QUOTE T) |UFD-;squareFreePart;2S;1|))))))) + (LETT #1# (CDR #1#) |UFD-;squareFreePart;2S;1|) + (GO G190) + G191 + (EXIT NIL)) + (COND + (#4# #3#) + ((QUOTE T) (|spadConstant| |$| 15)))) + (QREFELT |$| 14)))))) + +(DEFUN |UFD-;prime?;SB;2| (|x| |$|) + (EQL + (LENGTH (SPADCALL (SPADCALL |x| (QREFELT |$| 17)) (QREFELT |$| 21))) 1)) + +(DEFUN |UniqueFactorizationDomain&| (|#1|) + (PROG (|DV$1| |dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |DV$1| (|devaluate| |#1|) . #1=(|UniqueFactorizationDomain&|)) + (LETT |dv$| (LIST (QUOTE |UniqueFactorizationDomain&|) |DV$1|) . #1#) + (LETT |$| (GETREFV 24) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|stuffDomainSlots| |$|) + (QSETREFV |$| 6 |#1|) + |$|)))) + +(MAKEPROP + (QUOTE |UniqueFactorizationDomain&|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL NIL + (|local| |#1|) + (|Factored| |$|) + (0 . |squareFree|) + (|Factored| 6) + (5 . |unit|) + (|Record| (|:| |factor| 6) (|:| |exponent| (|Integer|))) + (|List| 11) + (10 . |factors|) + (15 . |*|) + (21 . |One|) + |UFD-;squareFreePart;2S;1| + (25 . |factor|) + (|Union| (QUOTE "nil") (QUOTE "sqfr") (QUOTE "irred") (QUOTE "prime")) + (|Record| (|:| |flg| 18) (|:| |fctr| 6) (|:| |xpnt| (|Integer|))) + (|List| 19) + (30 . |factorList|) + (|Boolean|) + |UFD-;prime?;SB;2|)) + (QUOTE #(|squareFreePart| 35 |prime?| 40)) + (QUOTE NIL) + (CONS + (|makeByteWordVec2| 1 (QUOTE NIL)) + (CONS + (QUOTE #()) + (CONS + (QUOTE #()) + (|makeByteWordVec2| 23 + (QUOTE + (1 6 7 0 8 1 9 6 0 10 1 9 12 0 13 2 6 0 0 0 14 0 6 0 15 1 6 7 + 0 17 1 9 20 0 21 1 0 0 0 16 1 0 22 0 23)))))) + (QUOTE |lookupComplete|))) + +@ +\section{category VSPACE VectorSpace} +<<category VSPACE VectorSpace>>= +)abbrev category VSPACE VectorSpace +++ Author: +++ Date Created: +++ Date Last Updated: +++ Basic Functions: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ Vector Spaces (not necessarily finite dimensional) over a field. + +VectorSpace(S:Field): Category == Module(S) with + "/" : (%, S) -> % + ++ x/y divides the vector x by the scalar y. + dimension: () -> CardinalNumber + ++ dimension() returns the dimensionality of the vector space. + add + (v:% / s:S):% == inv(s) * v + +@ +\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>> + +<<category BASTYPE BasicType>> +<<category SETCAT SetCategory>> +<<category STEP StepThrough>> +<<category SGROUP SemiGroup>> +<<category MONOID Monoid>> +<<category GROUP Group>> +<<category ABELSG AbelianSemiGroup>> +<<category ABELMON AbelianMonoid>> +<<category CABMON CancellationAbelianMonoid>> +<<category ABELGRP AbelianGroup>> +<<category RNG Rng>> +<<category LMODULE LeftModule>> +<<category RMODULE RightModule>> +<<category RING Ring>> +<<category BMODULE BiModule>> +<<category ENTIRER EntireRing>> +<<category CHARZ CharacteristicZero>> +<<category CHARNZ CharacteristicNonZero>> +<<category COMRING CommutativeRing>> +<<category MODULE Module>> +<<category ALGEBRA Algebra>> +<<category LINEXP LinearlyExplicitRingOver>> +<<category FLINEXP FullyLinearlyExplicitRingOver>> +<<category INTDOM IntegralDomain>> +<<category GCDDOM GcdDomain>> +<<category UFD UniqueFactorizationDomain>> +<<category PFECAT PolynomialFactorizationExplicit>> +<<category PID PrincipalIdealDomain>> +<<category EUCDOM EuclideanDomain>> +<<category DIVRING DivisionRing>> +<<category FIELD Field>> +<<category FINITE Finite>> +<<category VSPACE VectorSpace>> +<<category ORDSET OrderedSet>> +<<category ORDFIN OrderedFinite>> +<<category ORDMON OrderedMonoid>> +<<category OASGP OrderedAbelianSemiGroup>> +<<category OAMON OrderedAbelianMonoid>> +<<category OCAMON OrderedCancellationAbelianMonoid>> +<<category OAGROUP OrderedAbelianGroup>> +<<category ORDRING OrderedRing>> +<<category OINTDOM OrderedIntegralDomain>> +<<category OAMONS OrderedAbelianMonoidSup>> +<<category DIFRING DifferentialRing>> +<<category PDRING PartialDifferentialRing>> +<<category DIFEXT DifferentialExtension>> +@ +\eject +\begin{thebibliography}{99} +\bibitem{1} nothing +\end{thebibliography} +\end{document} |