Emulating non-rectangular arrays - haskell

Often times you want the performance of arrays over linked lists while having not conforming to the requirement of having rectangular arrays.
As an example consider an hexagonal grid, here shown with the 1-distance neighbors of cell (3, 3) in medium gray and the 2-distance neighbors in light gray.
Say we want an array that contains, for each cell, the indices of every 1- and 2-distance neighbor for that cell. One slight issue is that cells have a different amount of X-distance neighbors -- cells on the grid border will have fewer neighbors than cells closer to the grid center.
(We want an array of neighbor indices --- instead of a function from cell coordinates to neighbor indices --- for performance reasons.)
We can work around this problem by keeping track of how many neighbors each cell has. Say you have an array
neighbors2 of size R x C x N x 2, where R is the number of grid rows, C for columns, and N is the maximum number of 2-distance neighbors for any cell in the grid.
Then, by keeping an additional array n_neighbors2 of size R x C, we can keep track of which indices in neighbors2 are populated and which are just zero padding. For example, to retrieve the the 2-distance neighbors of cell (2, 5), we simply index into the array as such:
someNeigh = neighbors2[2, 5, 0..n_neighbors2[2, 5], ..]
someNeigh will be a n_neighbors2[2, 5] x 2 array (or view) of indicies, where someNeigh[0, 0] yields the row of the first neighbor, and someNeigh[0, 1] yields the column of the first neighbor and so forth.
Note that the elements at the positions
neighbors2[2, 5, n_neighbors2[2, 5]+1.., ..]
are irrelevant; this space is just padding to keep the matrix rectangular.
Provided we have a function for finding the d-distance neighbors for any cell:
import Data.Bits (shift)
rows, cols = (7, 7)
type Cell = (Int, Int)
generateNeighs :: Int -> Cell -> [Cell]
generateNeighs d cell1 = [ (row2, col2)
| row2 <- [0..rows-1]
, col2 <- [0..cols-1]
, hexDistance cell1 (row2, col2) == d]
hexDistance :: Cell -> Cell -> Int
hexDistance (r1, c1) (r2, c2) = shift (abs rd + abs (rd + cd) + abs cd) (-1)
where
rd = r1 - r2
cd = c1 - c2
How can we create the aforementioned arrays neighbors2 and n_neighbors2? Assume we know the maximum amount of 2-distance neighbors N beforehand. Then it is possible to modify generateNeighs to always return lists of the same size, as we can fill up remaining entries with (0, 0). That leaves, as I see it, two problems:
We need a function to populate neighbors2 which operates not every individual index but on a slice, in our case it should fill one cell at a time.
n_neighbors2 should be populated simultaneously as neighbors2
A solution is welcome with either repa or accelerate arrays.

Here's you picture skewed 30 degrees to the right:
As you can see your array is actually perfectly rectangular.
The indices of a neighborhood's periphery are easily found as six straight pieces around the chosen center cell, e.g. (imagine n == 2 is the distance of the periphery from the center (i,j) == (3,3) in the picture):
periphery n (i,j) =
-- 2 (3,3)
let
((i1,j1):ps1) = reverse . take (n+1) . iterate (\(i,j)->(i,j+1)) $ (i-n,j)
-- ( 1, 3)
((i2,j2):ps2) = reverse . take (n+1) . iterate (\(i,j)->(i+1,j)) $ (i1,j1)
-- ( 1, 5)
.....
ps6 = ....... $ (i5,j5)
in filter isValid (ps6 ++ ... ++ ps2 ++ ps1)
The whole neighborhood is simply
neighborhood n (i,j) = (i,j) : concat [ periphery k (i,j) | k <- [1..n] ]
For each cell/distance combination, simply generate the neighborhood indices on the fly and access your array in O(1) time for each index pair.

