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

\documentclass{article}
\usepackage{open-axiom}
\begin{document}
\title{\$SPAD/src/algebra array2.spad}
\author{The Axiom Team}
\maketitle
\begin{abstract}
\end{abstract}
\eject
\tableofcontents
\eject
\section{category ARR2CAT TwoDimensionalArrayCategory}
<<category ARR2CAT TwoDimensionalArrayCategory>>=
)abbrev category ARR2CAT TwoDimensionalArrayCategory
++ Two dimensional array categories and domains
++ Author:
++ Date Created: 27 October 1989
++ Date Last Updated: 27 June 1990
++ Keywords: array, data structure
++ Examples:
++ References:
TwoDimensionalArrayCategory(R,Row,Col): Category == Definition where
  ++ TwoDimensionalArrayCategory is a general array category which
  ++ allows different representations and indexing schemes.
  ++ Rows and columns may be extracted with rows returned as objects
  ++ of type Row and columns returned as objects of type Col.
  ++ The index of the 'first' row may be obtained by calling the
  ++ function 'minRowIndex'.  The index of the 'first' column may
  ++ be obtained by calling the function 'minColIndex'.  The index of
  ++ the first element of a 'Row' is the same as the index of the
  ++ first column in an array and vice versa.
  R   : Type
  Row : FiniteLinearAggregate R
  Col : FiniteLinearAggregate R

  Definition == HomogeneousAggregate(R) with

    shallowlyMutable
      ++ one may destructively alter arrays

    finiteAggregate
      ++ two-dimensional arrays are finite

--% Array creation

    new: (NonNegativeInteger,NonNegativeInteger,R) -> %
      ++ new(m,n,r) is an m-by-n array all of whose entries are r
    fill!: (%,R) -> %
      ++ fill!(m,r) fills m with r's

--% Size inquiries

    minRowIndex : % -> Integer
      ++ minRowIndex(m) returns the index of the 'first' row of the array m
    maxRowIndex : % -> Integer
      ++ maxRowIndex(m) returns the index of the 'last' row of the array m
    minColIndex : % -> Integer
      ++ minColIndex(m) returns the index of the 'first' column of the array m
    maxColIndex : % -> Integer
      ++ maxColIndex(m) returns the index of the 'last' column of the array m
    nrows : % -> NonNegativeInteger
      ++ nrows(m) returns the number of rows in the array m
    ncols : % -> NonNegativeInteger
      ++ ncols(m) returns the number of columns in the array m

--% Part extractions

    elt: (%,Integer,Integer) -> R
      ++ elt(m,i,j) returns the element in the ith row and jth
      ++ column of the array m
      ++ error check to determine if indices are in proper ranges
    qelt: (%,Integer,Integer) -> R
      ++ qelt(m,i,j) returns the element in the ith row and jth
      ++ column of the array m
      ++ NO error check to determine if indices are in proper ranges
    elt: (%,Integer,Integer,R) -> R
      ++ elt(m,i,j,r) returns the element in the ith row and jth
      ++ column of the array m, if m has an ith row and a jth column,
      ++ and returns r otherwise
    row: (%,Integer) -> Row
      ++ row(m,i) returns the ith row of m
      ++ error check to determine if index is in proper ranges
    column: (%,Integer) -> Col
      ++ column(m,j) returns the jth column of m
      ++ error check to determine if index is in proper ranges
    parts: % -> List R
      ++ parts(m) returns a list of the elements of m in row major order

--% Part assignments

    setelt: (%,Integer,Integer,R) -> R
      -- will become setelt!
      ++ setelt(m,i,j,r) sets the element in the ith row and jth
      ++ column of m to r
      ++ error check to determine if indices are in proper ranges
    qsetelt!: (%,Integer,Integer,R) -> R
      ++ qsetelt!(m,i,j,r) sets the element in the ith row and jth
      ++ column of m to r
      ++ NO error check to determine if indices are in proper ranges
    setRow!: (%,Integer,Row) -> %
      ++ setRow!(m,i,v) sets to ith row of m to v
    setColumn!: (%,Integer,Col) -> %
      ++ setColumn!(m,j,v) sets to jth column of m to v

