プログラミングコンテスト チャレンジブック 第2版を買ってみた
プログラミングコンテストチャレンジブック [第2版] ?問題解決のアルゴリズム活用力とコーディングテクニックを鍛える?
- 作者: 秋葉拓哉,岩田陽一,北川宜稔
- 出版社/メーカー: マイナビ
- 発売日: 2012/01/28
- メディア: 単行本(ソフトカバー)
- 購入: 11人 クリック: 205回
- この商品を含むブログ (19件) を見る
気分転換にこちらの本に挑戦することにしました。この本は回答のサンプルがC++で書かれてますがHaskellで解く予定です。Haskellは言語自体は好きなのですが普段あまり使わないのでまずは慣れるために。
Haskellの実行速度
haskell vs その他の言語 - ながとの日記 という記事を見て、へぇーと思ってみてたのですが、元記事のコードの次の2つが何故これほどまでに違うのか、ちょっと気になったのでコンパイルだけして実際に確認してみます。(2つ目のはBangPatternの言語拡張のとこだけ削除)
import Control.Monad import qualified Data.HashTable as H main = do m <- H.new (==) H.hashInt forM_ [1..10000000] $ \n -> H.insert m n n v <- H.lookup m 100 print v
import qualified Data.HashTable as H import Data.Maybe eqInt :: Int -> Int -> Bool eqInt a b = a == b type HT = H.HashTable Int Int n = 1000000 loadHashtable :: HT -> IO () loadHashtable ht = work n where work :: Int -> IO () work i = do if i < 0 then return () else do H.insert ht i i work (i-1) main = do h <- H.new eqInt H.hashInt loadHashtable h i <- (H.lookup h 100) >>= (return . show . fromJust) putStrLn i
確かに後者のほうが圧倒的に速いです。恐らく違いは数字の列挙の方法にあり、前者は巨大なリストの走査で、後者はループカウンタの利用、ということなのでしょうか。
ただ現実問題として毎回後者のように書くのもアレなので、アクション部分を入れ替えられる高階関数を用意したほうが良さそうですね。
forIntM_ :: Int -> (Int -> IO ()) -> IO () forIntM_ n act = work n where work :: Int -> IO () work i = do if i < 0 then return () else do act i work (i-1) loadHashtable :: HT -> IO () loadHashtable ht = forIntM_ n (\i -> H.insert ht i i)
Haskellでこの問題を解いてみた②
同じ人が別の問題を作っておられたようなので、解いてみました。
import Data.Array import Data.List type Point = (Int,Int) type Field = Array Point Char type Route = [Point] isLegalPuyo :: Char -> Bool isLegalPuyo '\n' = False isLegalPuyo '\r' = False isLegalPuyo _ = True parseField :: String -> Field parseField cs = let numRow = length $ lines $ cs numCol = length $ head $ lines $ cs puyos = filter isLegalPuyo cs in array ((1,1),(numRow,numCol)) $ zip [(y,x) | y <- [1..numRow], x <- [1..numCol]] puyos unfoldLine :: Int -> String -> [String] unfoldLine x cs = case splitAt x cs of (xs,[]) -> [xs] (xs,ys) -> xs : unfoldLine x ys showField :: Field -> IO () showField field = do putStr $ unlines $ unfoldLine (snd $ snd $ bounds field) $ elems field dfs :: (a -> [a]) -> a -> [a] dfs next node = dfs' node where dfs' n = n : concatMap dfs' (next n) inBound :: Field -> Point -> Bool inBound field (y,x) = let ((y1,x1),(y2,x2)) = bounds field in y1 <= y && y <= y2 && x1 <= x && x <= x2 findNextRoutes :: Field -> Route -> [Route] findNextRoutes field route = let pos@(y,x) = head route neighbors = filter (inBound field) [(y+1,x),(y-1,x),(y,x+1),(y,x-1)] puyo = field ! pos same_puyo_poss = filter (\p -> (field ! p) == puyo) neighbors not_dupe_poss = filter (\p -> not $ p `elem` route) same_puyo_poss in map (:route) not_dupe_poss findChainedRoute :: Field -> Point -> Route findChainedRoute field pos = let routes = dfs (findNextRoutes field) [pos] in nub $ concat $ routes erasePuyo :: Field -> Maybe Field erasePuyo field = let puyo_poss = filter (\x -> (field ! x) /= ' ') (indices field) erase_routes = filter (\x -> length x >= 4) $ map (findChainedRoute field) puyo_poss erase_pos = nub $ concat $ erase_routes in case erase_pos of [] -> Nothing xs -> Just (field // zip xs (repeat ' ')) dropPuyoLine :: Int -> Field -> Field dropPuyoLine col field = let numRow = fst $ snd $ bounds field puyos = map (field !) [(p,col) | p <- [numRow,numRow-1 .. 1]] packedPuyos = filter (/= ' ') puyos in field // zip [(p,col) | p <- [numRow,numRow-1 .. 1]] (packedPuyos ++ repeat ' ') dropPuyo :: Field -> Field dropPuyo field = let numCol = snd $ snd $ bounds field in foldr dropPuyoLine field [1..numCol] enumerateFields :: Field -> [Field] enumerateFields field = case erasePuyo field of Just x -> let next_field = dropPuyo x in next_field : enumerateFields next_field Nothing -> [] showNumberedField :: (Int,Field) -> IO () showNumberedField (index,field) = do putStrLn $ show index putStrLn "" showField field putStrLn "------------------------------------" main :: IO () main = do cs <- readFile "source.txt" let field = parseField cs enumerated_fields = enumerateFields field mapM_ showNumberedField (zip [1..] enumerated_fields)
だいたい1時間くらいでした。前の問題もそうだったんですが、慣れたC言語ならば半分くらいの時間で作れた気がするのが関数型言語好きとしては非常に悔しいです。関数脳を鍛えるには…。処理効率もあんまり良くないですし。
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で良いのでしょうか(笑)