Writing out the answer from #WillNess in full, and incorporating the proposal from #leftroundabout to store indecies in a 1D vector instead, and we get this:
import qualified Data.Array.Accelerate as A
import Data.Array.Accelerate (Acc, Array, DIM1, DIM2, DIM3, Z(..), (:.)(..), (!), fromList, use)
rows = 7
cols = 7
type Cell = (Int, Int)
(neighs, nNeighs) = generateNeighs
-- Return a vector of indices of cells at distance 'd' or less from the given cell
getNeighs :: Int -> Cell -> Acc (Array DIM1 Cell)
getNeighs d (r,c) = A.take n $ A.drop start neighs
where
start = nNeighs ! A.constant (Z :. r :. c :. 0)
n = nNeighs ! A.constant (Z :. r :. c :. d)
generateNeighs :: (Acc (Array DIM1 Cell), Acc (Array DIM3 Int))
generateNeighs = (neighsArr, nNeighsArr)
where
idxs = concat [[(r, c) | c <- [0..cols-1]] | r <- [0..rows-1]]
(neighsLi, nNeighsLi, n) = foldl inner ([], [], 0) idxs
neighsArr = use $ fromList (Z :. n) neighsLi
nNeighsArr = use $ fromList (Z :. rows :. cols :. 5) nNeighsLi
inner (neighs', nNeighs', n') idx = (neighs' ++ cellNeighs, nNeighs'', n'')
where
(cellNeighs, cellNNeighs) = neighborhood idx
n'' = n' + length cellNeighs
nNeighs'' = nNeighs' ++ n' : cellNNeighs
neighborhood :: Cell -> ([Cell], [Int])
neighborhood (r,c) = (neighs, nNeighs)
where
neighsO = [ periphery d (r,c) | d <- [1..4] ]
neighs = (r,c) : concat neighsO
nNeighs = tail $ scanl (+) 1 $ map length neighsO
periphery d (r,c) =
-- The set of d-distance neighbors form a hexagon shape. Traverse each of
-- the sides of this hexagon and gather up the cell indices.
let
ps1 = take d . iterate (\(r,c)->(r,c+1)) $ (r-d,c)
ps2 = take d . iterate (\(r,c)->(r+1,c)) $ (r-d,c+d)
ps3 = take d . iterate (\(r,c)->(r+1,c-1)) $ (r,c+d)
ps4 = take d . iterate (\(r,c)->(r,c-1)) $ (r+d,c)
ps5 = take d . iterate (\(r,c)->(r-1,c)) $ (r+d,c-d)
ps6 = take d . iterate (\(r,c)->(r-1,c+1)) $ (r,c-d)
in filter isValid (ps6 ++ ps5 ++ ps4 ++ ps3 ++ ps2 ++ ps1)
isValid :: Cell -> Bool
isValid (r, c)
| r < 0 || r >= rows = False
| c < 0 || c >= cols = False
| otherwise = True

