迷路解析

人材獲得作戦・4 試験問題ほかの試験問題をやってみた。

かかった時間は1時間強だと思う。

module Main where
-- import Data.Map
import Data.Array
import Data.Maybe
import System

main = do
  args <- getArgs
  if length args /= 1
    then error "Meiro inputfile"
    else return ()
  meiro <- lines `fmap` readFile (args!!0)
  let meiro' = mapping meiro
      path = paths meiro' [] [[search 'S' meiro]]
      out = output meiro' path
  putStr out

output :: Array (Int, Int) Char -> [(Int,Int)] -> String
output array path = str
  where
    list = assocs array
    list2 = map conv list
    conv (x,c) = if elem x path && c == ' '
                    then (x, '$')
                    else (x,c)
    str = toLines' 0 list2
    toLines' _ [] = '\n' : []
    toLines' n (((x,y),c):t) = if x == n then c : toLines' n t
                                         else '\n' : c : toLines' (n+1) t

mapping l@(h:t) = array ((0,0),(length l - 1, length h - 1)) $ f l 0
    where
      f :: [String] -> Int -> [((Int, Int), Char)]
      f (h:t) n = g h n 0 ++ f t (n+1)
      f [] _ = []

      g :: String -> Int -> Int -> [((Int, Int), Char)]
      g (h:t) n m = ((n, m), h) : g t n (m+1)
      g [] _ _  = []

paths :: Array (Int, Int) Char -> [(Int, Int)] -> [[(Int, Int)]] -> [(Int, Int)]
paths meiro checked (h@(hh:ht):t)
  | hh `elem` checked = paths meiro checked t -- ここ後述
  | meiro!hh == 'G' = h
  | meiro!hh == '*' = paths meiro (hh:checked) t
  | meiro!hh == ' ' = paths meiro (hh:checked) $ t ++ paths' h
  | meiro!hh == 'S' = paths meiro (hh:checked) $ t ++ paths' h

paths' :: [(Int, Int)] -> [[(Int, Int)]]
paths' l@((n, m):_) =
  [(n + 1, m) : l, (n - 1, m) : l, (n, m + 1) : l, (n, m - 1) : l]


search :: Char -> [String] -> (Int, Int)
search c meiro = search' meiro 0
 where
  search' :: [String] -> Int -> (Int, Int)
  search' (h:t) n = case search'' h n 0 of
                     Just p -> p
                     _ -> search' t $ n+1
  search' [] _  = error ""

  search'' :: String -> Int -> Int -> Maybe (Int, Int)
  search'' (h:t) n m = if h ==c then Just (n,m)
                                else search'' t n $ m + 1
  search'' [] _ _ = Nothing

急いで書いたので、変数名・関数名はかなり適当。速度的には、それなりに早いものになっていると思う。

苦戦した点:

  • 幅優先探索をするのに、「すでに通過したマスは再び捜索しなくてよい→そこに到達したパスはキューから取り除く」という処理が必要なことに気づかずに、内部でピンポン現象がおきて計算が爆発し、「List型では遅すぎるのだろうか。Data.ArrayとかData.Mapとか使ったことないけどやってみようか」とかしているのに時間をくった。「hh `elem` checked = paths meiro checked t」と書いてある処理を入れて解決。
  • 趣味でコーディングするときには、コマンド引数処理とかあまりしないから、やり方を忘れていた。

検討している改良点:

  1. メイン部分ではArrayで処理しているのに、同じデータからスタート地点を割り出すのは、Listのまま処理している。ちょっと気持ち悪い。
  2. 関数名・変数名がかなり適当。
  3. アルゴリズム的な改良点は僕には思いつかない。この問題を解く、幅優先探索より早いアルゴリズムはないのでは???*1

これら合わせて、専用データ型を作るのが美しい方向性か? Real World Haskell にあった正格型で速度向上!戦略がうまく当てはまりそう。

*1:Webで調べたら、A*というアルゴリズムが最適とされている? でも、メモリ確保を度外視すれば、この(あるセルから隣のセルへの)各経路の重さが同じという問題で、ここでやっている幅優先アルゴリズムより早くなるなんてことが起こるのか疑問。