\documentclass{article}
\usepackage{open-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, Gabriel Dos Reis
++ Date Created:
++ Date Last Updated: May 19, 2013.
++ 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:BasicType,S:OrderedType): Category ==
Join(BasicType,Functorial A,ConvertibleFrom List IndexedProductTerm(A,S)) with
if A has SetCategory and S has SetCategory then SetCategory
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.
terms: % -> List IndexedProductTerm(A,S)
++ \spad{terms x} returns the list of terms in \spad{x}.
++ Each term is a pair of a support (the first component)
++ and the corresponding value (the second component).
@
\section{domain IDPT IndexedProductTerm}
<<domain IDPT IndexedProductTerm>>=
)abbrev domain IDPT IndexedProductTerm
++ Author: Gabriel Dos Reis
++ Date Last Updated: May 7, 2013
++ Description:
++ An indexed product term is a utility domain used in the
++ representation of indexed direct product objects.
IndexedProductTerm(A,S): Public == Private where
A: BasicType
S: OrderedType
Public == Join(BasicType,CoercibleTo Pair(S,A)) with
term : (S, A) -> %
++ \spad{term(s,a)} constructs a term with index \spad{s}
++ and coefficient \spad{a}.
index : % -> S
++ \spad{index t} returns the index of the term \spad{t}.
coefficient : % -> A
++ \spad{coefficient t} returns the coefficient of the tern \spad{t}.
Private == Pair(S,A) add
term(s,a) == per [s,a]
index t == first rep t
coefficient t == second rep t
coerce(t: %): Pair(S,A) == rep t
@
\section{domain IDPO IndexedDirectProductObject}
<<domain IDPO IndexedDirectProductObject>>=
)abbrev domain IDPO IndexedDirectProductObject
++ Author: James Davenport, Gabriel Dos Reis
++ Date Created:
++ Date Last Updated: June 28, 2010
++ Description:
++ 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,S): Public == Private where
A: BasicType
S: OrderedType
Public == IndexedDirectProductCategory(A,S) with
combineWithIf: (%,%, (A,A) -> A, (A,A) -> Boolean) -> %
++ \spad{combineWithIf(u,v,f,p)} returns the result of combining
++ index-wise, coefficients of \spad{u} and \spad{u} if when
++ satisfy the predicate \spad{p}. Those pairs of coefficients
++ which fail\spad{p} are implicitly ignored.
Private == add
Rep == List IndexedProductTerm(A,S)
if A has CoercibleTo OutputForm and S has CoercibleTo OutputForm then
coerce(x:%):OutputForm ==
bracket [rarrow(index(t)::OutputForm, coefficient(t)::OutputForm)
for t in rep x]
x = y == rep x = rep y
monomial(r,s) == per [term(s,r)]
map(f,x) == per [term(index tm,f coefficient tm) for tm in rep x]
reductum x == per rest rep x
leadingCoefficient x ==
null rep x =>
error "Can't take leadingCoefficient of empty product element"
coefficient first rep x
leadingSupport x ==
null rep x =>
error "Can't take leadingCoefficient of empty product element"
index first rep x
terms x == rep x
convert l == per l
combineWithIf(u, v, f, p) ==
x := rep u
y := rep v
empty? x => v
empty? y => u
z: Rep := nil
prev: Rep := nil
while not empty? x and not empty? y repeat
xt := first x
yt := first y
index xt > index yt =>
t := [xt]
if empty? z then z := t
else setrest!(prev,t)
prev := t
x := rest x
index xt < index yt =>
t := [yt]
if empty? z then z := t
else setrest!(prev,t)
prev := t
y := rest y
not p(coefficient xt, coefficient yt) => iterate
t := [term(index xt, f(coefficient xt, coefficient yt))]
if empty? z then z := t
else setrest!(prev,t)
prev := t
x := rest x
y := rest y
if empty? x then setrest!(prev,y)
else if empty? y then setrest!(prev,x)
per z
@
\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:OrderedType):
Join(AbelianMonoid,IndexedDirectProductCategory(A,S))
== IndexedDirectProductObject(A,S) add
Term == IndexedProductTerm(A,S)
import Term
r: A
n: NonNegativeInteger
f: A -> A
s: S
0 == convert nil$List(Term)
zero? x == null terms x
import %tail: List Term -> List Term from Foreign Builtin
qsetrest!: (List Term, List Term) -> List Term
qsetrest!(l, e) ==
%store(%tail l,e)$Foreign(Builtin)
-- 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 ==
x' := terms x
y' := terms y
null x' => y
null y' => x
endcell: List Term := nil
res: List Term := nil
while not empty? x' and not empty? y' repeat
newcell: List Term := nil
if index x'.first = index y'.first then
r := coefficient x'.first + coefficient y'.first
if not zero? r then
newcell := [term(index x'.first, r)]
x' := rest x'
y' := rest y'
else if index x'.first > index y'.first then
newcell := [x'.first]
x' := rest x'
else
newcell := [y'.first]
y' := rest y'
if not empty? newcell then
if not empty? endcell then
qsetrest!(endcell, newcell)
endcell := newcell
else
res := newcell;
endcell := res
end :=
empty? x' => y'
x'
if empty? res then res := end
else qsetrest!(endcell, end)
convert res
n * x ==
zero? n => 0
one? n => x
convert [term(index u,a) for u in terms x
| not zero?(a:=n * coefficient u)]
monomial(r,s) ==
zero? r => 0
convert [term(s,r)]
map(f,x) ==
convert [term(index tm,a) for tm in terms x
| not zero?(a:=f coefficient tm)]
reductum x ==
null terms x => 0
convert rest(terms x)
leadingCoefficient x ==
null terms x => 0
coefficient terms(x).first
opposite?(x,y) ==
u := terms x
v := terms y
repeat
empty? u => return empty? v
empty? v => return empty? u
index u.first ~= index v.first => return false
not opposite?(coefficient u.first,coefficient v.first) => return false
u := rest u
v := rest v
@
\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:OrderedType):
Join(OrderedAbelianMonoid,IndexedDirectProductCategory(A,S))
== IndexedDirectProductAbelianMonoid(A,S) add
x<y ==
u := terms x
v := terms y
repeat
-- note careful order of next two lines
empty? v => return false
empty? u => return true
xt := first u
yt := first v
index xt < index yt => return true
index yt < index xt => return false
coefficient xt < coefficient yt => return true
coefficient yt < coefficient xt => return false
u := rest u
v := rest v
@
\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:OrderedType):
Join(AbelianGroup,IndexedDirectProductCategory(A,S))
== IndexedDirectProductAbelianMonoid(A,S) add
--representations
Term == IndexedProductTerm(A,S)
-x == convert [term(index u,-coefficient u) for u in terms x]
n:Integer * x:% ==
zero? n => 0
one? n => x
convert [term(index u,a) for u in terms x
| not zero?(a := n * coefficient u)]
import %tail: List Term -> List Term from Foreign Builtin
qsetrest!: (List Term, List Term) -> List Term
qsetrest!(l, e) ==
%store(%tail l,e)$Foreign(Builtin)
x - y ==
x' := terms x
y' := terms y
null x' => -y
null y' => x
endcell: List Term := nil
res: List Term := nil
while not empty? x' and not empty? y' repeat
newcell: List Term := nil
if index x'.first = index y'.first then
r := coefficient x'.first - coefficient y'.first
if not zero? r then
newcell := [term(index x'.first, r)]
x' := rest x'
y' := rest y'
else if index x'.first > index y'.first then
newcell := [x'.first]
x' := rest x'
else
newcell := [term(index y'.first,-coefficient y'.first)]
y' := rest y'
if not empty? newcell then
if not empty? endcell then
qsetrest!(endcell, newcell)
endcell := newcell
else
res := newcell;
endcell := res
end :=
empty? x' => terms(-convert y')
x'
if empty? res then res := end
else qsetrest!(endcell, end)
convert res
@
\section{License}
<<license>>=
--Copyright (C) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
--Copyright (C) 2007-2013, Gabriel Dos Reis.
--All rights reserved.
--
--Redistribution and use in source and binary forms, with or without
--modification, are permitted provided that the following conditions are
--met:
--
-- - Redistributions of source code must retain the above copyright
-- notice, this list of conditions and the following disclaimer.
--
-- - Redistributions in binary form must reproduce the above copyright
-- notice, this list of conditions and the following disclaimer in
-- the documentation and/or other materials provided with the
-- distribution.
--
-- - Neither the name of The Numerical ALgorithms Group Ltd. nor the
-- names of its contributors may be used to endorse or promote products
-- derived from this software without specific prior written permission.
--
--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
@
<<*>>=
<<license>>
<<category IDPC IndexedDirectProductCategory>>
<<domain IDPT IndexedProductTerm>>
<<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}