This can be by using the permute function to fill the neighbors for 1 cell at a time.
import Data.Bits (shift)
import Data.Array.Accelerate as A
import qualified Prelude as P
import Prelude hiding ((++), (==))
rows = 7
cols = 7
channels = 70
type Cell = (Int, Int)
(neighs, nNeighs) = fillNeighs
getNeighs :: Cell -> Acc (Array DIM1 Cell)
getNeighs (r, c) = A.take (nNeighs ! sh1) $ slice neighs sh2
where
sh1 = constant (Z :. r :. c)
sh2 = constant (Z :. r :. c :. All)
fillNeighs :: (Acc (Array DIM3 Cell), Acc (Array DIM2 Int))
fillNeighs = (neighs2, nNeighs2)
where
sh = constant (Z :. rows :. cols :. 18) :: Exp DIM3
neighZeros = fill sh (lift (0 :: Int, 0 :: Int)) :: Acc (Array DIM3 Cell)
-- nNeighZeros = fill (constant (Z :. rows :. cols)) 0 :: Acc (Array DIM2 Int)
(neighs2, nNeighs2li) = foldr inner (neighZeros, []) indices
nNeighs2 = use $ fromList (Z :. rows :. cols) nNeighs2li
-- Generate indices by varying column fastest. This assures that fromList, which fills
-- the array in row-major order, gets nNeighs in the correct order.
indices = foldr (\r acc -> foldr (\c acc2 -> (r, c):acc2 ) acc [0..cols-1]) [] [0..rows-1]
inner :: Cell
-> (Acc (Array DIM3 Cell), [Int])
-> (Acc (Array DIM3 Cell), [Int])
inner cell (neighs, nNeighs) = (newNeighs, n : nNeighs)
where
(newNeighs, n) = fillCell cell neighs
-- Given an cell and a 3D array to contain cell neighbors,
-- fill in the neighbors for the given cell
-- and return the number of neighbors filled in
fillCell :: Cell -> Acc (Array DIM3 Cell) -> (Acc (Array DIM3 Cell), Int)
fillCell (r, c) arr = (permute const arr indcomb neighs2arr, nNeighs)
where
(ra, ca) = (lift r, lift c) :: (Exp Int, Exp Int)
neighs2li = generateNeighs 2 (r, c)
nNeighs = P.length neighs2li
neighs2arr = use $ fromList (Z :. nNeighs) neighs2li
-- Traverse the 3rd dimension of the given cell
indcomb :: Exp DIM1 -> Exp DIM3
indcomb nsh = index3 ra ca (unindex1 nsh)
generateNeighs :: Int -> Cell -> [Cell]
generateNeighs d cell1 = [ (row2, col2)
| row2 <- [0..rows]
, col2 <- [0..cols]
, hexDistance cell1 (row2, col2) P.== d]
-- Manhattan distance between two cells in an hexagonal grid with an axial coordinate system
hexDistance :: Cell -> Cell -> Int
hexDistance (r1, c1) (r2, c2) = shift (abs rd + abs (rd + cd) + abs cd) (-1)
where
rd = r1 - r2
cd = c1 - c2

Related

Convert a list of position,value tuples into a single list

I am writing some code to work with arbitrary radix numbers in haskell. They will be stored as lists of integers representing the digits.
I almost managed to get it working, but I have run into the problem of converting a list of tuples [(a_1,b_1),...,(a_n,b_n)] into a single list which is defined as follows:
for all i, L(a_i) = b_i.
if there is no i such that a_i = k, a(k)=0
In other words, this is a list of (position,value) pairs for values in an array. If a position does not have a corresponding value, it should be set to zero.
I have read this (https://wiki.haskell.org/How_to_work_on_lists) but I don't think any of these methods are suitable for this task.
baseN :: Integer -> Integer -> [Integer]
baseN n b = convert_digits (baseN_digits n b)
chunk :: (Integer, Integer) -> [Integer]
chunk (e,m) = m : (take (fromIntegral e) (repeat 0))
-- This is broken because the exponents don't count for each other's zeroes
convert_digits :: [(Integer,Integer)] -> [Integer]
convert_digits ((e,m):rest) = m : (take (fromIntegral (e)) (repeat 0))
convert_digits [] = []
-- Converts n to base b array form, where a tuple represents (exponent,digit).
-- This works, except it ignores digits which are zero. thus, I converted it to return (exponent, digit) pairs.
baseN_digits :: Integer -> Integer -> [(Integer,Integer)]
baseN_digits n b | n <= 0 = [] -- we're done.
| b <= 0 = [] -- garbage input.
| True = (e,m) : (baseN_digits (n-((b^e)*m)) b)
where e = (greedy n b 0) -- Exponent of highest digit
m = (get_coef n b e 1) -- the highest digit
-- Returns the exponent of the highest digit.
greedy :: Integer -> Integer -> Integer -> Integer
greedy n b e | n-(b^e) < 0 = (e-1) -- We have overshot so decrement.
| n-(b^e) == 0 = e -- We nailed it. No need to decrement.
| n-(b^e) > 0 = (greedy n b (e+1)) -- Not there yet.
-- Finds the multiplicity of the highest digit
get_coef :: Integer -> Integer -> Integer -> Integer -> Integer
get_coef n b e m | n - ((b^e)*m) < 0 = (m-1) -- We overshot so decrement.
| n - ((b^e)*m) == 0 = m -- Nailed it, no need to decrement.
| n - ((b^e)*m) > 0 = get_coef n b e (m+1) -- Not there yet.
You can call "baseN_digits n base" and it will give you the corresponding array of tuples which needs to be converted to the correct output
Here's something I threw together.
f = snd . foldr (\(e,n) (i,l') -> ( e , (n : replicate (e-i-1) 0) ++ l')) (-1,[])
f . map (fromIntegral *** fromIntegral) $ baseN_digits 50301020 10 = [5,0,3,0,1,0,2,0]
I think I understood your requirements (?)
EDIT:
Perhaps more naturally,
f xs = foldr (\(e,n) fl' i -> (replicate (i-e) 0) ++ (n : fl' (e-1))) (\i -> replicate (i+1) 0) xs 0

