axiom-source 20170501-3 / usr / share / axiom-20170501 / src / algebra / ARR2CAT.spad

)abbrev category ARR2CAT TwoDimensionalArrayCategory
++ Date Created: 27 October 1989
++ Date Last Updated: 27 June 1990
++ Keywords: array, data structure
++ Description:
++ Two dimensional array categories and domains

TwoDimensionalArrayCategory(R,Row,Col) : Category == SIG where
  R   : Type
  Row : FiniteLinearAggregate R
  Col : FiniteLinearAggregate R

  SIG ==> 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
      ++
      ++X arr : ARRAY2 INT := new(5,4,0)
      
    fill_! : (%,R) -> %
      ++ fill!(m,r) fills m with r's
      ++
      ++X arr : ARRAY2 INT := new(5,4,0)
      ++X fill!(arr,10)
  
    --% Size inquiries
  
    minRowIndex : % -> Integer
      ++ minRowIndex(m) returns the index of the 'first' row of the array m
      ++
      ++X arr : ARRAY2 INT := new(5,4,10)
      ++X minRowIndex(arr)
  
    maxRowIndex : % -> Integer
      ++ maxRowIndex(m) returns the index of the 'last' row of the array m
      ++
      ++X arr : ARRAY2 INT := new(5,4,10)
      ++X maxRowIndex(arr)
  
    minColIndex : % -> Integer
      ++ minColIndex(m) returns the index of the 'first' column of the array m
      ++
      ++X arr : ARRAY2 INT := new(5,4,10)
      ++X minColIndex(arr)
  
    maxColIndex : % -> Integer
      ++ maxColIndex(m) returns the index of the 'last' column of the array m
      ++
      ++X arr : ARRAY2 INT := new(5,4,10)
      ++X maxColIndex(arr)
  
    nrows : % -> NonNegativeInteger
      ++ nrows(m) returns the number of rows in the array m
      ++
      ++X arr : ARRAY2 INT := new(5,4,10)
      ++X nrows(arr)
  
    ncols : % -> NonNegativeInteger
      ++ ncols(m) returns the number of columns in the array m
      ++
      ++X arr : ARRAY2 INT := new(5,4,10)
      ++X ncols(arr)
  
    --% 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
      ++
      ++X arr : ARRAY2 INT := new(5,4,10)
      ++X elt(arr,1,1)
  
    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
      ++
      ++X arr : ARRAY2 INT := new(5,4,10)
      ++X qelt(arr,1,1)
  
    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
      ++
      ++X arr : ARRAY2 INT := new(5,4,10)
      ++X elt(arr,1,1,6)
      ++X elt(arr,1,10,6)
  
    row : (%,Integer) -> Row
      ++ row(m,i) returns the ith row of m
      ++ error check to determine if index is in proper ranges
      ++
      ++X arr : ARRAY2 INT := new(5,4,10)
      ++X row(arr,1)
  
    column : (%,Integer) -> Col
      ++ column(m,j) returns the jth column of m
      ++ error check to determine if index is in proper ranges
      ++
      ++X arr : ARRAY2 INT := new(5,4,10)
      ++X column(arr,1)
  
    parts : % -> List R
      ++ parts(m) returns a list of the elements of m in row major order
      ++
      ++X arr : ARRAY2 INT := new(5,4,10)
      ++X parts(arr)
  
    --% Part assignments
  
    setelt : (%,Integer,Integer,R) -> R
      ++ 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
      ++
      ++X arr : ARRAY2 INT := new(5,4,0)
      ++X setelt(arr,1,1,17)
  
    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
      ++
      ++X arr : ARRAY2 INT := new(5,4,0)
      ++X qsetelt!(arr,1,1,17)
  
    setRow_! : (%,Integer,Row) -> %
      ++ setRow!(m,i,v) sets to ith row of m to v
      ++
      ++X T1:=TwoDimensionalArray Integer
      ++X arr:T1:= new(5,4,0)
      ++X T2:=OneDimensionalArray Integer
      ++X arow:=construct([1,2,3,4]::List(INT))$T2
      ++X setRow!(arr,1,arow)$T1
  
    setColumn_! : (%,Integer,Col) -> %
      ++ setColumn!(m,j,v) sets to jth column of m to v
      ++
      ++X T1:=TwoDimensionalArray Integer
      ++X arr:T1:= new(5,4,0)
      ++X T2:=OneDimensionalArray Integer
      ++X acol:=construct([1,2,3,4,5]::List(INT))$T2
      ++X setColumn!(arr,1,acol)$T1
  
    --% 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}
      ++
      ++X arr : ARRAY2 INT := new(5,4,10)
      ++X map(-,arr)
      ++X map((x +-> x + x),arr)
  
    map_! : (R -> R,%) -> %
      ++ map!(f,a)  assign \spad{a(i,j)} to \spad{f(a(i,j))} 
      ++ for all \spad{i, j}
      ++
      ++X arr : ARRAY2 INT := new(5,4,10)
      ++X map!(-,arr)
  
    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}
      ++
      ++X adder(a:Integer,b:Integer):Integer == a+b
      ++X arr : ARRAY2 INT := new(5,4,10)
      ++X map(adder,arr,arr)
  
    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)}.
      ++
      ++X adder(a:Integer,b:Integer):Integer == a+b
      ++X arr1 : ARRAY2 INT := new(5,4,10)
      ++X arr2 : ARRAY2 INT := new(3,3,10)
      ++X map(adder,arr1,arr2,17)
  
   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
  
     copy m ==
       ans := new(nrows m,ncols m,NIL$Lisp)
       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,NIL$Lisp)
       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,NIL$Lisp)
       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),NIL$Lisp)
       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(x +-> x = 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,NIL$Lisp)
         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,NIL$Lisp)
         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