Initial population.

1 files changed, 350 insertions, 0 deletions

diff --git a/src/algebra/indexedp.spad.pamphlet b/src/algebra/indexedp.spad.pamphlet
new file mode 100644
index 00000000..41f9bc89
--- /dev/null
+++ b/src/algebra/indexedp.spad.pamphlet
@@ -0,0 +1,350 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/algebra indexedp.spad}
+\author{James Davenport}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{category IDPC IndexedDirectProductCategory}
+<<category IDPC IndexedDirectProductCategory>>=
+)abbrev category IDPC IndexedDirectProductCategory
+++ Author: James Davenport
+++ Date Created:
+++ Date Last Updated:
+++ Basic Functions:
+++ Related Constructors:
+++ Also See:
+++ AMS Classifications:
+++ Keywords:
+++ References:
+++ Description:
+++ This category represents the direct product of some set with
+++ respect to an ordered indexing set.
+
+IndexedDirectProductCategory(A:SetCategory,S:OrderedSet): Category ==
+  SetCategory with
+    map:           (A -> A, %) -> %
+       ++ map(f,z) returns the new element created by applying the
+       ++ function f to each component of the direct product element z.
+    monomial:         (A, S) -> %
+       ++ monomial(a,s) constructs a direct product element with the s
+       ++ component set to \spad{a}
+    leadingCoefficient:   % -> A
+       ++ leadingCoefficient(z) returns the coefficient of the leading
+       ++ (with respect to the ordering on the indexing set)
+       ++ monomial of z.
+       ++ Error: if z has no support.
+    leadingSupport:   % -> S
+       ++ leadingSupport(z) returns the index of leading
+       ++ (with respect to the ordering on the indexing set) monomial of z.
+       ++ Error: if z has no support.
+    reductum:      % -> %
+       ++ reductum(z) returns a new element created by removing the
+       ++ leading coefficient/support pair from the element z.
+       ++ Error: if z has no support.
+
+@
+\section{domain IDPO IndexedDirectProductObject}
+<<domain IDPO IndexedDirectProductObject>>=
+)abbrev domain IDPO IndexedDirectProductObject
+++ Indexed direct products of objects over a set \spad{A}
+++ of generators indexed by an ordered set S. All items have finite support.
+IndexedDirectProductObject(A:SetCategory,S:OrderedSet): IndexedDirectProductCategory(A,S)
+ == add
+    --representations
+       Term:=  Record(k:S,c:A)
+       Rep:=  List Term
+    --declarations
+       x,y: %
+       f: A -> A
+       s: S
+    --define
+       x = y ==
+         while not null x and _^ null y repeat
+           x.first.k ^= y.first.k => return false
+           x.first.c ^= y.first.c => return false
+           x:=x.rest
+           y:=y.rest
+         null x and null y
+
+       coerce(x:%):OutputForm ==
+          bracket [rarrow(t.k :: OutputForm, t.c :: OutputForm) for t in x]
+
+       -- sample():% == [[sample()$S,sample()$A]$Term]$Rep
+
+       monomial(r,s) == [[s,r]]
+       map(f,x) == [[tm.k,f(tm.c)] for tm in x]
+
+       reductum x     ==
+          rest x
+       leadingCoefficient x  ==
+          null x => error "Can't take leadingCoefficient of empty product element"
+          x.first.c
+       leadingSupport x  ==
+          null x => error "Can't take leadingCoefficient of empty product element"
+          x.first.k
+
+@
+\section{domain IDPAM IndexedDirectProductAbelianMonoid}
+<<domain IDPAM IndexedDirectProductAbelianMonoid>>=
+)abbrev domain IDPAM IndexedDirectProductAbelianMonoid
+++ Indexed direct products of abelian monoids over an abelian monoid \spad{A} of
+++ generators indexed by the ordered set S. All items have finite support.
+++ Only non-zero terms are stored.
+IndexedDirectProductAbelianMonoid(A:AbelianMonoid,S:OrderedSet):
+    Join(AbelianMonoid,IndexedDirectProductCategory(A,S))
+ ==  IndexedDirectProductObject(A,S) add
+    --representations
+       Term:=  Record(k:S,c:A)
+       Rep:=  List Term
+       x,y: %
+       r: A
+       n: NonNegativeInteger
+       f: A -> A
+       s: S
+       0  == []
+       zero? x ==  null x
+
+	-- PERFORMANCE CRITICAL; Should build list up
+	--  by merging 2 sorted lists.   Doing this will
+	-- avoid the recursive calls (very useful if there is a
+	-- large number of vars in a polynomial.
+--       x + y  ==
+--          null x => y
+--          null y => x
+--          y.first.k > x.first.k => cons(y.first,(x + y.rest))
+--          x.first.k > y.first.k => cons(x.first,(x.rest + y))
+--          r:= x.first.c + y.first.c
+--          r = 0 => x.rest + y.rest
+--          cons([x.first.k,r],(x.rest + y.rest))
+       qsetrest!: (Rep, Rep) -> Rep
+       qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp
+
+       x + y == 
+	 	null x => y
+		null y => x
+		endcell: Rep := empty()
+		res:  Rep := empty()
+		while not empty? x and not empty? y repeat 
+			newcell := empty()
+			if x.first.k = y.first.k then
+				r:= x.first.c + y.first.c
+				if not zero? r then 
+					newcell := cons([x.first.k, r], empty())
+				x := rest x
+				y := rest y
+			else if x.first.k > y.first.k then
+				newcell := cons(x.first, empty())
+				x := rest x
+			else
+				newcell := cons(y.first, empty())
+				y := rest y
+			if not empty? newcell then 
+				if not empty? endcell then
+					qsetrest!(endcell, newcell)
+					endcell := newcell
+				else
+					res     := newcell;
+					endcell := res
+		if empty? x then end := y
+		else end := x
+		if empty? res then res := end
+		else qsetrest!(endcell, end)
+		res
+
+       n * x  ==
+             n = 0 => 0
+             n = 1 => x
+             [[u.k,a] for u in x | (a:=n*u.c) ^= 0$A]
+
+       monomial(r,s) == (r = 0 => 0; [[s,r]])
+       map(f,x) == [[tm.k,a] for tm in x | (a:=f(tm.c)) ^= 0$A]
+
+       reductum x     == (null x => 0; rest x)
+       leadingCoefficient x  == (null x => 0; x.first.c)
+
+@
+\section{domain IDPOAM IndexedDirectProductOrderedAbelianMonoid}
+<<domain IDPOAM IndexedDirectProductOrderedAbelianMonoid>>=
+)abbrev domain IDPOAM IndexedDirectProductOrderedAbelianMonoid
+++ Indexed direct products of ordered abelian monoids \spad{A} of
+++ generators indexed by the ordered set S.
+++ The inherited order is lexicographical.
+++ All items have finite support: only non-zero terms are stored.
+IndexedDirectProductOrderedAbelianMonoid(A:OrderedAbelianMonoid,S:OrderedSet):
+    Join(OrderedAbelianMonoid,IndexedDirectProductCategory(A,S))
+ ==  IndexedDirectProductAbelianMonoid(A,S) add
+    --representations
+       Term:=  Record(k:S,c:A)
+       Rep:=  List Term
+       x,y: %
+       x<y ==
+         empty? y => false
+         empty? x => true   -- note careful order of these two lines
+         y.first.k > x.first.k => true
+         y.first.k < x.first.k => false
+         y.first.c > x.first.c => true
+         y.first.c < x.first.c => false
+         x.rest < y.rest
+
+@
+\section{domain IDPOAMS IndexedDirectProductOrderedAbelianMonoidSup}
+<<domain IDPOAMS IndexedDirectProductOrderedAbelianMonoidSup>>=
+)abbrev domain IDPOAMS IndexedDirectProductOrderedAbelianMonoidSup
+++ Indexed direct products of ordered abelian monoid sups \spad{A},
+++ generators indexed by the ordered set S.
+++ All items have finite support: only non-zero terms are stored.
+IndexedDirectProductOrderedAbelianMonoidSup(A:OrderedAbelianMonoidSup,S:OrderedSet):
+    Join(OrderedAbelianMonoidSup,IndexedDirectProductCategory(A,S))
+ ==  IndexedDirectProductOrderedAbelianMonoid(A,S) add
+    --representations
+       Term:=  Record(k:S,c:A)
+       Rep:=  List Term
+       x,y: %
+       r: A
+       s: S
+
+       subtractIfCan(x,y) ==
+         empty? y => x
+         empty? x => "failed"
+         x.first.k < y.first.k => "failed"
+         x.first.k > y.first.k =>
+             t:= subtractIfCan(x.rest, y)
+             t case "failed" => "failed"
+             cons( x.first, t)
+         u:=subtractIfCan(x.first.c, y.first.c)
+         u case "failed" => "failed"
+         zero? u => subtractIfCan(x.rest, y.rest)
+         t:= subtractIfCan(x.rest, y.rest)
+         t case "failed" => "failed"
+         cons([x.first.k,u],t)
+
+       sup(x,y) ==
+         empty? y => x
+         empty? x => y
+         x.first.k < y.first.k => cons(y.first,sup(x,y.rest))
+         x.first.k > y.first.k => cons(x.first,sup(x.rest,y))
+         u:=sup(x.first.c, y.first.c)
+         cons([x.first.k,u],sup(x.rest,y.rest))
+
+@
+\section{domain IDPAG IndexedDirectProductAbelianGroup}
+<<domain IDPAG IndexedDirectProductAbelianGroup>>=
+)abbrev domain IDPAG IndexedDirectProductAbelianGroup
+++ Indexed direct products of abelian groups over an abelian group \spad{A} of
+++ generators indexed by the ordered set S.
+++ All items have finite support: only non-zero terms are stored.
+IndexedDirectProductAbelianGroup(A:AbelianGroup,S:OrderedSet):
+    Join(AbelianGroup,IndexedDirectProductCategory(A,S))
+ ==  IndexedDirectProductAbelianMonoid(A,S) add
+    --representations
+       Term:=  Record(k:S,c:A)
+       Rep:=  List Term
+       x,y: %
+       r: A
+       n: Integer
+       f: A -> A
+       s: S
+       -x == [[u.k,-u.c] for u in x]
+       n * x  ==
+             n = 0 => 0
+             n = 1 => x
+             [[u.k,a] for u in x | (a:=n*u.c) ^= 0$A]
+
+       qsetrest!: (Rep, Rep) -> Rep
+       qsetrest!(l: Rep, e: Rep): Rep == RPLACD(l, e)$Lisp
+
+       x - y ==
+                null x => -y
+                null y => x
+                endcell: Rep := empty()
+                res:  Rep := empty()
+                while not empty? x and not empty? y repeat
+                        newcell := empty()
+                        if x.first.k = y.first.k then
+                                r:= x.first.c - y.first.c
+                                if not zero? r then
+                                        newcell := cons([x.first.k, r], empty())
+                                x := rest x
+                                y := rest y
+                        else if x.first.k > y.first.k then
+                                newcell := cons(x.first, empty())
+                                x := rest x
+                        else
+                                newcell := cons([y.first.k,-y.first.c], empty())
+                                y := rest y
+                        if not empty? newcell then
+                                if not empty? endcell then
+                                        qsetrest!(endcell, newcell)
+                                        endcell := newcell
+                                else
+                                        res     := newcell;
+                                        endcell := res
+                if empty? x then end := - y
+                else end := x
+                if empty? res then res := end
+                else qsetrest!(endcell, end)
+                res
+
+--       x - y  ==
+--          empty? x => - y
+--          empty? y => x
+--          y.first.k > x.first.k => cons([y.first.k,-y.first.c],(x - y.rest))
+--          x.first.k > y.first.k => cons(x.first,(x.rest - y))
+--          r:= x.first.c - y.first.c
+--          r = 0 => x.rest - y.rest
+--          cons([x.first.k,r],(x.rest - y.rest))
+
+@
+\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 IDPC IndexedDirectProductCategory>>
+<<domain IDPO IndexedDirectProductObject>>
+<<domain IDPAM IndexedDirectProductAbelianMonoid>>
+<<domain IDPOAM IndexedDirectProductOrderedAbelianMonoid>>
+<<domain IDPOAMS IndexedDirectProductOrderedAbelianMonoidSup>>
+<<domain IDPAG IndexedDirectProductAbelianGroup>>
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}