AtCoder に登録したら解くべき精選過去問 10 問を Haskell で解いてみた （$n+1$ 番煎じ）

はじめに

$n+1$ 番煎じです。
Haskell で解いてみましたのコードと略説。

@drken さんの記事を見てみたら追記でジャッジができるようになりましたとのことで興味が湧いて来ました。
そんな時に@hsjoihs さんの記事がHaskell 一番乗りということだそうで、なるだけ見ないようにして解いてみました。

PracticeA はじめてのあっとこーだー（Welcome to AtCoder）

Haskell でのIO の取り扱いです、@tanakh さんの模範解答のコピペ。

main :: IO ()
main = do
  a <- readLn
  [b, c] <- map read . words <$> getLine  
  s <- getLine
  putStrLn $ show (a+b+c) ++ " " ++ s

入力のパターンごとに

以上だけだと芸がないので一応一覧、後半でも使えるパターンとして一応めも。

入力形式固定の時はこの例のコピペで

a
b c

という入力形式なら

main = do
  a     <- readLn
  [b,c] <- map read . words <$> getLine
  ...

で読んで... で処理します。

最初に何行か分かるなら

最初に何個データが来るか宣言されてからデータが来る場合、つまり

n   -- the total number of the follwoing data
d1  -- 1 st data
...
dn  -- n th data

というパターンなら'Control.Monad.replicateM :: Applicative m => Int -> m a -> m [a]' をインポートしつつ

import Control.Monad (replicateM)

main = do
  n  <- readLn
  ds <- replicateM n readLn
  ...

という形で読みんで処理します。

(a,b) ペアで扱いたい

ちょっと冗長ですが

type Pair = (Int, Int)

main :: IO ()
main = do
  n   <- readLn :: IO Int
  xys <- replicateM n readPair
  ...

readPair :: IO Pair
readPair = do
  [x,y] <- map read . words <$> getLine
  return (x,y)

という感じでペア用の読み込み関数を作っておくことにしました。

ABC086A Product

main :: IO ()
main = do
  [a,b] <- map read . words <$> getLine
  putStrLn $ oddOrEven' a b

oddOrEven'
  :: Int -> Int -> String
oddOrEven' a b
  | odd a && odd b = "Odd"
  | otherwise      = "Even"

入力の読み込みはテンプレ、分岐用にhome made の関数を書きましたが分けなくて良いかも。
偶奇は奇数奇数の組み合わせのみ奇数なのでガードで書きおろす。

ABC081A Placing Marbles

main :: IO ()
main = do
  s <- getLine
  let n = length . filter (=='1') $ s
  print n

String すなわち[Char] と思って読み込んだs をChar の'1' で等しいかどうかでフィルターして長さを返せばそれが答え。
Applicative スタイルで書いたら @drken さんの解答に等しくなります。

ABC081B Shift only

main :: IO ()
main = do
  _ <- getLine
  as <- map read . words <$> getLine
  print $ counter as

counter
  :: [Int] -> Int
counter ns = helper ns 0
  where
    helper :: [Int] -> Int -> Int
    helper ms k
      | all even ms = helper ms' (k+1)
      | otherwise   = k
      where
        ms' = map (`div` 2) ms

ちょっとghci の上で実験して再帰で素朴に書いてみました。
accumulator を使って累算していきます、すなわちリストの要素が全部偶数なら全部二で割ってというふうに回していく回数を記録して、偶数じゃない要素が出たら累算された値を返すというやつです。

ABC087B Coins

main :: IO ()
main = do
  a <- readLn
  b <- readLn 
  c <- readLn 
  x <- readLn 
  print $ selection a b c x

selection
  :: Int -> Int -> Int -> Int -> Int
selection a b c x
  = length [(s,t,u) | s<-[0..a], t<-[0..b], u<-[0..c]
                    , 500*s + 100*t + 50*u == x]

いわゆるリスト内包表記を使っての全数探索です。

ABC083B Some Sums

import Data.Char (digitToInt)