Printing a game board using a Data.Map

I have a Data.Map (Int, Int) [String] representing the board of a game (I assume that at a position on the map there can be more than one piece). Let's say that i have the following Map:
fromList [ ( (0,1) , ["piece1", "piece2"] )
, ( (2,2) , ["piece3", "piece4"] ) ]
What I am trying to do is printing the table, in this case a 3 X 3 table, with the elements of the map at the position specified while the rest of the spaces are empty or have an 'x'. I have tried to use foldl and map and combinations of the 2 but I just don't get it how i should do it. I have to mention that i am very new to Haskell. Any help would be great!
Output should be:
x | piece1piece2 | x
x | x | x
x | x | piece3piece4
Here's some code that will get you started. It works by iterating over the (row,column) coords of the board. In the iteration it looks up the string to print for that location, defaulting to "x" on failure. Finally the board is printed one row at a time.
The final format is not exactly what you had in mind but it should get you most of the way there.
import Data.Map as DM
import Data.Maybe
import Data.List.Split
main = do
let pieces = fromList [ ( (0,1) , ["piece1", "piece2"] )
, ( (2,2) , ["piece3", "piece4"] ) ]
-- prepare piece name lists for printing
p2 = fmap concat pieces
height = 3
width = 3
-- iterate over board in row/column order
-- lookup name - use "x" if not found
namesInOrder = [fromMaybe "x" $ DM.lookup (row,col) p2
| row <- [0..height-1]
, col <- [0..width-1]
]
-- split into chunks of one row each
rows = chunksOf width namesInOrder
-- print each row on its own line
mapM print rows
I'm going to start off with the import of Data.Map.Strict. Generally the way to do it is
import qualified Data.Map.Strict as M
import Data.Map.Strict (Map)
You have a Map (Int, Int) String, and you need to print out a square array of strings. It seems that the first thing you need to do is calculate the dimensions of the array. We can do that with an indexed fold. It looks like a good one for the job is
foldlWithKey' :: (a -> k -> b -> a) -> a -> Map k b -> a
Hrmm... Those type variables aren't very informative. Let me relabel them:
foldlWithKey'
:: (acc -> key -> elem -> acc)
-> acc
-> Map key elem
-> acc
This function takes an initial value of an accumulator, and a function indicating how to modify that accumulator for each key and element in the map. Let's make a type representing the dimensions of the board:
data Dim = Dim { rows :: !Int, cols :: !Int }
Now we can write
getDim :: Map (Int, Int) a -> Dim
getDim = M.foldlWithKey' update (Dim 0 0)
where
update (Dim rs cs) (r, c) _
= Dim (max rs (r + 1)) (max cs (c + 1))
For each entry in the Map, we adjust the row and column counts as necessary.
Now that we know the dimensions of the board, let's build a representation of it that will be more suitable for printing. The simplest way to do this is probably to iterate over the row and column numbers, looking up the pairs in the map. Let's start by writing a function to get a single row:
getRow :: Int -> Dim -> Map (Int, Int) a -> [Maybe a]
getRow r (Dim {cols = cs}) m =
[ M.lookup (r, c) | c <- [0 .. cs - 1] ]
Here Nothing means that the key was not in the map, and Just whatever means it was.
Now we can use that to get all the rows:
getRows :: Dim -> Map (Int, Int) a -> [[Maybe a]]
getRows dim#(Dim {rows = rs}) m =
[ getRow r dim m | r <- [0 .. rs - 1] ]
Now we can think about displaying! I'm going to leave this to you, but I suggest you consider using Data.List.intercalate and map to turn each row into a string.

