\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} <>= )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. leadingTerm : % -> IndexedProductTerm(A,S) ++ The leading term of an indexed product. 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} <>= )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} <>= )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] leadingTerm x == null terms x => error "Cannot take the leadingTerm of an empty product" first terms x reductum x == per rest rep x leadingCoefficient x == coefficient leadingTerm x leadingSupport x == index leadingTerm 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} <>= )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 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:NonNegativeInteger * 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} <>= )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 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} <>= )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 subtractIfCan(x,y) == zero? y => just x zero? x => nothing leadingSupport x < leadingSupport y => nothing leadingSupport x > leadingSupport y => t := subtractIfCan(reductum x, y) t case nothing => nothing just convert cons(leadingTerm x, terms t) u := subtractIfCan(leadingCoefficient x, leadingCoefficient y) u case nothing => nothing t := subtractIfCan(reductum x, reductum y) zero? u => t t case nothing => nothing just convert cons(term(leadingSupport x,u),terms t) sup(x,y) == zero? y => x zero? x => y leadingSupport x < leadingSupport y => convert cons(leadingTerm y,terms sup(x,reductum y)) leadingSupport x > leadingSupport y => convert cons(leadingTerm x,terms sup(reductum x,y)) u := sup(leadingCoefficient x, leadingCoefficient y) convert cons(term(leadingSupport x,u),terms sup(reductum x,reductum y)) @ \section{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} <>= --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. @ <<*>>= <> <> <> <> <> <> <> <> @ \eject \begin{thebibliography}{99} \bibitem{1} nothing \end{thebibliography} \end{document}