main :: IO ()
main = do
  [n,a,b] <- map read . words <$> getLine 
  print $ f n a b

f :: Int -> Int -> Int -> Int
f n a b = sum [ m | m <- [1..n]
                  , a   <= g m
                  , g m <= b]
  where
    g = sumDigits

sumDigits
  :: Int -> Int
sumDigits = sum . map digitToInt . show

ズルしました、hoogle であるに違いないと睨んだ型で検索したらdigitToInt を見つけましたので組み込んだ次第です。
show でString にした後一桁ごと数字に直して全部足すというのがsumDigits です。

ABC088B Card Game for Two

import Data.List (sortBy)

sort' 
  :: Ord a => [a] -> [a]
sort' = sortBy (flip compare)

alisAndBob 
  :: Ord a => [a] -> ([a],[a])
alisAndBob ns = helper ns ([],[])
  where
    helper :: Ord a => [a] -> ([a],[a]) -> ([a],[a])
    helper [] ab = ab
    helper [a] ab@(as,bs) = (a:as, bs)
    helper (a:b:cs) ab@(as,bs) = helper cs (a:as, b:bs)

point
  :: ([Int],[Int]) -> Int
point (as,bs) = sum as - sum bs

main :: IO ()
main = do
  _ <- getLine
  as <- map read . words <$> getLine
  print . point . alisAndBob . sort' $ as

ソートが昇順だもんでどうひっくり返そうかなと思ったら比較関数の引数をひっくり返して降順に、つまり大きい方から小さい方へ、とするという手を見つけまして、採用。
ソートした後のリストを先頭から振り分けていけばアリスとボブの手札に、あとはそれぞれ足し合わせてから引いたら得点差に。
ハスケル的にはカリー化しておいた方が見やすいでしょうか？

ABC085B Kagami Mochi

import Data.List (nub, sort)
import Control.Monad (replicateM)

mochi
  :: [Int] -> Int
mochi = length . nub

main = do
  n <- readLn
  ds <- replicateM n readLn
  print $ mochi ds

最初はmochi = length . nub . sort にしてましたが要らんかったな、、、
nub で重複した要素を取り除いて数を数えたらそれがそのまま段数に。

ABC085C Otoshidama

otoshidama'
  :: Int -> Int -> [(Int,Int,Int)]
otoshidama' n y
  = [(a,b,c) | let a0 = y `quot` 10000
             , a <- [0 .. a0]
             , let b0 = (y - 10000*a) `quot` 5000
             , b <- [0 .. b0]
             , let c = n-a-b
             , a*10000 + b*5000 + c*1000 == y
             ]

otoshidama 
  :: Int -> Int -> IO ()
otoshidama n y
  | null o    = putStrLn "-1 -1 -1"
  | otherwise = putStrLn $ show a ++ " " ++ show b ++ " " ++ show c
  where
    o = otoshidama' n y
    (a,b,c) = head o

main :: IO ()
main = do
  [n,y] <- map read . words <$> getLine
  otoshidama n y

otoshidama' はリスト内包表記を用いて全数探索してます。
otoshidama では、もしこのotoshidama' が空リストを返せば-1 -1 -1 を返しますが、そうでない時は安全に先頭を取れるのでパターンマッチで取り出した(a,b,c) を出力するというわけです、ひとつあれば充分なので。

注

と偉そうに書いてますが、最初はもっと素朴にc も含めた三重の全数探索で時間切れを喰らいまして、さてどう計算量減らそうかと思っていたところで二重三重の for 文という文句を見つけふむふむと読んでHaskell のリスト内包表記に焼き直したら通りました。
確かにn が与えられているのでa,b が決まれば自動的にc も決まります。

ABC049C 白昼夢 / Daydream

main :: IO ()
main = do
  s <- getLine
  let r = reverse s
  let b = isIn r
  if b then putStrLn "YES"
       else putStrLn "NO"

isIn
  :: String -> Bool