--% Map and Zip

    map: (R -> R,%) -> %
      ++ map(f,a) returns \spad{b}, where \spad{b(i,j) = f(a(i,j))} for all \spad{i, j}
    map!: (R -> R,%) -> %
      ++ map!(f,a)  assign \spad{a(i,j)} to \spad{f(a(i,j))} for all \spad{i, j}
    map:((R,R) -> R,%,%) -> %
      ++ map(f,a,b) returns \spad{c}, where \spad{c(i,j) = f(a(i,j),b(i,j))}
      ++ for all \spad{i, j}
    map:((R,R) -> R,%,%,R) -> %
      ++ map(f,a,b,r) returns \spad{c}, where \spad{c(i,j) = f(a(i,j),b(i,j))} when both
      ++ \spad{a(i,j)} and \spad{b(i,j)} exist;
      ++ else \spad{c(i,j) = f(r, b(i,j))} when \spad{a(i,j)} does not exist;
      ++ else \spad{c(i,j) = f(a(i,j),r)} when \spad{b(i,j)} does not exist;
      ++ otherwise \spad{c(i,j) = f(r,r)}.

   add

--% Predicates

    any?(f,m) ==
      for i in minRowIndex(m)..maxRowIndex(m) repeat
        for j in minColIndex(m)..maxColIndex(m) repeat
          f(qelt(m,i,j)) => return true
      false

    every?(f,m) ==
      for i in minRowIndex(m)..maxRowIndex(m) repeat
        for j in minColIndex(m)..maxColIndex(m) repeat
          not f(qelt(m,i,j)) => return false
      true

    size?(m,n) == nrows(m) * ncols(m) = n
    less?(m,n) == nrows(m) * ncols(m) < n
    more?(m,n) == nrows(m) * ncols(m) > n

--% Size inquiries

    # m == nrows(m) * ncols(m)

--% Part extractions

    elt(m,i,j,r) ==
      i < minRowIndex(m) or i > maxRowIndex(m) => r
      j < minColIndex(m) or j > maxColIndex(m) => r
      qelt(m,i,j)

    count(f:R -> Boolean,m:%) ==
      num : NonNegativeInteger := 0
      for i in minRowIndex(m)..maxRowIndex(m) repeat
        for j in minColIndex(m)..maxColIndex(m) repeat
          if f(qelt(m,i,j)) then num := num + 1
      num

    parts m ==
      entryList : List R := nil()
      for i in maxRowIndex(m)..minRowIndex(m) by -1 repeat
        for j in maxColIndex(m)..minColIndex(m) by -1 repeat
          entryList := concat(qelt(m,i,j),entryList)
      entryList

