第８回日本情報オリンピック 予選

今年の情報オリンピック予選問題
http://www.ioi-jp.org/joi/2008/2009-yo-prob_and_sol/
をHaskellで解いてみました．

簡潔に書けて楽しいです．

1

module Main where
import IO

main = do
  input <- getContents
  let i = map (map read . words) $ lines input
  putStr . unlines . map (unwords . map show . solve) $ i

solve a = time $ untime (drop 3 a) - untime (take 3 a)
  where time n = [n `div` 3600, n `div` 60 `mod` 60, n `mod` 60]
        untime [h,m,s] = h*3600 + m*60 + s

複数行処理するところが面倒．それだけです．

2

module Main where
import IO
import List

main = do
  input <- getContents
  let i = map read $ words input
  putStrLn . unwords . map show $ solve i

solve a = [score (take 10 a), score (drop 10 a)]
  where score = sum . take 3 . reverse . sort

sum と take があるおかげで楽勝．

3

module Main where
import IO
import List

main = do
  input <- getContents
  let i = map read $ words input
      n = head i
  putStrLn . show $ solve n (take n $ tail i)

solve n a =
  minimum [ length . rensa $ chg pos to a
           | pos <- [0..n-1], to <- [1..3] ]
  where chg p t a = (take p) a ++ t : drop (p+1) a 

rensa =
  stopped . (iterate oneRensa)
  where 
    oneRensa =
      concat . filter (\x -> length x < 4) . group
    stopped a =
      fst . head . filter (\(a,b) -> a==b) $ zip a (tail a)

「1箇所を変更して，連鎖した後の長さの最小値を取る」部分が solve で，
rensa は同じものの連続をまとめて，長さ4未満のものを残し，変化しなくなったら終了ということ．
変更した場所から探したりしていないために遅くなっていますが，予選の提出には間に合う程度．

4

module Main where
import IO

main = do
  input <- getContents
  let i = map read $ words input
      w = i!!0
      h = i!!1
      d = drop 2 i
  putStrLn . show $ maximum [tos w h d x y | x <- [0 .. w-1], y <- [0 .. h-1]]

tos w h d x y | x<0 || x>=w  = 0
tos w h d x y | y<0 || y>=h  = 0
tos w h d x y
  | d!!t == 0  = 0
  | otherwise =
      let d2 = tozero d t
      in 1 + maximum [ 
           (tos w h d2 (x-1) y)
           , (tos w h d2 (x+1) y)
           , (tos w h d2 x (y-1))
           , (tos w h d2 x (y+1))]
  where t = x+w*y
        tozero a t =
          let b = splitAt t a
          in fst b ++ 0 : tail (snd b)

再帰する問題だと，コードの雰囲気はあまり変わらない様子．
変数の書き換えがリストだと面倒です．

5

module Main where
import IO

main = do
  input <- getContents
  let i = map read $ words input
      n = i!!0
      p = i!!2
      q = i!!3
      r = i!!4
  putStrLn . show $ (count2 p q r) . shuffle (drop 5 i) $ cards n

count2 p q r c =
  count r $ (cut3 (p-1) q c) !! 1

count r =
  sum . (map (cnt r))
  where cnt r (x,y) = min r y - min r x

cards n = [(0,n)]

shuffle [] c = c
shuffle (x:y:zs) c =
  shuffle zs $ concat . reverse $ cut3 x y c

cut3 x y c =
  let a = cut y c
      b = cut x (fst a)
  in [fst b, snd b, snd a] 

cut x [] = ([],[])
cut x c | x<=0  = ([],c)
cut x (c:cs)
  | len <= x  =
      let a = cut (x-len) cs
      in (c : fst a, snd a)
  | otherwise =
      let a = (fst c, fst c + x)
          b = (fst c + x, snd c)
      in ([a], b:cs)
  where len = (snd c) - (fst c)

今回最も実装が重い問題です．たぶん．
もちろん，早い解法．（公式ページ解説参照）
(a,b) で a+1 .. b のカードの束としています．

枚数でカードを分割する cut を用い，
3分割する cut3 と答えを数える count を実装．
cut3 がタプルではなくリストで返すのは， concat . reverse と書けるからです．

6

module Main where
import IO

main = do
  input <- getContents
  let i = map read $ words input
  putStrLn . show $ tos (i !! 0) (i !! 1) (i !! 2)

tos n m s = bingo !! m !! (n*n) !! s

bingo = scanl
          (\b m ->
            zipWith (zipWith (+%) )
              b
              (repeat 0 : map (replicate m 0 ++) b)    )
          ((1 : repeat 0) : (repeat . repeat) 0)
          [1..]
        where a +% b = (a+b) `mod` 100000

Haskellだとなぜか実装が重くなる問題です．

をリストをずらして zipWith (+) することで実装．
mod 100000 だったので，適当な演算子 +% を定義しています．