module Rainbox.Array2d
(
Table
, lCols
, lRows
, cells
, table
, labelCols
, labelRows
, mapTable
, mapColLabels
, mapRowLabels
, cols
, rows
, arrayByRows
, arrayByCols
) where
import Data.Array
data Table lCol lRow col row a = Table
{ lCols :: Array col lCol
, lRows :: Array row lRow
, cells :: Array (col, row) a
} deriving (Eq, Show)
instance (Ix col, Ix row) => Functor (Table lCol lRow col row) where
fmap f t = t { cells = fmap f . cells $ t }
table
:: (Ix col, Ix row)
=> (col -> [(row, a)] -> lCol)
-> (row -> [(col, a)] -> lRow)
-> Array (col, row) a
-> Table lCol lRow col row a
table fCol fRow ay = Table ayc ayr ay
where
ayc = labelCols fCol ay
ayr = labelRows fRow ay
labelCols
:: (Ix col, Ix row)
=> (col -> [(row, a)] -> lCol)
-> Array (col, row) a
-> Array col lCol
labelCols f a = listArray (minCol, maxCol) es
where
((minCol, minRow), (maxCol, maxRow)) = bounds a
es = zipWith f ixsCols . map mkRow $ ixsCols
where
ixsCols = range (minCol, maxCol)
mkRow col = zip ixsRows (map (\rw -> a ! (col, rw)) ixsRows)
where
ixsRows = range (minRow, maxRow)
labelRows
:: (Ix col, Ix row)
=> (row -> [(col, a)] -> lRow)
-> Array (col, row) a
-> Array row lRow
labelRows f a = listArray (minRow, maxRow) es
where
((minCol, minRow), (maxCol, maxRow)) = bounds a
es = zipWith f ixsRows . map mkCol $ ixsRows
where
ixsRows = range (minRow, maxRow)
mkCol row = zip ixsCols (map (\cl -> a ! (cl, row)) ixsCols)
where
ixsCols = range (minCol, maxCol)
mapTable
:: (Ix col, Ix row)
=> (lCol -> lRow -> col -> row -> a -> b)
-> Table lCol lRow col row a
-> Table lCol lRow col row b
mapTable f (Table cs rs ls) = Table cs rs ls'
where
ls' = listArray (bounds ls) . map g . assocs $ ls
where
g ((col, row), e) = f (cs ! col) (rs ! row) col row e
mapColLabels
:: (Ix col, Ix row)
=> (lCol -> col -> [(lRow, row, a)] -> lCol')
-> Table lCol lRow col row a
-> Table lCol' lRow col row a
mapColLabels f (Table cs rs ls) = Table cs' rs ls
where
((colMin, rowMin), (colMax, rowMax)) = bounds ls
cs' = listArray (colMin, colMax) es
where
es = zipWith3 f (elems cs) (indices cs) rws
where
rws = map mkRow . indices $ cs
where
mkRow idx = zipWith3 (,,) (elems rs)
(indices rs)
(map (ls !) (range ((idx, rowMin), (idx, rowMax))))
mapRowLabels
:: (Ix col, Ix row)
=> (lRow -> row -> [(lCol, col, a)] -> lRow')
-> Table lCol lRow col row a
-> Table lCol lRow' col row a
mapRowLabels f (Table cs rs ls) = Table cs rs' ls
where
((colMin, rowMin), (colMax, rowMax)) = bounds ls
rs' = listArray (rowMin, rowMax) es
where
es = zipWith3 f (elems rs) (indices rs) cls
where
cls = map mkCol . indices $ rs
where
mkCol idx = zipWith3 (,,) (elems cs)
(indices cs)
(map (ls !) (range ((colMin, idx), (colMax, idx))))
cols
:: (Ix col, Ix row)
=> Array (col, row) a
-> [[a]]
cols ay = map getCol $ range (minCol, maxCol)
where
((minCol, minRow), (maxCol, maxRow)) = bounds ay
ixsRows = range (minRow, maxRow)
getCol ixCol = map (\rw -> ay ! (ixCol, rw)) ixsRows
rows
:: (Ix col, Ix row)
=> Array (col, row) a
-> [[a]]
rows ay = map getRow $ range (minRow, maxRow)
where
((minCol, minRow), (maxCol, maxRow)) = bounds ay
ixsCols = range (minCol, maxCol)
getRow ixRow = map (\cl -> ay ! (cl, ixRow)) ixsCols
arrayByRows
:: [[a]]
-> Array (Int, Int) a
arrayByRows ls = array ((0,0), (colMax, rowMax)) $ indexRows ls
where
rowMax = length ls 1
colMax = case ls of
[] -> 1
x:_ -> length x 1
indexRows :: [[a]] -> [((Int, Int),a)]
indexRows = concat . map f . zip [0 ..]
where
f (rw, ls) = map g $ zip [0 ..] ls
where
g (cl, a) = ((cl, rw), a)
arrayByCols
:: [[a]]
-> Array (Int, Int) a
arrayByCols ls = listArray ((0,0), (colMax, rowMax)) . concat $ ls
where
colMax = length ls 1
rowMax = case ls of
[] -> 1
x:_ -> length x 1