--% Creation
    -- array creation requires an initial element used to
    -- populate the array.  This is a best effort attempt
    -- to supply such element, when semantics permits.
    sampleElement(): R ==
      R has sample: () -> R => sample()$R
      NIL$Lisp    -- better obfuscation welcome.

    copy m ==
      ans := new(nrows m,ncols m,sampleElement())
      for i in minRowIndex(m)..maxRowIndex(m) repeat
        for j in minColIndex(m)..maxColIndex(m) repeat
          qsetelt!(ans,i,j,qelt(m,i,j))
      ans

    fill!(m,r) ==
      for i in minRowIndex(m)..maxRowIndex(m) repeat
        for j in minColIndex(m)..maxColIndex(m) repeat
          qsetelt!(m,i,j,r)
      m

    map(f,m) ==
      ans := new(nrows m,ncols m,sampleElement())
      for i in minRowIndex(m)..maxRowIndex(m) repeat
        for j in minColIndex(m)..maxColIndex(m) repeat
          qsetelt!(ans,i,j,f(qelt(m,i,j)))
      ans

    map!(f,m) ==
      for i in minRowIndex(m)..maxRowIndex(m) repeat
        for j in minColIndex(m)..maxColIndex(m) repeat
          qsetelt!(m,i,j,f(qelt(m,i,j)))
      m

    map(f,m,n) ==
      (nrows(m) ~= nrows(n)) or (ncols(m) ~= ncols(n)) =>
        error "map: arguments must have same dimensions"
      ans := new(nrows m,ncols m,sampleElement())
      for i in minRowIndex(m)..maxRowIndex(m) repeat
        for j in minColIndex(m)..maxColIndex(m) repeat
          qsetelt!(ans,i,j,f(qelt(m,i,j),qelt(n,i,j)))
      ans

    map(f,m,n,r) ==
      maxRow := max(maxRowIndex m,maxRowIndex n)
      maxCol := max(maxColIndex m,maxColIndex n)
      ans := new(max(nrows m,nrows n),max(ncols m,ncols n),sampleElement())
      for i in minRowIndex(m)..maxRow repeat
        for j in minColIndex(m)..maxCol repeat
          qsetelt!(ans,i,j,f(elt(m,i,j,r),elt(n,i,j,r)))
      ans

    setRow!(m,i,v) ==
      i < minRowIndex(m) or i > maxRowIndex(m) =>
        error "setRow!: index out of range"
      for j in minColIndex(m)..maxColIndex(m) _
        for k in minIndex(v)..maxIndex(v) repeat
          qsetelt!(m,i,j,v.k)
      m

    setColumn!(m,j,v) ==
      j < minColIndex(m) or j > maxColIndex(m) =>
        error "setColumn!: index out of range"
      for i in minRowIndex(m)..maxRowIndex(m) _
        for k in minIndex(v)..maxIndex(v) repeat
          qsetelt!(m,i,j,v.k)
      m

    if R has _= : (R,R) -> Boolean then

      m = n ==
        eq?(m,n) => true
        (nrows(m) ~= nrows(n)) or (ncols(m) ~= ncols(n)) => false
        for i in minRowIndex(m)..maxRowIndex(m) repeat
          for j in minColIndex(m)..maxColIndex(m) repeat
            not (qelt(m,i,j) = qelt(n,i,j)) => return false
        true

      member?(r,m) ==
        for i in minRowIndex(m)..maxRowIndex(m) repeat
          for j in minColIndex(m)..maxColIndex(m) repeat
            qelt(m,i,j) = r => return true
        false

      count(r:R,m:%) == count(#1 = r,m)

    if Row has shallowlyMutable then

      row(m,i) ==
        i < minRowIndex(m) or i > maxRowIndex(m) =>
          error "row: index out of range"
        v : Row := new(ncols m,sampleElement())
        for j in minColIndex(m)..maxColIndex(m) _
          for k in minIndex(v)..maxIndex(v) repeat
            qsetelt!(v,k,qelt(m,i,j))
        v

    if Col has shallowlyMutable then

      column(m,j) ==
        j < minColIndex(m) or j > maxColIndex(m) =>
          error "column: index out of range"
        v : Col := new(nrows m,sampleElement())
        for i in minRowIndex(m)..maxRowIndex(m) _
          for k in minIndex(v)..maxIndex(v) repeat
            qsetelt!(v,k,qelt(m,i,j))
        v

    if R has CoercibleTo(OutputForm) then

      coerce(m:%) ==
        l : List List OutputForm
        l := [[qelt(m,i,j) :: OutputForm _
                  for j in minColIndex(m)..maxColIndex(m)] _
                  for i in minRowIndex(m)..maxRowIndex(m)]
        matrix l

@
\section{domain IIARRAY2 InnerIndexedTwoDimensionalArray}
<<domain IIARRAY2 InnerIndexedTwoDimensionalArray>>=
)abbrev domain IIARRAY2 InnerIndexedTwoDimensionalArray
InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col):_
       Exports == Implementation where
  ++ This is an internal type which provides an implementation of
  ++ 2-dimensional arrays as PrimitiveArray's of PrimitiveArray's.
  R : Type
  mnRow, mnCol : Integer
  Row : FiniteLinearAggregate R
  Col : FiniteLinearAggregate R

  Exports ==> TwoDimensionalArrayCategory(R,Row,Col)

  Implementation ==> add

    Rep := PrimitiveArray PrimitiveArray R

--% Predicates

    empty? m == empty?(m)$Rep

--% Primitive array creation

    empty() == empty()$Rep

    new(rows,cols,a) ==
      rows = 0 =>
        error "new: arrays with zero rows are not supported"
--      cols = 0 =>
--        error "new: arrays with zero columns are not supported"
      arr : PrimitiveArray PrimitiveArray R := new(rows,empty())
      for i in minIndex(arr)..maxIndex(arr) repeat
        qsetelt!(arr,i,new(cols,a))
      arr

