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

<<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]
    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}
<<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}
<<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
       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}
<<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}