How to do a triangular array in Haskell

I want to do something like
array ((0,0), (25, 25)) [((i,j), 1) | i <- [0..25], j <- [i..25]]
which you can see by the array index, is only defined when i <= j. However, when I try to print this out in ghci I get an error because it tries to print things like (1,0) due to the array bounds.
((1,0),*** Exception: (Array.!): undefined array element
I could just have the array be square and put something like 0's in those entries, but I think that would be suboptimal. Is there a way I can set up the bounds of this array to be "triangular"?
A simple upper triangular index can be defined as:
import Data.Ix (Ix, range, index, inRange)
data UpperTriagIndex = Int :. Int
deriving (Show, Ord, Eq)
instance Ix UpperTriagIndex where
range (a :. b, c :. d) = concatMap (\i -> (i :.) <$> [max i b..d]) [a..c]
inRange (a :. b, c :. d) (i :. j) = a <= i && i <= c && b <= j && j <= d
index pr#(a :. b, c :. d) ix#(i :. j)
| inRange pr ix = f a - f i + j - i
| otherwise = error "out of range!"
where f x = let s = d + 1 - max x b in s * (s + 1) `div` 2
One can verify that range and index round trip even if the array is not square. For example:
\> let pr = (0 :. 0, 3 :. 5) in index pr <$> range pr
[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17] -- [0..17]
and:
\> import Data.Array (array, (!))
\> let f i j = (i :. j, "row: " ++ show i ++ ", col: " ++ show j)
\> let a = array ((0 :. 0), (3 :. 3)) [f i j | i <- [0..3], j <- [i..3]]
\> a ! (2 :. 3)
"row: 2, col: 3"

Haskell - call the matrix module via import

I need to solve a linear equation with matrix multiplication.
I am using Hugs, so I tried the following:
import Matrix(multiplyMat)
// more code follows
When I call this in the console, the console is telling me:
Can not find imported module "Memo".
But it is in the directory of all modules, so why is there an error?
The file is called Matrix.hs:
-- Some simple Hugs programs for manipulating matrices.
--
module Matrix where
import List
type Matrix k = [Row k] -- matrix represented by a list of its rows
type Row k = [k] -- a row represented by a list of literals
-- General utility functions:
shapeMat :: Matrix k -> (Int, Int)
shapeMat mat = (rows mat, cols mat)
rows :: Matrix k -> Int
rows mat = length mat
cols :: Matrix k -> Int
cols mat = length (head mat)
idMat :: Int -> Matrix Int
idMat 0 = []
idMat (n+1) = [1:replicate n 0] ++ map (0:) (idMat n)
-- Matrix multiplication:
multiplyMat :: Matrix Int -> Matrix Int -> Matrix Int
multiplyMat a b | cols a==rows b = [[row `dot` col | col<-b'] | row<-a]
| otherwise = error "incompatible matrices"
where v `dot` w = sum (zipWith (*) v w)
b' = transpose b
-- An attempt to implement the standard algorithm for converting a matrix
-- to echelon form...
echelon :: Matrix Int -> Matrix Int
echelon rs
| null rs || null (head rs) = rs
| null rs2 = map (0:) (echelon (map tail rs))
| otherwise = piv : map (0:) (echelon rs')
where rs' = map (adjust piv) (rs1++rs3)
(rs1,rs2) = span leadZero rs
leadZero (n:_) = n==0
(piv:rs3) = rs2
-- To find the echelon form of a matrix represented by a list of rows rs:
--
-- {first line in definition of echelon}:
-- If either the number of rows or the number of columns in the matrix
-- is zero (i.e. if null rs || null (head rs)), then the matrix is
-- already in echelon form.
--
-- {definition of rs1, rs2, leadZero in where clause}:
-- Otherwise, split the matrix into two submatrices rs1 and rs2 such that
-- rs1 ++ rs2 == rs and all of the rows in rs1 begin with a zero.
--
-- {second line in definition of echelon}:
-- If rs2 is empty (i.e. if null rs2) then every row begins with a zero
-- and the echelon form of rs can be found by adding a zero on to the
-- front of each row in the echelon form of (map tail rs).
--
-- {Third line in definition of echelon, and definition of piv, rs3}:
-- Otherwise, the first row of rs2 (denoted piv) contains a non-zero
-- leading coefficient. After moving this row to the top of the matrix
-- the original matrix becomes piv:(rs1++rs3).
-- By subtracting suitable multiples of piv from (suitable multiples of)
-- each row in (rs1++rs3) {see definition of adjust below}, we obtain a
-- matrix of the form:
--
-- <----- piv ------>
-- __________________
-- 0 |
-- . |
-- . | rs' where rs' = map (adjust piv) (rs1++rs3)
-- . |
-- 0 |
--
-- whose echelon form is piv : map (0:) (echelon rs').
--
adjust :: Num a => Row a -> Row a -> Row a
adjust (m:ms) (n:ns) = zipWith (-) (map (n*) ms) (map (m*) ns)
-- A more specialised version of this, for matrices of integers, uses the
-- greatest common divisor function gcd in an attempt to try and avoid
-- result matrices with very large coefficients:
--
-- (I'm not sure this is really worth the trouble!)
adjust' :: Row Int -> Row Int -> Row Int
adjust' (m:ms) (n:ns) = if g==0 then ns
else zipWith (\x y -> b*y - a*x) ms ns
where g = gcd m n
a = n `div` g
b = m `div` g
-- end!!
Your Matrix file exports nothing.
To export, write the header like this:
module Module (function, value, Type(Constructor))

Translation of nested for loops into Haskell

I am struggling to translate this piece of a matrix multiplication in F# into Haskell (pls forget the parallel component):
Parallel.For(0, rowsA, (fun i->
for j = 0 to colsB - 1 do
for k = 0 to colsA - 1 do
result.[i,j] <- result.[i,j] + a.[i,k] * b.[k,j]))
|> ignore
All I managed to put together is
sum (map (\(i, j, k) -> (my.read (a,i,k)) * (my.read (b, k, j))) [ (i, j, k) | i <- [0..rowsA], j <- [0..colsB], k <- [0..colsA] ])
--my.read reads the values of the respective cells from 'my' database
The intention is to read the cells of matrix a and matrix b from my database and do a matrix multiplication that eventually can be carried out in portions by different agents. This is controlled by setting the boundaries for i , j and k but is not relevant here.
I have tried to translate the above F# sample into haskell. The issue I am struggling with is that the result is not the sum over everything but there should be a list of results at the position i, j(F# result.[i,j] - the cell is the result matrix). I do not see how I could emit the right result (i,j). Maybe I must further take this apart?
What exactly is the original code doing? Also, what is the type signature of my.read? I assume it would have a signature similar to Num b => (a, Int, Int) -> IO b, in which case this code will not even compile. If my . read is in the IO monad, then you could write it as:
myfunc = do
let indices = [(i, j, k) | i <- [0..rowsA],
j <- [0..colsB],
k <- [0..colsA]]
-- Since `my . read` returns a value in the IO monad,
-- we can't just multiply the values returned.
r1 <- mapM (\(i, j, k) -> (my . read) (a, i, k)) indices
r2 <- mapM (\(i, j, k) -> (my . read) (b, k, j)) indices
-- We can multiply r1 and r2 together though,
-- since they are values extracted from the IO monad
return $ sum $ zipWith (*) r1 r2
The best advice I can give you right now is to use ghci to figure out your types.
Try to divide
a :: [(a,a,a)]
a = [ (i, j, k) | i <- [0..rowsA], j <- [0..colsB], k <- [0..colsA] ]
into
b :: [[(a,a,a)]]
b = [ [ (i, j, k) | k <- [0..colsA]] | i <- [0..rowsA], j <- [0..colsB] ]
And you have a list of "lines" - matrix
And the list of sum is
m = [ [ (i, j, k) | k <- [0..colsA]] | i <- [0..rowsA], j <- [0..colsB] ]
listSum = map sum $ map (map (\(i,j,k) -> my_read (a,i,k) * my_read(b,k,j))) m

Resources