Round 1B (Google Code Jam 2009)

まぁ,前回同様,予想通り,ダメダメだったわけだが.

共通のテンプレート(下)を使用した.

import Data.List
import Data.Maybe
import Data.Ord
import Data.Char
import Data.Function
import Data.Map (Map)
import qualified Data.Map as M
import Data.Set (Set)
import qualified Data.Set as Set
import Data.MemoTrie
import Data.Array
import Data.Array.ST
import Control.Monad
import Control.Monad.ST
getList :: Read a => IO [a]
getList = liftM (map read.words) getLine
getInts :: IO [Int]
getInts = getList
getInt :: IO Int
getInt = liftM head getInts

これで,qualifiedの綴りに迷うことがなくなれば,幸いだ.

(ちなみに,ソースコードは見やすいように手を加えてある)

目次

A

ぱっと見.問題文長い.

英語が苦手な僕は,こんなん読んでたら,理解するのに30分くらいかかる.とか思って,Bに進んだ.

そのあと戻ってきましたが.

二分木のパーサが出来れば,おしまい,な問題だと思う.

しかし.

しかし,である.

パーサつくるの面倒.しかし,ライブラリの使いかた(多分,Haskellにはパーサのライブラリがあった)

も知らないし.

だけど,Cは厄介そうだったので,仕方なく,力技で書いた.

