haskell中的二维数组处理

use*_*581 4 haskell file

对不起,我的问题对某些人来说似乎微不足道(我是新手).我有一个文件,其中包含一个如下所示的地图:

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

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

------------@
Run Code Online (Sandbox Code Playgroud)

在此文件中,字符表示您可以自由地朝这个方向移动.该#字符表明您不能移动任何进一步朝着这个方向,你应该去别的地方.该@字符表示宝藏的位置.在这种情况下,它位于右下角,但它可以位于地图中的任何位置.所以我必须通过这些线路,看看我能否达到@.在这里,我们从左上角开始.到目前为止,我已设法读取该文件的内容.我想知道如何在Haskell中处理这个问题.使用二维数组在Java中很容易,但我如何在Haskell中推荐这个问题呢?

例如,对于前面的示例,路径为:

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

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

--++++++++++@
Run Code Online (Sandbox Code Playgroud)

+符号代表的路径@符号.

这个算法我必须在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] == "@") {

  }
}
Run Code Online (Sandbox Code Playgroud)

谢谢

Mic*_*ael 6

在Haskell中有很多种方法可以制作2D数组,这里有一个很简单的例子,就是将字符读入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)
Run Code Online (Sandbox Code Playgroud)

并继续进行状态变化的荒谬原始"逻辑":

-- 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
Run Code Online (Sandbox Code Playgroud)

在这个幸福的情况下,它给出这样的输出

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

+++#--###----
-#+++#----##-
----++++++++@
-}
Run Code Online (Sandbox Code Playgroud)

逻辑必须更加复杂,有moveleftmoveup等等,但这应该是给出想法或想法.

编辑:这是一个不使用中间类型的版本,并且不会将任何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
Run Code Online (Sandbox Code Playgroud)