Processing dimensional arrays in haskell

Question

Sorry for my question, which might seem trivial to some (I'm a beginner). I have a file that contains a map similar to this:

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

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

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

In this file, symbols –indicate that you can move in that direction. The symbol #indicates that you cannot move further in this direction, and you must go somewhere else. The symbol @indicates the location of the treasure. In this case, it is located in the lower right corner, but it can be anywhere on the map. So I have to go through these lines and see if I can achieve @. Here we start in the upper left corner. So far I have managed to read the contents of the file. And I am wondering how to handle this in Haskell. It will be easy in Java using a two-dimensional array, but how can I approximate this problem in Haskell?

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

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

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

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

The symbol +represents the path to the @ symbol.

This is the algorithm I have to implement 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

Answer 1

2D- Haskell, Data.Array, 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)

"" :

-- 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

,

{-
$ 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

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

, moveleft moveup .. .., .

: , IO . ghci, :

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

Answer 2

, 2D-.

, ( [[Char]]) .

, , IntList IntList Char ; , , .

, - . () , (O (1) ) .

, Monad.Control.State . Data.Array, ( , ).