data Tree = T {w::Double, f::String, y::Tree, n::Tree} | L {w::Double} deriving Show
mkTree :: String -> Tree
mkTree s | leaf s    = L ( read.init.tail $ s)
| otherwise = let w’ = read.tail $ w
f’ = f
(ys,ns) = cut $ unwords ws
ns’ = fst $ cut ns
in T w’ f’ (mkTree ys) (mkTree ns’)
where (w:f:ws) = words s
leaf :: [Char] -> Bool
leaf s = all (elem "()0123456789. ") s
cut :: String -> (String, String)
cut (’ ‘:s) = cut s
cut (’(’:s) = cpart 1 "(" s
where cpart  cs s = (cs, s)
cpart p cs (’(’:s) = cpart (p+1) (cs++"(") s
cpart p cs (’)’:s) = cpart (p-1) (cs++")") s
cpart p cs (c  :s) = cpart p (cs ++ )   s
cute :: Tree -> [String] -> Double -> Double
cute (L w) fs p = p  w
cute (T w f y n) fs p | elem f fs = cute y fs (w  p)
| otherwise = cute n fs (w * p)
main = do n <- getInt
forM_ [1..n] $ i ->
do l <- getInt
t <- replicateM l getLine
let t’ = mkTree.fst.cut.unlines $ t
a <- getInt
putStrLn $ "Case #" ++ show i ++ ":"
forM_ [1..a] $ a ->
do fs <- getLine
print $ cute t’ (drop 2.words $ fs) 1

ものすごい,その場しのぎのコードなので,気に食わない.

Stringの処理に手間取った.

B

問題文,短い.

これだよ,こういう問題が良いんだよ.意気揚々と問題文を読み始める.

5分後…

>日本語でおk?

10分後…

>日本語で(ry

15分後…

>にほ(ry

と,まぁ,問題文が短いだけに,意味が分からないと,困ると.

桁が増える場合,などを考えていなかったりして,結構時間を食った.

あとで分かったが,この問題は next permutation を求めるもんだい.

なので,これが理解できると一瞬(で,出来る人もいる).

ということで,コードはシンプル.

main = do t <- getInt
forM_ [1..t] $ i ->
do n <- liftM read getLine
putStrLn $ "Case #" ++ show i ++ "] " ++ show (next n)
next :: Integer -> Integer
next n = read.map intToDigit.npart1 [] .reverse.(:).map digitToInt.show $ n
npart1 xs (y:z:zs) | y > z     = npart2 z (y:xs) zs
| otherwise = npart1 (y:xs) (z:zs)
npart1 xs [z] = npart2 z xs []
npart2 z xs ys = reverse ys ++ m : sort (delete m (z:xs))
where m = minimum.filter (>z) $ xs

しかし,もう少し速く解けるだろう,この問題程度なら.

そういえば,このとき,screen か zsh かどっちか分からないけど,変な挙動を突然したから,

焦った.結局,ほかのterminal立ちあげて,どうにかなった.

C

これは問題文は,他2問と比べると,すんなり,理解できた.

ようは,最短路問題ですよ,たぶん.

とりあえず,コンテスト中に (座標, 数式の計算結果)を頂点にして,枝を座標移動にともなう,数式の追加

な感じで表現して,ダミーの頂点を一つ追加して,最短パスのアルゴリズムを走らせれば,答えはでるなー,

|V|= O(Q * W * W), |E| = O( Q * W * W) ぐらいかー,

まぁ,計算は終わるな.

でも,実装はHaskellだと時間的に無理かな.

と,思ってました.

実際,時間切れでした.

終了後,つくったコード.ベルマン・フォード的なコード(配列の代わりにMapを使用).

しかし,汚いコードだ.しかも,遅い.

type Point = (Int, Int)
type MS    = Array Point Char
type Memo  = Map (Point, Int) String
type Ans   = Map Int String
type State = ((Point,Int), String)
_QueryMax = 250
nodes :: MS -> [Point]
nodes ms = filter (isDigit.(ms !)).range.bounds $ ms
neighboor s (i,j) = filter (inRange.bounds $ s) [(i,j+1),(i+1,j),(i,j-1),(i-1,j)]
edge ms (,) = [(x, digitToInt $ ms ! x, [ms ! x]) | x <- nodes ms]
edge ms x = nub.sort $ [(z, delta y z, [ms ! y, ms ! z]) | y <- neighboor ms x, z <- neighboor ms y]
where delta a b | ms ! a == ’+’ = digitToInt $ ms ! b
| ms ! a == ’-’ = negate.digitToInt $ ms ! b
updateMemo :: MS -> Memo -> [State] -> (Memo, [State])
updateMemo ms m xs = foldl’ upart (m, []) xs
where  upart (m, zs) x | M.member (fst x) m = (m, zs)
| otherwise          = (uncurry M.insert x m, x:zs)
updateAns :: MS -> Ans -> [State] -> Ans
updateAns ms a xs = foldl’ upart a ys
where ys = nub’ [(c,s)| ((x,c),s) <- xs,  < c && c <=_QueryMax]
upart a x | M.member (fst x) a = a
| otherwise          = uncurry M.insert x a
step ms m a xs
| M.size a == _QueryMax = a
| null xs               = a
| otherwise             = step ms m’ a’ zs
where (m’,ys) = updateMemo ms m xs
a’      = updateAns ms a ys
zs      = nexts ms m’ ys
next :: MS -> Memo -> State -> [State]
next ms m ((x,c),s) = [((z, c + d), s ++ s’) |(z,d,s’) <- edge ms x, c + d > -_QueryMax, c + d < 2 *QueryMax]
nexts :: MS -> Memo -> [State] -> [State]
nexts ms m xs = nub’ $ concatMap (next ms m) xs
nub’ :: (Ord a, Ord b) => [(a,b)] -> [(a,b)]
nub’ = map (minimumBy $ comparing snd).groupBy (on (==) fst).sort
main = do n <- getInt
forM [1..n] $ i ->
do (w:q:) <- getInts
ms <- getSquare w
qs <- getInts
let a = step ms (M.empty) (M.empty) [(((,),),"")]
putStrLn $ "Case #" ++ show i ++ ":"
forM qs $ j ->
putStrLn.fromJust.M.lookup j $ a
– output and input function
getSquare w = liftM (listArray ((1,1),(w,w)).concat).replicateM w $ getLine

初めは,fglのライブラリ使って,お手軽最短経路を実行しようと画策していたが,

  • グラフの頂点はIntでないとダメ
  • 枝の重みは Real でないとダメ

らしいので,どうやらお手軽作戦は,全然お手軽では無い模様だった.

どうにかして,関数型らしく書けないものか.

# あ,neighboursだった.