path: root/src/algebra/indexedp.spad.pamphlet

\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: June 28, 2010
++ 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,ConvertibleFrom List IndexedProductTerm(A,S)) with
    if A has SetCategory and S has SetCategory then SetCategory
    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.
    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 == List IndexedProductTerm(A,S) add
    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]

    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

@
\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
    --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: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}