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 0 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 ++ [c]) 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.(0:).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 (0,0) = [(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, 0 < 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) [(((0,0),0),"")] 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だった.
Round 1C (Google Code Jam 2009)
ヘボヘボだった,1Bだが,なんとか通過していた.
練習のために,1Cもやってみた.
時間制限とかプレッシャーがないぶん,気楽で,まぁまぁ良い感じだった(たぶん,問題も簡単になっている).
(前回と同じテンプレートを使用しています.)
A
そのまま.ただし,1進数は許されないことに注意.
main = do n <- getInt forM_ [1..n] $ \i -> do s <- getLine putStrLn.output i $ f s f :: (Eq a) => [a] -> Integer f cs = foldl' add 0.mapMaybe (`lookup` m) $ cs where ds = nub cs b = max 2 $ genericLength ds m = zip ds (1:0:[2..]) add x y = b * x + y
B
微分とかできますか?って問題なんですかね.
実は,計算誤差のこと全く考えていなかった(なんとうマヌケ).ちょっと悩んだけど,
出力みたらNaNとか負の時間とかになっていたので,そこで気づいた.
main = do t <- getInt forM_ [1..t] $ \i -> do n <- getInt cs <- liftM (coef.unite).replicateM (fromIntegral n) $ getInts putStrLn $ "Case #"++show i++": "++ show (dMin n cs)++" "++show (tMin cs) unite :: Integral a => [[a]] -> [a] unite fs = map sum.transpose $ fs coef :: Integral a => [a] -> [a] coef [x,y,z,vx,vy,vz] = unite.map f $ [(vx,x),(vy,y),(vz,z)] where f (a,b) = [a^2, 2*a*b, b^2] pos x = if x < 0 then 0 else x tMin (0:_) = 0 tMin (p:q:_) = pos $ - fromIntegral q / fromIntegral (2*p) dMin n cs = (/n').sqrt.pos.sum.zipWith (*) (map fromIntegral cs) $ [t^2, t, 1] where t = tMin cs n' = fromIntegral $ n -- output and input function getInts :: IO [Integer] getInts = getList getInt :: IO Integer getInt = liftM head getInts
あと,Intで計算したら桁落ちしてたので,Integerにした.
C
逆から考えてDP.
囚人が抜けていくのではなく,囚人が空いているかしょに入ってくると思って再帰.
若干実行時間が,遅い気もするが,配列ではなく,メモ化再帰だから,おおめにみる.
main = do n <- getInt forM_ [1..n] $ \i -> do (p:q:_) <- getInts qs <- getInts putStrLn.output i $ (bribe p qs) bribe :: Int -> [Int] -> Int bribe p qs = b 1 $ length ss where ss = map pred.zipWith (-) (qs++[p+1]) $ 0:qs bM = memo2 b b i j | i == j = 0 | i < j = b0 i j + minimum [bM i k + bM (k+1) j| k <- [i..j-1]] b0 i j = pred.sum.intersperse 1.take (j-i+1).drop (i-1) $ ss
結構,シンプルだと自分では思っている.やはり,MemoTrieが便利(memo2ってやつ).
# C は 雰囲気が Project Euler #253 似ていると思った.