isIn s = isIn' s False
  where
    isIn' ""                               b = b 
    isIn' ('r':'e':'m':'a':'e':'r':'d':ss) _ = isIn' ss True 
    isIn'         ('m':'a':'e':'r':'d':ss) _ = isIn' ss True 
    isIn'     ('r':'e':'s':'a':'r':'e':ss) _ = isIn' ss True
    isIn'         ('e':'s':'a':'r':'e':ss) _ = isIn' ss True
    isIn' _                                _ = False

先頭から見ていくと、最後までいけるかどうかで二分木を作って追っていくのかな？と思ったりしていきなり難しいなぁと感じていたら何の事は無いひっくり返して例のaccumulator で再帰的に調べて行ったら通りました。
初期値はこのテストケースには関係ないみたいですね。

ABC086C Traveling

最初

import Control.Monad 
  ( replicateM ) 

type Trio = (Int, Int, Int)

main :: IO ()
main = do
  n    <- readLn :: IO Int
  txys <- replicateM n readTrio
  putStrLn $ if possiblePath txys
               then "Yes"
               else "No"

readTrio :: IO Trio
readTrio = do
  [x,y,z] <- map read . words <$> getLine
  return (x,y,z)

norm
  :: Trio -> Int
norm (_, x, y) = abs x + abs y

isNeighbour
  :: Trio  -> Bool
isNeighbour p@(t,x,y) -- (0,0,0)
  = even (x + y - t) && norm p <= t

diffPath
  :: [Trio] -> [Trio]
diffPath []        = []
diffPath pp@(p:ps) = p : zipWith diff ps pp
  where
    diff (s,a,b) (t,x,y) = (s-t, a-x, b-y)

possiblePath
  :: [Trio] -> Bool
possiblePath = all isNeighbour . diffPath  

先頭を原点からの、それ以降の要素を要素間の相対座標に直してそれぞれが到達可能かどうかを見ていこうという方針です。
到達可能な範囲はひし形になり、そこへの移動に必要な時間はいわゆるマンハッタン距離で抑えられます。
あとはそれぞれ書き下ろしていくだけでしたが、この問題だけ偉い時間が掛かりました、実行に。
少々アレンジの違いはあれどそれぞれこの方針なら1.2 sec から1.3 sec という結果でした。

次

import Control.Monad 
  ( replicateM ) 
import qualified Data.ByteString.Char8 as B
  ( readInt, words, getLine )
import Data.Maybe
  ( fromJust )

type Trio = (Int, Int, Int)

main :: IO ()
main = do
  n    <- readLn :: IO Int
  txys <- replicateM n readTrio :: IO [Trio]
  putStrLn $ if possiblePath txys
               then "Yes"
               else "No"

readTrio :: IO Trio
readTrio = do
--  [x,y,z] <- map read . words <$> getLine
  [x,y,z] <- map (fst . fromJust . B.readInt) . B.words <$> B.getLine
  return (x,y,z)

norm
  :: Trio -> Int
norm (_, x, y) = abs x + abs y

isNeighbour
  :: Trio  -> Bool
isNeighbour p@(t,x,y) -- (0,0,0)
  = even (x + y - t) && norm p <= t

diffPath
  :: [Trio] -> [Trio]
diffPath []        = []
diffPath pp@(p:ps) = p : zipWith diff ps pp
  where
    diff (s,a,b) (t,x,y) = (s-t, a-x, b-y)

possiblePath
  :: [Trio] -> Bool
possiblePath = all isNeighbour . diffPath  

他の方の解答も見れるのでありがたくいくつか覗いてみました、ぱっとペーペーの私でも真似られそうなのはData.ByteString.Char8を使うというものでした
ほぼ同じコードになりますが、B.readInt がMaybe でラップされたペアが帰って来るので、辺な入力はないと信じてJust の中身だけ取り出してfst で当該要素を取って来るという作業が必要になります。
これで10 倍ほど早くなり0.18 sec から0.19 sec となりました、さらにもう10倍速いコードも見受けられましたがちょっと背伸びが過ぎるのでここにて。