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だった．

コンテンツ

A

B

C