--% Size inquiries

    minRowIndex m == mnRow
    minColIndex m == mnCol
    maxRowIndex m == nrows m + mnRow - 1
    maxColIndex m == ncols m + mnCol - 1

    nrows m == (# m)$Rep

    ncols m ==
      empty? m => 0
      # m(minIndex(m)$Rep)

--% Part selection/assignment

    qelt(m,i,j) ==
      qelt(qelt(m,i - minRowIndex m)$Rep,j - minColIndex m)

    elt(m:%,i:Integer,j:Integer) ==
      i < minRowIndex(m) or i > maxRowIndex(m) =>
        error "elt: index out of range"
      j < minColIndex(m) or j > maxColIndex(m) =>
        error "elt: index out of range"
      qelt(m,i,j)

    qsetelt!(m,i,j,r) ==
      setelt(qelt(m,i - minRowIndex m)$Rep,j - minColIndex m,r)

    setelt(m:%,i:Integer,j:Integer,r:R) ==
      i < minRowIndex(m) or i > maxRowIndex(m) =>
        error "setelt: index out of range"
      j < minColIndex(m) or j > maxColIndex(m) =>
        error "setelt: index out of range"
      qsetelt!(m,i,j,r)

    if R has SetCategory then
        latex(m : %) : String ==
          s : String := "\left[ \begin{array}{"
          for j in minColIndex(m)..maxColIndex(m) repeat
            s := concat(s,"c")$String
          s := concat(s,"} ")$String
          for i in minRowIndex(m)..maxRowIndex(m) repeat
            for j in minColIndex(m)..maxColIndex(m) repeat
              s := concat(s, latex(qelt(m,i,j))$R)$String
              if j < maxColIndex(m) then s := concat(s, " & ")$String
            if i < maxRowIndex(m) then s := concat(s, " \\ ")$String
          concat(s, "\end{array} \right]")$String

@
\section{domain IARRAY2 IndexedTwoDimensionalArray}
<<domain IARRAY2 IndexedTwoDimensionalArray>>=
)abbrev domain IARRAY2 IndexedTwoDimensionalArray
IndexedTwoDimensionalArray(R,mnRow,mnCol):Exports == Implementation where
  ++ An IndexedTwoDimensionalArray is a 2-dimensional array where
  ++ the minimal row and column indices are parameters of the type.
  ++ Rows and columns are returned as IndexedOneDimensionalArray's with
  ++ minimal indices matching those of the IndexedTwoDimensionalArray.
  ++ The index of the 'first' row may be obtained by calling the
  ++ function 'minRowIndex'.  The index of the 'first' column may
  ++ be obtained by calling the function 'minColIndex'.  The index of
  ++ the first element of a 'Row' is the same as the index of the
  ++ first column in an array and vice versa.
  R : Type
  mnRow, mnCol : Integer
  Row ==> IndexedOneDimensionalArray(R,mnCol)
  Col ==> IndexedOneDimensionalArray(R,mnRow)

  Exports ==> TwoDimensionalArrayCategory(R,Row,Col)

  Implementation ==>
    InnerIndexedTwoDimensionalArray(R,mnRow,mnCol,Row,Col)

@
\section{domain ARRAY2 TwoDimensionalArray}
<<domain ARRAY2 TwoDimensionalArray>>=
)abbrev domain ARRAY2 TwoDimensionalArray
TwoDimensionalArray(R):Exports == Implementation where
  ++ A TwoDimensionalArray is a two dimensional array with
  ++ 1-based indexing for both rows and columns.
  R : Type
  Row ==> OneDimensionalArray R
  Col ==> OneDimensionalArray R

  Exports ==> TwoDimensionalArrayCategory(R,Row,Col) with
    shallowlyMutable
      ++ One may destructively alter TwoDimensionalArray's.

  Implementation ==> InnerIndexedTwoDimensionalArray(R,1,1,Row,Col)

@
\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 ARR2CAT TwoDimensionalArrayCategory>>
<<domain IIARRAY2 InnerIndexedTwoDimensionalArray>>
<<domain IARRAY2 IndexedTwoDimensionalArray>>
<<domain ARRAY2 TwoDimensionalArray>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}