Haskellでこの問題を解いてみた

web巡回してたらこんなページを見つけたので、解いてみました。

import Data.Array
import Data.Maybe
import Data.List

data Cell = Space | Wall | Start | Goal | Road deriving (Show, Eq)

type Field = Array (Int,Int) Cell
type Route = [(Int,Int)]

charToCell :: Char -> Maybe Cell
charToCell ' ' = Just Space
charToCell '*' = Just Wall
charToCell 'S' = Just Start
charToCell 'G' = Just Goal
charToCell _ = Nothing

cellToChar :: Cell -> Char
cellToChar Space = ' '
cellToChar Wall = '*'
cellToChar Start = 'S'
cellToChar Goal = 'G'
cellToChar Road = '$'

parseField :: String -> Field
parseField cs =
    let numRow = length $ lines cs
        numCol = length $ head $ lines cs
        cells = mapMaybe charToCell cs
    in  array ((1,1),(numRow,numCol)) $ zip [(y,x) | y <- [1..numRow], x <- [1..numCol]] cells

unfoldLine :: Int -> String -> [String]
unfoldLine _ [] = []
unfoldLine x cs = case drop x cs of
                      [] -> [cs]
                      ds -> take x cs : unfoldLine x ds

showField :: Field -> IO ()
showField field = putStr $ unlines $ unfoldLine (snd $ snd $ bounds field) $ map cellToChar $ elems field

findStart :: Field -> (Int,Int)
findStart field = case find (\(i,e) -> e == Start) (assocs field) of
                      Just (i,e) -> i
                      otherwise  -> error "not found start position"

findNextRoute :: Field -> Route -> [Route]
findNextRoute field route =
   let head_pos = head route
       y = fst head_pos
       x = snd head_pos
       next_poss = [(y+1,x),(y-1,x),(y,x+1),(y,x-1)]
       not_wall_poss = filter (\x -> (field ! x) /= Wall) next_poss
       not_dupe_poss = filter (\x -> not (x `elem` route)) not_wall_poss
   in  map (:route) not_dupe_poss

dfs :: (a -> [a]) -> a -> [a]
dfs next node = dfs' node
    where
        dfs' n = n : concatMap dfs' (next n)

bfs :: (a -> [a]) -> a -> [a]
bfs next node = bfs' [node]
    where
        bfs' xs = xs ++ bfs' (concatMap next xs)

findAllRoute :: Field -> Route -> [Route]
findAllRoute field route = bfs (findNextRoute field) route

main :: IO ()
main = do
    cs <- readFile "sample.txt"
    let field = parseField cs
        routes = findAllRoute field [findStart field]
        cond x = (field ! (head x)) == Goal
        route = find cond routes
        answer = case route of
                     Just x -> field // (zip x (repeat Road))
                     otherwise -> field
    showField answer

間違ってDFSで書いてしまった名残がソースに残ってしまいました。

Haskellの強いところは、やはりdfsとbfs関数ですね。(ほぼ)無限リストを構築し、その先頭をfindで探せるので、このあたりのコードがスッキリしています。探索部分自体のコードは凄く短い。

この問題によるレベル判定に「Lv3:不完全な最短性のチェックまでできた」「Lv4:最短性のチェックができた」とありますが、幅優先探索で見つけたらLv4で良いのでしょうか（笑）

椿の日記

たぶんプログラムの話をします

Haskellでこの問題を解いてみた