2 dimension array processing in haskell

Question

Sorry for my question which might seem trivial to some (I'm new). I have a file which contains a map looking like this :

---#--###----

-#---#----##-

------------@

In this file, – characters indicate that you are free to move in this direction. The # character indicates that you cannot move any further in this direction and you should go somewhere else. The @ character indicates the location of the treasure. In this case, it is in the bottom right corner, but it could be anywhere in the map. So I have to go through these lines and see if I can reach the @. Here we are starting at the top left corner. So far I have managed to read the content of the file. And I'm wondering how to process this in Haskell. It will be easy in Java using a 2-dimensional array but how can I appproach this problem in Haskell?

For example, for the previous example, the path is:

+++#--###----

-#+--#----##-

--++++++++++@

The + symbol represents the path to the @ symbol.

This the algorithm I have to implement it in Java:

Dfs(i,j) {
  if (arr[i][j+1] == "-" && i >=0 && i<=row.size && j>=0  && j<=column.size) {
      Dfs(i,j+1) 
  } else if(arr[i][j+1] == "@") {

  }

  if (arr[i][j-1] == "-" && i >=0 && i<=row.size && j>=0  && j<=column.size) {
        Dfs(i,j-1) 
  }   else if(arr[i][j-1] == "@") {

  }

  if (arr[i+1][j] == "-" && i >=0 && i<=row.size && j>=0  && j<=column.size) {
      Dfs(i+1,j) 
  } else if(arr[i+1][j] == "@") {

  }
}

Thank you

Answer 1

This very much depends on the way you want to use your 2D array.

If you only care about sequential use, a simple list of lists (basically [[Char]]) may be fine.

If you care about efficient getting to particular random coordinates, I can imagine that an IntList IntList Char could work for you; it's almost like list of lists, but individual cells can be much more efficiently updated, and it gives cheap random access for pathfinding.

Possibly a zipper-like structure would suit you best. I can't (so far) imagine a nice structure of this type that gives you both cheap (O(1) per neighbor cell) navigation for pathfinding and cheap updates.

Also, you could use a mutable map via Monad.Control.State e.g. by keeping a Data.Array in it, but you will have to lift all your logic into this monad (which would complicate passing copies of the map around, when you need it).

Answer 2

There are many ways of making 2D arrays in Haskell, here is a somewhat laborious example of reading the chars into a Data.Array array, and then moving things about with the so-called state monad:

import Data.Array
import Control.Monad.State.Strict

main = do str <- getContents -- accepts string from stdin
          let array = mkThingArray str -- we parse the string
              limits = snd (bounds array) -- we remember (height,width)
              initialState = ((0::Int,-1::Int),limits,array)
          ((position,(h,w),a)) <- execStateT findpath initialState
          let chars = elems $ fmap toChar a
          putStrLn ""
          putStrLn $ splitText (w+1) chars

parseArray str = listArray ((0,0),(height-1, width-1)) total where 
    rawlines = lines str
    ls       = filter (not . null) rawlines
    lens     = map length ls
    height   = length ls 
    width    = minimum lens 
    proper   = map (take width) ls
    total    = concat proper              

data Thing = Open | Closed | Home | Taken deriving (Show, Eq, Ord)
toThing c = case c of '-' -> Open; '#' -> Closed; '@' -> Home;
                      '+' -> Taken; _ -> error "No such Thing"
toChar c = case c of Open -> '-'; Closed -> '#'; 
                     Home -> '@'; Taken -> '+'

mkThingArray str = fmap toThing (parseArray str)

And continuing with an absurdly primitive 'logic' of state change:

-- we begin with moveright, which may then pass on to movedown 
-- and so on perhaps in a more sophisticated case
findpath = moveright 
  where
  moveright = do ((n,m), (bound1,bound2), arr) <- get
                 if m < bound2 
                 then case arr ! (n,m+1) of
                   Open   -> do liftIO (putStrLn "moved right")
                                put ((n,m+1), (bound1,bound2), arr // [((n,m+1),Taken)])
                                moveright
                   Closed -> movedown
                   Home   -> return ()
                   Taken  -> movedown
                 else movedown

  movedown = do ((n,m), (bound1,bound2), arr) <- get
                if n < bound1 
                then case arr ! (n+1,m) of
                   Open   -> do liftIO (putStrLn "moved down")
                                put ((n+1,m), (bound1,bound2), arr // [((n+1,m),Taken)])
                                moveright
                   Closed -> moveright
                   Home   -> return ()
                   Taken  -> moveright
                else moveright    

splitText n str = unlines $ split n [] str 
   where split n xss []  = xss
         split n xss str = let (a,b) = splitAt n str
                           in if not (null a) 
                                then split n (xss ++ [a]) b
                                else xss

which, in this happy case, gives output like this

{-
$ pbpaste | ./arrayparse 
moved right
moved right
moved right
moved down
moved right
moved right
moved down
moved right
moved right
moved right
moved right
moved right
moved right
moved right

+++#--###----
-#+++#----##-
----++++++++@
-}

The logic will have to be more sophisticated, with moveleft and moveup, etc., etc. but this is supposed to give the idea, or an idea.

Edit: Here is a version that doesn't use an intermediate type and doesn't throw any IO into the state machine. It should be more usable in ghci, so you can tear it apart more easily:

import Data.Array
import Control.Monad.Trans.State.Strict

main = do str <- readFile "input.txt"
          ((pos,(h,w),endarray)) <- execStateT findpath 
                                               (mkInitialState str)
          putStrLn $ prettyArray endarray

-- the following are just synonyms, nothing is happening:
type Pos = (Int, Int)      -- Our positions are in 2 dimensions
type Arr = Array Pos Char  -- Characters occupy these positions
type ArrState = (Pos, Pos, Arr) -- We will be tracking not just 
                                --  an array of Chars but a 
                                --  current position and the total size
parseArray :: String -> Arr
parseArray str = listArray ((1,1),(height, width)) (concat cropped) where 
    ls       = filter (not . null) (lines str)
    width    = minimum (map length ls)     
    height   = length ls            
    cropped  = map (take width) ls -- the map is cropped to shortest line

prettyArray :: Arr -> String
prettyArray arr = split [] (elems arr)
  where (ab,(h,w)) = bounds arr 
        split xss []  = unlines xss 
        split xss str = let (a,b) = splitAt w str
                        in if null a then unlines xss else split (xss ++ [a]) b

mkInitialState :: String -> ArrState
mkInitialState str = ((1::Int,0::Int), limits, array)
 where array = parseArray str      -- we parse the string
       limits = snd (bounds array) -- we remember (height,width)
        -- since we don't resize, tracking this could be avoided

makeStep :: Arr -> Pos -> Arr   
makeStep arr (n, m) = arr // [((n,m),'+')]  -- this is crude

moveRight, moveDown, findpath :: Monad m => StateT ArrState m ()
moveRight = do ((n,m),bounds,arr) <- get
               put ((n,m+1), bounds, makeStep arr (n,m+1))
moveDown = do ((n,m),bounds,arr) <- get
              put ((n+1,m), bounds, makeStep arr (n+1,m))
findpath = tryRight  
  where -- good luck for most paths ...
  tryRight  = do ((n,m), (_,bound2), arr) <- get
                 if m < bound2 
                 then case arr ! (n,m+1) of
                   '@' -> return ()
                   '-' -> do moveRight
                             tryRight 
                   _   -> tryDown 
                 else tryDown 

  tryDown  = do ((n,m), (bound1,_), arr) <- get
                if n < bound1 
                then case arr ! (n+1,m) of
                   '@'   -> return ()
                   '-'   -> do moveDown
                               tryRight 
                   _  -> tryRight 
                else tryRight     

runInput :: String -> String
runInput str = prettyArray endarray
 where ((position,(h,w),endarray)) = execState findpath (mkInitialState str)
 -- If I wanted to include IO things in the state machine,
 -- I would have to use execStateT not execState, which presupposes purity
test :: String -> IO ()
test str = putStrLn (runInput str)

t1 = unlines ["---#--###----" 
             , ""
             , "-#---#----##-"
             , ""
             , "------------@"
             ] :: String
--
t2 = unlines ["---#--###----"
             ,""
             ,"---#-#----##-"
             ,""
             ,"------------@"
             ] :: String