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.
Related
i'm trying to write a function that for n gives matrix n*n with unique rows and columns (latin square).
I got function that gives my list of strings "1" .. "2" .. "n"
numSymbol:: Int -> [String]
I tried to generate all permutations of this, and them all n-length tuples of permutations, and them check if it is unique in row / columns. But complexity (n!)^2 works perfect for 2 and 3, but with n > 3 it takes forever. It is possible to build latin square from permutations directly, for example from
permutation ( numSymbol 3) = [["1","2","3"],["1","3","2"],["2","1","3"],["2","3","1"],["3","1","2"],["3","2","1"]]
get
[[["1","2","3",],["2","1","3"],["3","1","2"]] , ....]
without generating list like [["1",...],["1",...],...], when we know first element disqualify it ?
Note: since we can easily take a Latin square that's been filled with numbers from 1 to n and re-label it with anything we want, we can write code that uses integer symbols without giving anything away, so let's stick with that.
Anyway, the stateful backtracking/nondeterministic monad:
type StateList s = StateT s []
is helpful for this sort of problem.
Here's the idea. We know that every symbol s is going to appear exactly once in each row r, so we can represent this with an urn of all possible ordered pairs (r,s):
my_rs_urn = [(r,s) | r <- [1..n], s <- [1..n]]
Similarly, as every symbol s appears exactly once in each column c, we can use a second urn:
my_cs_urn = [(c,s) | c <- [1..n], s <- [1..n]]
Creating a Latin square is matter of filling in each position (r,c) with a symbol s by removing matching balls (r,s) and (c,s) (i.e., removing two balls, one from each urn) so that every ball is used exactly once. Our state will be the content of the urns.
We need backtracking because we might reach a point where for a particular position (r,c), there is no s such that (r,s) and (c,s) are both still available in their respective urns. Also, a pleasant side-effect of list-based backtracking/nondeterminism is that it'll generate all possible Latin squares, not just the first one it finds.
Given this, our state will look like:
type Urn = [(Int,Int)]
data S = S
{ size :: Int
, rs :: Urn
, cs :: Urn }
I've included the size in the state for convenience. It won't ever be modified, so it actually ought to be in a Reader instead, but this is simpler.
We'll represent a square by a list of cell contents in row-major order (i.e., the symbols in positions [(1,1),(1,2),...,(1,n),(2,1),...,(n,n)]):
data Square = Square
Int -- square size
[Int] -- symbols in row-major order
deriving (Show)
Now, the monadic action to generate latin squares will look like this:
type M = StateT S []
latin :: M Square
latin = do
n <- gets size
-- for each position (r,c), get a valid symbol `s`
cells <- forM (pairs n) (\(r,c) -> getS r c)
return $ Square n cells
pairs :: Int -> [(Int,Int)]
pairs n = -- same as [(x,y) | x <- [1..n], y <- [1..n]]
(,) <$> [1..n] <*> [1..n]
The worker function getS picks an s so that (r,s) and (c,s) are available in the respective urns, removing those pairs from the urns as a side effect. Note that getS is written non-deterministically, so it'll try every possible way of picking an s and associated balls from the urns:
getS :: Int -> Int -> M Int
getS r c = do
-- try each possible `s` in the row
s <- pickSFromRow r
-- can we put `s` in this column?
pickCS c s
-- if so, `s` is good
return s
Most of the work is done by the helpers pickSFromRow and pickCS. The first, pickSFromRow picks an s from the given row:
pickSFromRow :: Int -> M Int
pickSFromRow r = do
balls <- gets rs
-- "lift" here non-determinstically picks balls
((r',s), rest) <- lift $ choices balls
-- only consider balls in matching row
guard $ r == r'
-- remove the ball
modify (\st -> st { rs = rest })
-- return the candidate "s"
return s
It uses a choices helper which generates every possible way of pulling one element out of a list:
choices :: [a] -> [(a,[a])]
choices = init . (zipWith f <$> inits <*> tails)
where f a (x:b) = (x, a++b)
f _ _ = error "choices: internal error"
The second, pickCS checks if (c,s) is available in the cs urn, and removes it if it is:
pickCS :: Int -> Int -> M ()
pickCS c s = do
balls <- gets cs
-- only continue if the required ball is available
guard $ (c,s) `elem` balls
-- remove the ball
modify (\st -> st { cs = delete (c,s) balls })
With an appropriate driver for our monad:
runM :: Int -> M a -> [a]
runM n act = evalStateT act (S n p p)
where p = pairs n
this can generate all 12 Latin square of size 3:
λ> runM 3 latin
[Square 3 [1,2,3,2,3,1,3,1,2],Square 3 [1,2,3,3,1,2,2,3,1],...]
or the 576 Latin squares of size 4:
λ> length $ runM 4 latin
576
Compiled with -O2, it's fast enough to enumerate all 161280 squares of size 5 in a couple seconds:
main :: IO ()
main = print $ length $ runM 5 latin
The list-based urn representation above isn't very efficient. On the other hand, because the lengths of the lists are pretty small, there's not that much to be gained by finding more efficient representations.
Nonetheless, here's complete code that uses efficient Map/Set representations tailored to the way the rs and cs urns are used. Compiled with -O2, it runs in constant space. For n=6, it can process about 100000 Latin squares per second, but that still means it'll need to run for a few hours to enumerate all 800 million of them.
{-# OPTIONS_GHC -Wall #-}
module LatinAll where
import Control.Monad.State
import Data.List
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Map (Map, (!))
import qualified Data.Map as Map
data S = S
{ size :: Int
, rs :: Map Int [Int]
, cs :: Set (Int, Int) }
data Square = Square
Int -- square size
[Int] -- symbols in row-major order
deriving (Show)
type M = StateT S []
-- Get Latin squares
latin :: M Square
latin = do
n <- gets size
cells <- forM (pairs n) (\(r,c) -> getS r c)
return $ Square n cells
-- All locations in row-major order [(1,1),(1,2)..(n,n)]
pairs :: Int -> [(Int,Int)]
pairs n = (,) <$> [1..n] <*> [1..n]
-- Get a valid `s` for position `(r,c)`.
getS :: Int -> Int -> M Int
getS r c = do
s <- pickSFromRow r
pickCS c s
return s
-- Get an available `s` in row `r` from the `rs` urn.
pickSFromRow :: Int -> M Int
pickSFromRow r = do
urn <- gets rs
(s, rest) <- lift $ choices (urn ! r)
modify (\st -> st { rs = Map.insert r rest urn })
return s
-- Remove `(c,s)` from the `cs` urn.
pickCS :: Int -> Int -> M ()
pickCS c s = do
balls <- gets cs
guard $ (c,s) `Set.member` balls
modify (\st -> st { cs = Set.delete (c,s) balls })
-- Return all ways of removing one element from list.
choices :: [a] -> [(a,[a])]
choices = init . (zipWith f <$> inits <*> tails)
where f a (x:b) = (x, a++b)
f _ _ = error "choices: internal error"
-- Run an action in the M monad.
runM :: Int -> M a -> [a]
runM n act = evalStateT act (S n rs0 cs0)
where rs0 = Map.fromAscList $ zip [1..n] (repeat [1..n])
cs0 = Set.fromAscList $ pairs n
main :: IO ()
main = do
print $ runM 3 latin
print $ length (runM 4 latin)
print $ length (runM 5 latin)
Somewhat remarkably, modifying the program to produce only reduced Latin squares (i.e., with symbols [1..n] in order in both the first row and the first column) requires changing only two functions:
-- All locations in row-major order, skipping first row and column
-- i.e., [(2,2),(2,3)..(n,n)]
pairs :: Int -> [(Int,Int)]
pairs n = (,) <$> [2..n] <*> [2..n]
-- Run an action in the M monad.
runM :: Int -> M a -> [a]
runM n act = evalStateT act (S n rs0 cs0)
where -- skip balls [(1,1)..(n,n)] for first row
rs0 = Map.fromAscList $ map (\r -> (r, skip r)) [2..n]
-- skip balls [(1,1)..(n,n)] for first column
cs0 = Set.fromAscList $ [(c,s) | c <- [2..n], s <- skip c]
skip i = [1..(i-1)]++[(i+1)..n]
With these modifications, the resulting Square will include symbols in row-major order but skipping the first row and column. For example:
λ> runM 3 latin
[Square 3 [3,1,1,2]]
means:
1 2 3 fill in question marks 1 2 3
2 ? ? =====================> 2 3 1
3 ? ? in row-major order 3 1 2
This is fast enough to enumerate all 16,942,080 reduced Latin squares of size 7 in a few minutes:
$ stack ghc -- -O2 -main-is LatinReduced LatinReduced.hs && time ./LatinReduced
[1 of 1] Compiling LatinReduced ( LatinReduced.hs, LatinReduced.o )
Linking LatinReduced ...
16942080
real 3m9.342s
user 3m8.494s
sys 0m0.848s
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
I'm stuck with my homework task, somebody help, please..
Here is the task:
Find all possible partitions of string into words of some dictionary
And here is how I'm trying to do it:
I use dynamical programming concept to fill matrix and then I'm stuck with how to retrieve data from it
-- Task5_2
retrieve :: [[Int]] -> [String] -> Int -> Int -> Int -> [[String]]
retrieve matrix dict i j size
| i >= size || j >= size = []
| index /= 0 = [(dict !! index)]:(retrieve matrix dict (i + sizeOfWord) (i + sizeOfWord) size) ++ retrieve matrix dict i (next matrix i j) size
where index = (matrix !! i !! j) - 1; sizeOfWord = length (dict !! index)
next matrix i j
| j >= (length matrix) = j
| matrix !! i !! j > 0 = j
| otherwise = next matrix i (j + 1)
getPartitionMatrix :: String -> [String] -> [[Int]]
getPartitionMatrix text dict = [[ indiceOfWord (getWord text i j) dict 1 | j <- [1..(length text)]] | i <- [1..(length text)]]
--------------------------
getWord :: String -> Int -> Int -> String
getWord text from to = map fst $ filter (\a -> (snd a) >= from && (snd a) <= to) $ zip text [1..]
indiceOfWord :: String -> [String] -> Int -> Int
indiceOfWord _ [] _ = 0
indiceOfWord word (x:xs) n
| word == x = n
| otherwise = indiceOfWord word xs (n + 1)
-- TESTS
dictionary = ["la", "a", "laa", "l"]
string = "laa"
matr = getPartitionMatrix string dictionary
test = retrieve matr dictionary 0 0 (length string)
Here is a code that do what you ask for. It doesn't work exactly like your solution but should work as fast if (and only if) both our dictionary lookup were improved to use tries as would be reasonable. As it is I think it may be a bit faster than your solution :
module Partitions (partitions) where
import Data.Array
import Data.List
data Branches a = Empty | B [([a],Branches a)] deriving (Show)
isEmpty Empty = True
isEmpty _ = False
flatten :: Branches a -> [ [ [a] ] ]
flatten Empty = []
flatten (B []) = [[]]
flatten (B ps) = concatMap (\(word, bs) -> ...) ps
type Dictionary a = [[a]]
partitions :: (Ord a) => Dictionary a -> [a] -> [ [ [a] ] ]
partitions dict xs = flatten (parts ! 0)
where
parts = listArray (0,length xs) $ zipWith (\i ys -> starting i ys) [0..] (tails xs)
starting _ [] = B []
starting i ys
| null words = ...
| otherwise = ...
where
words = filter (`isPrefixOf` ys) $ dict
go word = (word, parts ! (i + length word))
It works like this : At each position of the string, it search all possible words starting from there in the dictionary and evaluates to a Branches, that is either a dead-end (Empty) or a list of pairs of a word and all possible continuations after it, discarding those words that can't be continued.
Dynamic programming enter the picture to record every possibilities starting from a given index in a lazy array. Note that the knot is tied : we compute parts by using starting, which uses parts to lookup which continuations are possible from a given index. This only works because we only lookup indices after the one starting is computing and starting don't use parts for the last index.
To retrieve the list of partitions from this Branches datatype is analogous to the listing of all path in a tree.
EDIT : I removed some crucial parts of the solution in order to let the questioner search for himself. Though that shouldn't be too hard to complete with some thinking. I'll probably put them back with a somewhat cleaned up version later.
I have a Map (Int, Int) a where a can be any type. Based on the Tuple2 stored in the array as key I wanna create a String table which stores the values of the map.
Because the maximal values of the Tuple2 are known and can be large, my first thought was to create a mutable 2D-Array with a default value. While iterating over the entries of the Map, this array could be filled and then printed out. A pseudo-code example with a Map of Ints:
map = Map (Int, Int) Int
table = Array.ofDim (maxY, maxX) withDefaultValue 0
for ((x,y), int) <- map do
table[y][x] = int
end
rows = table.rows map toString
str = rows map (toString ++ lineEnd)
print str
The only problem is: I don't know how to do this in Haskell. Furthermore I don't know if this is the preferred way one goes in Haskell.
I didn't find good examples how to use 2D-Arrays in Haskell, thus can someone give me one? If there is a better way to do this, maybe with a built-in data type such as Table, Matrix, 2DStringBuilder etc., can someone show me an example how to use them?
table = Array.ofDim (maxY, maxX) withDefaultValue 0
That can be done with
table :: Array (Int,Int) Int
table = array ((0,0),(maxX,maxY))
[((i,j),Map.findWithDefault 0 (i,j) map) | i <- [0 .. maxX], j <- [0 .. maxY]]
Then for tabular output of any two-dimensional array,
rows :: Array (Int,Int) a -> [[a]]
rows arr = [[arr ! (r,c) | c <- [clow .. chigh]] | r <- [rlow .. rhigh]]
where
((rlow,clow),(rhigh,chigh)) = bounds arr
rowStrings :: Show a => Array (Int,Int) a -> [String]
rowStrings arr = [unwords (map show row) | row <- rows arr]
tableString :: Show a => Array (Int,Int) a -> String
tableString arr = unlines (rowStrings arr)
prettyPrint :: Show a => Array (Int,Int) a -> IO ()
prettyPrint arr = putStr (tableString arr)
You can also define some the functions point-free,
prettyPrint = putStr . tableString
tableString = unlines . rowStrings
rowStrings = map (unwords . map show) . rows
rows and table are not comfortably defined point-free, though, so I stop here.
I am trying to build a smallish haskell app that will translate a few key phrases from english to french.
First, i have a list of ordered pairs of strings that represent and english word/phrase followed by the french translations:
icards = [("the", "le"),("savage", "violent"),("work", "travail"),
("wild", "sauvage"),("chance", "occasion"),("than a", "qu'un")...]
next i have a new data:
data Entry = Entry {wrd, def :: String, len :: Int, phr :: Bool}
deriving Show
then i use the icards to populate a list of Entrys:
entries :: [Entry]
entries = map (\(x, y) -> Entry x y (length x) (' ' `elem` x)) icards
for simplicity, i create a new type that will be [Entry] called Run.
Now, i want to create a hash table based on the number of characters in the english word. This will be used later to speed up searchings. So i want to create a function called runs:
runs :: [Run]
runs = --This will run through the entries and return a new [Entry] that has all of the
words of the same length grouped together.
I also have:
maxl = maximum [len e | e <- entries]
It just so happens that Hackage has a hashmap package! I'm going to create a small data type based on that HashMap, which I will call a MultiMap. This is a typical trick: it's just a hash map of linked lists. I'm not sure what the correct name for MultiMap actually is.
import qualified Data.HashMap as HM
import Data.Hashable
import Prelude hiding (lookup)
type MultiMap k v = HM.Map k [v]
insert :: (Hashable k, Ord k) => k -> a -> MultiMap k a -> MultiMap k a
insert k v = HM.insertWith (++) k [v]
lookup :: (Hashable k, Ord k) => k -> MultiMap k a -> [a]
lookup k m = case HM.lookup k m of
Nothing -> []
Just xs -> xs
empty :: MultiMap k a
empty = HM.empty
fromList :: (Hashable k, Ord k) => [(k,v)] -> MultiMap k v
fromList = foldr (uncurry insert) empty
I mimicked only the essentials of a Map: insert, lookup, empty, and fromList. Now it is quite easy to turn entries into a MutliMap:
data Entry = Entry {wrd, def :: String, len :: Int, phr :: Bool}
deriving (Show)
icards = [("the", "le"),("savage", "violent"),("work", "travail"),
("wild", "sauvage"),("chance", "occasion"),("than a", "qu'un")]
entries :: [Entry]
entries = map (\(x, y) -> Entry x y (length x) (' ' `elem` x)) icards
fromEntryList :: [Entry] -> MutiMap Int Entry
fromEntryList es = fromList $ map (\e -> (len e, e)) es
Loading that up into ghci, we can now lookup a list of entries with a given length:
ghci> let m = fromEntryList entries
ghci> lookup 3 m
[Entry {wrd = "the", def = "le", len = 3, phr = False}]
ghci> lookup 4 m
[Entry {wrd = "work", def = "travail", len = 4, phr = False},
Entry {wrd = "wild", def = "sauvage", len = 4, phr = False}]
(Note that this lookup is not the one defined in Prelude.) You could similarly use the English word as a key.
-- import Data.List (find) -- up with other imports
fromEntryList' :: [Entry] -> MultiMap String Entry
fromEntryList' es = fromList $ map (\e -> (wrd e, e)) es
eLookup :: String -> MultiMap String Entry -> Maybe Entry
eLookup str m = case lookup str m of
[] -> Nothing
xs -> find (\e -> wrd e == str) xs
Testing...
ghci> let m = fromEntryList' entries
ghci> eLookup "the" m
Just (Entry {wrd = "the", def = "le", len = 3, phr = False})
ghci> eLookup "foo" m
Nothing
Notice how in eLookup we first perform the Map lookup in order to determine if anything has been placed in that slot. Since we are using a hash set, we need to remember that two different Strings might have the same hash code. So in the event that the slot is not empty, we perform a find on the linked list there to see if any of the entries there actually match the correct English word. If you are interested in performance, you should consider using Data.Text instead of String.
groupBy and sortBy are both in Data.List.
import Data.List
import Data.Function -- for `on`
runs :: [Run]
runs = f 0 $ groupBy ((==) `on` len) $ sortBy (compare `on` len) entries
where f _ [] = []
f i (r # (Entry {len = l} : _) : rs) | i == l = r : f (i + 1) rs
f i rs = [] : f (i + 1) rs
Personally, I would use a Map instead
import qualified Data.Map as M
runs :: M.Map String Entry
runs = M.fromList $ map (\entry -> (wrd entry, entry)) entries
and lookup directly by English word instead of a two step length-of-English-word and then English-word process.