Data.Vectorが配列のように使えて便利と Twitter で聞きました。一時話題になった迷路の問題を Haskell で解いてみました。
instance を使ったのも始めて。
import Data.List import qualified Data.Vector as V -- 関数と引数を逆に記述する関数 --「F# をまねる」 -- http://d.hatena.ne.jp/kazu-yamamoto/20110218/1297992233 infixl 0 |> (|>) :: a -> (a -> b) -> b a |> f = f a mazeString :: [String] mazeString = [ "**************************" , "*S* * *" , "* * * * ************* *" , "* * * ************ *" , "* * *" , "************** ***********" , "* *" , "** ***********************" , "* * G *" , "* * *********** * *" , "* * ******* * *" , "* * *" , "**************************" ] data Pos = C Char | I Int instance Show Pos where show (C c) = " " ++ [c] show (I n) = (reverse.take 3.reverse) $ " " ++ show n instance Eq Pos where (==) (C x) (C y) = x == y (==) (I x) (I y) = x == y (==) (C _) (I _) = False (==) (I _) (C _) = False type VMaze = V.Vector (V.Vector Pos) data Maze = M { mazeMap :: VMaze, start :: (Int,Int), goal :: (Int,Int) } instance Show Maze where show (M mazeMap _ _) = concat $ intersperse "\n" $ map (concat.(map show).V.toList) $ V.toList mazeMap maze :: VMaze maze = V.fromList $ map ((V.fromList).(map (\x -> C x))) mazeString dataMaze = M { mazeMap = maze, start = searchChar (C 'S') maze xMaxPos yMaxPos, goal = searchChar (C 'G') maze xMaxPos yMaxPos } startTuple :: (Int,Int) startTuple = start dataMaze startX, startY :: Int startX = fst startTuple startY = snd startTuple goalTuple :: (Int,Int) goalTuple = goal dataMaze goalX, goalY :: Int goalX = fst goalTuple goalY = snd goalTuple -- 二次元Vector より取得 get2Dimension :: Int -> Int -> VMaze -> Pos get2Dimension x y maze = (maze V.! y) V.! x -- 二次元Vectorへ書き込み put2Dimension :: Int -> Int -> Pos -> VMaze -> VMaze put2Dimension x y p maze = maze V.// [(y , (maze V.! y) V.// [(x,p)])] xMaxPos, yMaxPos :: Int xMaxPos = (V.length (maze V.! 0)) - 1 yMaxPos = (V.length maze) - 1 searchChar :: Pos -> VMaze -> Int -> Int -> (Int, Int) searchChar p maze x y = if get2Dimension x y maze == p then (x,y) else if y == 0 then if x == 0 then (-1,-1) else searchChar p maze (x-1) 0 else if x == 0 then searchChar p maze xMaxPos (y-1) else searchChar p maze (x-1) y writeDistance :: Int -> Int -> Int -> Maze -> Maze writeDistance x y distance maze | isOutOfMaze x y = maze | isChar (C 'G') x y maze = maze | isChar (C '*') x y maze = maze | isChar (C 'S') x y maze || isChar (C ' ') x y maze = recursive4 putDistance | isNumber x y maze = if isShort then recursive4 putDistance else maze where -- 上下左右へ再帰 recursive4 m = m |> writeDistance (x+1) y (distance+1) |> writeDistance x (y+1) (distance+1) |> writeDistance (x-1) y (distance+1) |> writeDistance x (y-1) (distance+1) putDistance = maze{ mazeMap = put2Dimension x y (I distance) (mazeMap maze)} isShort = distance < oldPos where (I oldPos) = get2Dimension x y (mazeMap maze) -- Pos の Eq instance を定義してあるのでそのまま(==)を使用できる。 isChar :: Pos -> Int -> Int -> Maze -> Bool isChar p x y maze = get2Dimension x y (mazeMap maze) == p isNumber :: Int -> Int -> Maze -> Bool isNumber x y maze = case get2Dimension x y (mazeMap maze) of (C _) -> False (I _) -> True isOutOfMaze :: Int -> Int -> Bool isOutOfMaze x y = x < 0 || y < 0 || x > xMaxPos || y > yMaxPos -- 4 方向から最小の距離のセルを取得 data Direction = D { x, y :: Int , distance::Int } deriving Show instance Eq Direction where (==) (D _ _ x) (D _ _ y) = x == y instance Ord Direction where (<=) (D _ _ x) (D _ _ y) = x <= y (<) (D _ _ x) (D _ _ y) = x < y (>=) (D _ _ x) (D _ _ y) = x >= y (>) (D _ _ x) (D _ _ y) = x > y max (D a b x) (D c d y) | x <= y = (D c d y) | otherwise = (D a b x) min (D a b x) (D c d y) | x <= y = (D a b x) | otherwise = (D c d y) fourDirectionN :: Int -> Int -> Maze -> [Direction] fourDirectionN x y maze = [] |> nextcell x (y-1) |> nextcell x (y+1) |> nextcell (x-1) y |> nextcell (x+1) y where nextcell x y = ifGet2Dimension x y maze ifGet2Dimension :: Int -> Int -> Maze -> [Direction] -> [Direction] ifGet2Dimension x y maze ls = if isValidNum x y maze then D { x= x, y = y, distance = intNum} : ls else ls where (I intNum) = get2Dimension x y (mazeMap maze) isValidNum :: Int -> Int -> Maze -> Bool isValidNum x y maze = not (isOutOfMaze x y) && (isNumber x y maze) writeRoute :: Int -> Int -> Maze -> Maze writeRoute x y maze | startX == x && startY == y = maze | otherwise = writeRoute newx newy newMaze where newMaze = maze { mazeMap = put2Dimension newx newy (C '$') (mazeMap maze)} fourDirection = fourDirectionN x y maze -- Direction の Ord instance を定義してあるので -- そのまま minimum を使用できる。 (D newx newy _) = minimum fourDirection writeStart :: Maze -> Maze writeStart maze = maze { mazeMap = put2Dimension startX startY (C 'S') (mazeMap maze)} deleteNumber :: Maze -> Maze deleteNumber maze = maze { mazeMap = V.map (V.map numberToSpace) (mazeMap maze)} where numberToSpace :: Pos -> Pos numberToSpace (C c) = C c numberToSpace (I _) = C ' ' main :: IO () main = dataMaze |> writeDistance startX startY 0 |> writeRoute goalX goalY |> writeStart |> deleteNumber |> putStrLn.show {- -- スタートからの距離を書き込みます ghci> putStrLn.show $ writeDistance startX startY 0 dataMaze * * * * * * * * * * * * * * * * * * * * * * * * * * * S * 8 * 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 * * 1 * 7 * 9 10 * 14 15 * * * * * * * * * * * * * 29 30 * * 2 * 6 7 8 * 16 15 16 17 * * * * * * * * * * * * 30 31 * * 3 4 5 6 * 18 17 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 * * * * * * * * * * * * * * * 23 * * * * * * * * * * * * 37 36 35 34 33 32 31 30 29 28 27 26 25 24 25 26 27 28 29 30 31 32 33 34 * * * 37 * * * * * * * * * * * * * * * * * * * * * * * * 39 38 39 40 41 42 * 46 47 48 49 50 51 52 53 54 55 56 57 58 59 G 65 66 * * 40 39 * 41 42 43 44 45 46 * * * * * * * * * * * 60 * 64 65 * * 41 40 41 42 * 44 45 46 47 48 49 50 51 * * * * * * * 61 * 63 64 * * 42 41 42 43 44 45 46 * 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 * * * * * * * * * * * * * * * * * * * * * * * * * * * -- ゴールから4方向の数字セルを取得します。 ghci> fourDirectionN goalX goalY $ writeDistance startX startY 0 dataMaze [D {x = 23, y = 8, distance = 65},D {x = 21, y = 8, distance = 59}] -- 最小セル。 ghci> minimum $ fourDirectionN goalX goalY $ writeDistance startX startY 0 dataMaze D {x = 21, y = 8, distance = 59} -- ゴールから4方向の数字セルのうち最小セルをたどってマーク。 ghci> writeRoute goalX goalY $ writeDistance startX startY 0 dataMaze * * * * * * * * * * * * * * * * * * * * * * * * * * * $ * 8 * $ $ $ $ 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 * * $ * 7 * $ 10 * $ 15 * * * * * * * * * * * * * 29 30 * * $ * $ $ $ * 16 $ 16 17 * * * * * * * * * * * * 30 31 * * $ $ $ 6 * 18 17 $ $ $ $ $ $ $ 23 24 25 26 27 28 29 30 31 32 * * * * * * * * * * * * * * * $ * * * * * * * * * * * * 37 $ $ $ $ $ $ $ $ $ $ $ $ $ 25 26 27 28 29 30 31 32 33 34 * * * $ * * * * * * * * * * * * * * * * * * * * * * * * 39 $ $ $ 41 42 * $ $ $ $ $ $ $ $ $ $ $ $ $ $ G 65 66 * * 40 39 * $ $ $ $ $ 46 * * * * * * * * * * * 60 * 64 65 * * 41 40 41 42 * 44 45 46 47 48 49 50 51 * * * * * * * 61 * 63 64 * * 42 41 42 43 44 45 46 * 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 * * * * * * * * * * * * * * * * * * * * * * * * * * * -- スタートを0にしていたので 'S'に戻す。 ghci> writeStart $ writeRoute goalX goalY $ writeDistance startX startY 0 dataMaze * * * * * * * * * * * * * * * * * * * * * * * * * * * S * 8 * $ $ $ $ 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 * * $ * 7 * $ 10 * $ 15 * * * * * * * * * * * * * 29 30 * * $ * $ $ $ * 16 $ 16 17 * * * * * * * * * * * * 30 31 * * $ $ $ 6 * 18 17 $ $ $ $ $ $ $ 23 24 25 26 27 28 29 30 31 32 * * * * * * * * * * * * * * * $ * * * * * * * * * * * * 37 $ $ $ $ $ $ $ $ $ $ $ $ $ 25 26 27 28 29 30 31 32 33 34 * * * $ * * * * * * * * * * * * * * * * * * * * * * * * 39 $ $ $ 41 42 * $ $ $ $ $ $ $ $ $ $ $ $ $ $ G 65 66 * * 40 39 * $ $ $ $ $ 46 * * * * * * * * * * * 60 * 64 65 * * 41 40 41 42 * 44 45 46 47 48 49 50 51 * * * * * * * 61 * 63 64 * * 42 41 42 43 44 45 46 * 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 * * * * * * * * * * * * * * * * * * * * * * * * * * * -- 数字を消す。 ghci> deleteNumber $ writeStart $ writeRoute goalX goalY $ writeDistance startX startY 0 dataMaze * * * * * * * * * * * * * * * * * * * * * * * * * * * S * * $ $ $ $ * * $ * * $ * $ * * * * * * * * * * * * * * * $ * $ $ $ * $ * * * * * * * * * * * * * * $ $ $ * $ $ $ $ $ $ $ * * * * * * * * * * * * * * * $ * * * * * * * * * * * * $ $ $ $ $ $ $ $ $ $ $ $ $ * * * $ * * * * * * * * * * * * * * * * * * * * * * * * $ $ $ * $ $ $ $ $ $ $ $ $ $ $ $ $ $ G * * * $ $ $ $ $ * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * -}
