Qualification Round 感想

総じて，ダメダメな出来だったが，反省会の意味も込め感想を書いておく．

Qualification なだけあって，どの問題も簡単だったが，アルゴリズムをコードにするのに時間がかかった．

あと入出力もメンドウ．

A – Alien Language

すべての問題についてあてはまるが，まず，問題を理解することに時間がかかる．

しかし，アルゴリズムは単純．

辞書にある文字が含まれるか，全部調べるだけ．

主要部分はこんな感じ．

main = do (l:d:n:_) <- getInts
ws <- replicateM d getLine
cs <- replicateM n getCase
mapM_ putStrLn.zipWith output [1..] .map (match ws) $ cs
match :: [String] -> [String] -> Int
match ws [] = length ws
match ws (c:cs) = match ws' cs
where ws' = map tail.filter ((`elem` c).head) $ ws

smallの問題のインスタンスのファイルの名前がダウンロードごとに違うことに気がつかず，

submitしてもincorrectなので，焦った．

全体はこんな感じ．入出力関係が多い．どうにかすっきりできないか．

（分離して書く限りはこの程度なのだろうか？）

import Control.Monad (liftM, replicateM)
-- main part
main = do (l:d:n:_) <- getInts
ws <- replicateM d getLine
cs <- replicateM n getCase
mapM_ putStrLn.zipWith output [1..] .map (match ws) $ cs
match :: [String] -> [String] -> Int
match ws [] = length ws
match ws (c:cs) = match ws' cs
where ws' = map tail.filter ((`elem` c).head) $ ws
-- output and input function
parse :: String -> [String]
parse [] = []
parse (')':s) = parse s
parse ('(':s) = a : parse s'
where (a, s') = span (/=')') s
parse (c:s) =  : parse s
getCase :: IO [String]
getCase = liftM parse $ getLine
output :: Show a => Int -> a -> String
output x y = concat $ "Case #" : show x : ": " : [show y]
getList :: Read a => IO [a]
getList = liftM (map read.words) getLine
getInts :: IO [Int]
getInts = getList
getInt :: IO Int
getInt = liftM head getInts

spanとか存在を忘れてた．

追記 #3

正規表現を使う方法もあったらしい．どうやら (, ) をそれぞれ [, ] に変えると正規表現で

幸せになれるらしい．

しかし，僕は正規表現なんてほとんど知らないので，なんのことやら．

だけど，とりあえず，簡単に解けるらしい．

B Watersheds

問題文に知らない単語がでてきたので，調べてた．ちょっとだけ，賢くなった気がした．

水の流れをシュミレートすれば良いだけだが，ラベリングに関してルールがあるので，状態を使えると便利と思った．

c++かjavaでやろうかと思ったが，もう忘却の彼方なので，しかたなくhaskellで．

（しかし，結局，STUArrayの使いかたも忘却の彼方だったというオチ）

標高のデータをArrayで持って，それをもとに処理．

main = do cs <- (`replicateM` getCase) =<< getInt
mapM_ putStrLn.zipWith output [1..] $ map basin cs
next :: Array Point Int -> Point -> Point
next a p@(y,x) = minimumBy (comparing (a !)).filter (inRange $ bounds a) $ [(y-1,x),(y,x-1),(y,x+1),(y+1,x),(y,x)]
isSink :: Array Point Int -> Point -> Bool
isSink a p = a ! p <= a ! next a p
basin :: Array (Int, Int) Int -> [[Char]]
basin a = take h.map (take w).iterate (drop w).runST
$ do b <- newArray ((1,1),(h,w)) ' ' :: ST s (STUArray s Point Char)
let loop c y x | x > w     = loop c (y+1) 1
| y > h     = getElems b
| otherwise = ifVisited y x  (loop c y (x+1)) $ do c' <- walk c y x  [(y,x)]; loop c' y (x+1)
walk c y x qs | isSink a (y,x) = do c' <- ifVisited y x (readArray b (y,x)) (return c)
mapM_ (p -> writeArray b p c') qs
if c == c' then return $ succ c else return c
| otherwise      = let (y',x') = next a (y,x)
in walk c y' x' ((y',x'):qs)
ifVisited y x f g = do c <- readArray b (y,x)
if c /= ' ' then f else g
loop 'a' 1 1
where ((1,1),(h,w)) = bounds a

うーん，カオス．別の方法もあると思うが，配列使うのが素直だと思う．

しかし，Haskellでは配列は使いにくい．

一応，コードを全部のせておく．

import Control.Monad (liftM, replicateM)
import Data.List (minimumBy)
import Data.Array.Unboxed (Array, UArray, listArray, bounds, (!))
import Data.Array.ST (STUArray, newArray, readArray, writeArray, inRange, getElems)
import Control.Monad.ST (ST, runST)
import Data.Ord (comparing)
type Point = (Int, Int)
-- main part
main = do cs <- (`replicateM` getCase) =<< getInt
mapM_ putStrLn.zipWith output [1..] $ map basin cs
next :: Array Point Int -> Point -> Point
next a p@(y,x) = minimumBy (comparing (a !)).filter (inRange $ bounds a) $ [(y-1,x),(y,x-1),(y,x+1),(y+1,x),(y,x)]
isSink :: Array Point Int -> Point -> Bool
isSink a p = a ! p <= a ! next a p
basin :: Array (Int, Int) Int -> [[Char]]
basin a = take h.map (take w).iterate (drop w).runST
$ do b <- newArray ((1,1),(h,w)) ' ' :: ST s (STUArray s Point Char)
let loop c y x | x > w     = loop c (y+1) 1
| y > h     = getElems b
| otherwise = ifVisited y x  (loop c y (x+1)) $ do c' <- walk c y x  [(y,x)]; loop c' y (x+1)
walk c y x qs | isSink a (y,x) = do c' <- ifVisited y x (readArray b (y,x)) (return c)
mapM_ (p -> writeArray b p c') qs
if c == c' then return $ succ c else return c
| otherwise      = let (y',x') = next a (y,x)
in walk c y' x' ((y',x'):qs)
ifVisited y x f g = do c <- readArray b (y,x)
if c /= ' ' then f else g
loop 'a' 1 1
where ((1,1),(h,w)) = bounds a
-- output and input function
getCase :: IO (Array Point Int)
getCase = do (h:w:_) <- getInts
as <- liftM (listArray ((1,1),(h,w)).concat).replicateM h $ getInts
return as
output :: Int -> [[Char]] -> String
output x xs = concat $ "Case #" : show x : ":n" : (interleave "n" $  map (interleave ' ') xs)
where interleave y []     = []
interleave y [x]    = [x]
interleave y (x:xs) = x:y:interleave y xs
getList :: Read a => IO [a]
getList = liftM (map read.words) getLine
getInts :: IO [Int]
getInts = getList
getInt :: IO Int
getInt = liftM head getInts

追記 #1

実は配列を捨てれば簡単に書けることに気がついた．効率？なにそれ食べられるの？

main = do cs <- (`replicateM` getCase) =<< getInt
mapM_ putStrLn.zipWith output [1..] $ map drainageBasins cs
next :: Array Point Int -> Point -> Point
next a p@(y,x) = minimumBy (comparing (a !)).filter (inRange $ bounds a) $ [(y-1,x),(y,x-1),(y,x+1),(y+1,x),(y,x)]
isSink :: Array Point Int -> Point -> Bool
isSink a p = a ! p <= a ! next a p
sink :: Array Point Int -> Point -> Point
sink a p = until (isSink a) (next a) p
drainageBasins :: Array (Int, Int) Int -> [[Char]]
drainageBasins a = split.mapMaybe (`lookup` ls) $ ss
where ss = map (sink a).range $ ((1,1),(h,w))
ls = zip (nub ss) ['a'..]
((1,1),(h,w)) = bounds a
split = take h.map (take w).iterate (drop w)

入出力の関数は同じ．

追記 #2

効率を気にしてみた．遅延評価万歳．

sinks :: Array Point Int -> [Point]
sinks a = elems ss
where ss = listArray (bounds a).map sink.range.bounds $ a
sink p | a ! p <= a ! next a p = p
| otherwise             = ss ! next a p
drainageBasins :: Array (Int, Int) Int -> [[Char]]
drainageBasins a = split.mapMaybe (`lookup` ls).sinks $ a
where ls = zip (nub.sinks $ a) ['a'..]
((1,1),(h,w)) = bounds a
split = take h.map (take w).iterate (drop w)

遅延評価を利用して，毎回sinkまで辿るのではなく，すでに訪ずれた場所に到達したら終了するようにした．

全体のコード．はじめのコードに比べ，だいぶスッキリした．精神衛生上良い．

import Control.Monad
import Data.Array
import Data.Ix
import Data.List
import Data.Ord
import Data.Maybe
type Point = (Int, Int)
-- main part
main = do cs <- (`replicateM` getCase) =<< getInt
mapM_ putStrLn.zipWith output [1..] $ map drainageBasins cs
next :: Array Point Int -> Point -> Point
next a p@(y,x) = minimumBy (comparing (a !)).filter (inRange $ bounds a) $ [(y-1,x),(y,x-1),(y,x+1),(y+1,x),(y,x)]
sinks :: Array Point Int -> [Point]
sinks a = elems ss
where ss = listArray (bounds a).map sink.range.bounds $ a
sink p | a ! p <= a ! next a p = p
| otherwise             = ss ! next a p
drainageBasins :: Array (Int, Int) Int -> [[Char]]
drainageBasins a = split.mapMaybe (`lookup` ls).sinks $ a
where ls = zip (nub.sinks $ a) ['a'..]
((1,1),(h,w)) = bounds a
split = take h.map (take w).iterate (drop w)
-- output and input function
getCase :: IO (Array Point Int)
getCase = do (h:w:_) <- getInts
as <- liftM (listArray ((1,1),(h,w)).concat).replicateM h $ getInts
return as
output :: Int -> [[Char]] -> String
output x xs = concat $ "Case #" : show x : ":n" : (interleave "n" $  map (interleave ' ') xs)
where interleave y []     = []
interleave y [x]    = [x]
interleave y (x:xs) = x:y:interleave y xs
getList :: Read a => IO [a]
getList = liftM (map read.words) getLine
getInts :: IO [Int]
getInts = getList
getInt :: IO Int
getInt = liftM head getInts

C Welcome to Code Jam

アルゴリズムを思いついたので，適当に実装したら，small通った．

調子にのってlargeに挑戦したら，メモリ使いすぎ．

急いで，修正するも少し間に合わなかった．アホ．

典型的なDPの問題だと思う．

というわけで，配列を使うか，メモ化を使うか，どっちかが楽だと思う．

問題サイズが小さいので，どちらでも問題ないと思う．メモ化が楽なのでメモ化を採用．

最初の失敗作．

countMemo,count :: [Int] -> [Int] -> Int
countMemo = memo2 count
count [] _ = 1
count _ [] = 
count (x:xs) (y:ys) | x /= y    = countMemo (x:xs) ys
| otherwise = (`mod` 10000) $ countMemo xs ys + countMemo (x:xs) (ys)

明らかに，効率が悪い（配列をグローバルにキーとしてる点など）が，smallの答えをだしてしまった．

修正版．

count :: Eq a => [a] -> [a] -> Integer
count a b = c  
where c x y | x == length a    = 1
| y == length b    = 
| a !! x /= b !! y = cMemo x (y+1)
| otherwise        = cMemo (x+1) (y+1) + cMemo x (y+1)
cMemo = memo2 c

どちらもDPの式そのまんまのコードである．

全体．

import Control.Monad (liftM, replicateM)
import Data.MemoTrie (memo2)
-- main part
main :: IO ()
main = mapM_ putStrLn.zipWith output [1..].map (count "welcome to code jam") =<< (`replicateM` getLine) =<< getInt
-- Simple DP
count :: Eq a => [a] -> [a] -> Integer
count a b = c  
where c x y | x == length a    = 1
| y == length b    = 
| a !! x /= b !! y = cMemo x (y+1)
| otherwise        = cMemo (x+1) (y+1) + cMemo x (y+1)
cMemo = memo2 c
-- output and input function
output :: Num a => a -> a -> String
output m n = "Case #" ++ show m ++ ": " ++ n'
where n' = reverse.take 4.reverse $ "0000" ++ show n
getList :: Read a => IO [a]
getList = liftM (map read.words) getLine
getInts :: IO [Int]
getInts = getList
getInt :: IO Int
getInt = liftM head getInts