「AtCoder に登録したら次にやること」を初心者がHaskellでやってみる

#はじめに
2018年の1月からAtCoderを始めました。
ABC中心に5回くらいコンテストに出てみて初心者なりに楽しんでいるのですが、やはりなかなか難しいです。そう思っていたところ、けんちょんさんが素敵なガイドを書いてくださったので、これに沿って少しずつ勉強をやってみようと思います。
##参考にする記事

• けんちょんさんのガイド
• @hsjoihsさんの記事

##方針
自分で解けた問題は解けた時点のコードを投稿して、その後でほかの方のコードを見て改善したり、コメントを追加したりして、一つの問題に複数のバージョンのコードを載せていって成長の軌跡？みたいにしていこうかとおもっています。試行錯誤をしたときは良くなかったアイディア含めてありのままに書いたり書かなかかったりします。

1問ごとに、

• 自分で解く

• けんちょんさんのコメントを読む

• @hsjoihsさんの記事を読む

• 自分で書き直す
  みたいにやっていくよてい。

• 言語はHaskellを使います。
  （筆者はHaskellも競プロも初心者です。）

#第 1 問: ABC 086 A - Product (100 点)

product.hs

main :: IO()
main = do
    integers <- fmap (map read . words) getLine
    putStrLn $ solve integers

solve :: [Int] -> String
solve integers = if mod ab 2 == 0 then "Even" else "Odd"
    where ab = product integers

#第 2 問: ABC 081 A - Placing Marbles (100 点)

marble.hs

main = do
    line <- getLine
    putStrLn $ solve line

solve :: String -> String
solve = show . length . filter ('1'==)　{-length . filterの部分はなんかほかに関数ありそう-}

• 入出力はmainでやり、solveで入力された文字列を答えになるべき文字列にします。
• StringはCharのリストなので、Charの'1'と等しいものだけを取り出した部分リストをつくります。(filter ('1'==))
• その部分リストの要素数を数えます。(length)
• 数えた答えはIntなので、showをつかってStringにします。
• これらを合成関数にします。
• filterの引数に('1'==)という部分適用された関数を使ったのでちょっとHaskellっぽい！！

#第 3 問: ABC 081 B - Shift Only (200 点)

shiftonly.hs

main :: IO()
main = do
    n <- getLine {-nは使わない-}
    numbers <- fmap (map read . words) getLine
    putStrLn $ solve numbers

solve :: [Int] -> String
solve nums = show $ f nums 0

{-第一引数のリストが2で割れる回数を第二引数に加えて返却する。-}
f :: [Int] -> Int -> Int
f [] x = x
f nums x = if (dividable nums) then f nums' x+1 else x
    where nums' = map ((flip div) 2) nums

{-整数のリストの中のすべての整数が偶数の時Trueを返しそれ以外の時False-}
dividable :: [Int] -> Bool
dividable = and . map ((0==) . (flip mod) 2)

• ちょっとカッコが多くなってしまった。。
• dividableがTrueかどうかを確かめてからあらためて2で割るっていうのは無駄がある気がするけどAの最大値のlogかけるNくらいの大きさなら許してほしいとおもって最初に思いついたように書いてみた。あとでうまい人のコードを探したい。

#第 4 問: ABC 087 B - Coins (200 点)

最初に自分で提出したコードは次の通りでした。

coins1.hs

main = do
    a <- read <$> getLine
    b <- read <$> getLine
    c <- read <$> getLine
    x <- read <$> getLine
    print $ solve a b c x

{-500円玉a枚と100円玉b枚と50円玉c枚でx円を払い方法の数-}
solve :: Int -> Int -> Int -> Int -> Int
solve a b c x = sum [g b c (x - 500*c') | c' <- [0..a] ]

{-100円玉b枚と50円玉c枚でx円を払う方法の数-}
g :: Int -> Int -> Int -> Int
g b c x = sum [h c (x - 100*b') | b' <- [0..b] ]

{-50円玉c枚でx円を払う方法の数-}
h :: Int -> Int -> Int
h c x | x >= 0 = if 50 * c >= x then 1 else 0
      | x < 0 = 0

自分で解いたときはこんな風に書きました。考えているときは素直に考えているつもりでいたのですが、「ぴったりx円」というこの問題の中で難しいポイントから先に考えてしまっていた気がします。けんちょんさんのコメントを読んで初めてそれに気が付きました。

けんちょんさんコメントを読んでからもう一度書き直したのが次のコードです。

coins2.hs

main = do
    a <- read <$> getLine
    b <- read <$> getLine
    c <- read <$> getLine
    x <- read <$> getLine
    print $ solve a b c x

{-金額を忘れてとにかく可能な支払い方法を列挙する→金額が正しいものを数える-}
solve :: Int -> Int -> Int -> Int -> Int
solve a b c x = length $ filter (x==) [ 500*a' + 100*b' + 50*c' | a'<-[0..a], b'<-[0..b], c'<-[0..c] ]

最初の書き方をしたときはやっぱり途中で頭がこんがらがったりして時間を食っていました。x円っていうところに引っ張られないで、そもそも支払い方っていくつあるのか？って考えたらよかったなとおもいます。

学んだこと

• 場合の数→全列挙から考える。つまり、「ある条件をみたすものの数」と言われたら「ある条件」をとりあえず忘れて全体はどうなってるのか考えてみる。
• <$>を使うならControl.Applicativeをimportする。

#第5問 ABC083B Some Sums

somesums.hs

import Control.Applicative
main = do
    [n,a,b] <- map read . words <$> getLine
    print $ solve n a b

solve :: Int -> Int -> Int -> Int
solve n a b = sum [m |m <- [1..n], dsum m <= b, dsum m >= a]

dsum :: Int -> Int
dsum n = sum $ map (read . (\c -> [c])) (show n)

dsumの定義がなんかうまくない気がします。
ラムダ式書きたくない。

第6問 ABC088B - Card Game for Two

cardgamefortwo.hs

import Control.Applicative
import Data.List
main = do
    getLine
    numbers <- map read . words <$> getLine
    print $ solve numbers

solve :: [Int] -> Int
solve nums = alice - bob
    where alice = sum [sorted !! index | index <- [0,2..len-1]]
          bob = sum [sorted !! index | index <- [1,3..len-1]]
          sorted = reverse . sort $ nums
          len = length nums

上のコードでもACですが、こちらのほうがかっこいいですね！

学んだこと

• リストの添え字指定アクセスは!!関数でできる
• [0,2..n]みたいに書くとスライスできる
• cycle関数で正負を交互にする

#第7問 ABC085B - Kagami Mochi

kagamimochi.hs

import Control.Applicative
import Data.List
main = do
    n <- readLn
    mochis <- sequence $ replicate n readLn
    print $ solve mochis

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

学んだこと

• Data.Listの中にあるnub関数は、リストからユニークな要素をとりだしてくれます。

> :t nub
nub :: (Eq a) => [a] -> [a]

#第8問 ABC085C - Otoshidama(300点)

• ついに300点問題だ！ということで考えたことを書いていってみます。
• 第 4 問: ABC 087 B - Coins (200 点)で学んだことを今こそ生かす！ということでN枚のお札でのお年玉の支払い方がそもそも何通りあるのかを考えてみますと、もっとも単純にN枚のお札の順番まで区別して考えると3^N。問題を見るとN=2000までありうるとのことなので今回は「素朴に全部列挙」はできなさそうです。
• そこで工夫をしないといけませんが、着想を得るために具体例を手で計算して解いてみます。Y=43000ではどうでしょう。全部千円札だと43枚で、5000円札に1枚両替すると5枚減って1枚増えるので39枚になります。
• ここでふと思ったのですが、「全部千円札」の支払い方からスタートして「両替」を繰り返すことでY円支払い可能な方法を「辿っていく」のはどうでしょうか？
• 枚数を減らす両替は「1000円から5000円」「1000円から10000円」「5000円から10000円」の3つがあります。
• このあたりで「グラフ」っぽさを感じ取りました。僕の知っている数少ないアルゴリズム「BFS」を使えないか？
  - とか考えてましたが風呂に入ったら気が変わり、次のようなコードでTLEしました。

otoshidama.hs

import Control.Applicative
import Data.List

main = do
    [n,y] <- map read . words <$> getLine
    putStrLn $ psolve n y

type Otoshidama = (Int,Int,Int)
faildama = (-1,-1,-1) :: Otoshidama

psolve :: Int -> Int -> String
psolve n y = pOtoshidama $ solve n y 

solve :: Int -> Int -> Otoshidama
solve n y = judgel n (candidates n y)

candidates :: Int -> Int -> [Otoshidama]
candidates n y = nub . concat $ map (f n y) (natsume n y)

judgel :: Int -> [Otoshidama] -> Otoshidama
judgel _ [] = faildama
judgel n (x:xs) | judge n x = x
                | otherwise = judgel n xs
judge :: Int -> Otoshidama -> Bool
judge n o = n == satsu o

natsume :: Int -> Int -> [Int]
natsume n y = [n' | n' <- [0..n], mod n' 5 == mod (div y 1000) 5]

f :: Int -> Int -> Int -> [Otoshidama]
f n y n' = zipWith (\x y -> (n',x,y)) list' [0..]
    where y' = div (y - 1000*n') 5000
          list' = [y',y'-2..0]

satsu :: Otoshidama -> Int
satsu (x,y,z) = x+y+z

pOtoshidama :: Otoshidama -> String
pOtoshidama (x,y,z) = unwords $ map show [z,y,x]

candidatesのところが雑すぎたかなとおもったので少し改善を試みます。これでだめだったらBFSをやってみようと思いました。

otosidama.hs

import Control.Applicative
import Data.List

main = do
    [n,y] <- map read . words <$> getLine
    putStrLn $ psolve n y

type Otoshidama = (Int,Int,Int)
faildama = (-1,-1,-1) :: Otoshidama

psolve :: Int -> Int -> String
psolve n y = pOtoshidama $ solve n y 

solve :: Int -> Int -> Otoshidama
solve n y = judgel n (candidates n y)

candidates :: Int -> Int -> [Otoshidama]
{-candidates n y = nub . concat $ map (f n y) (natsume n y)-}
candidates n y = foldl appendama [] list
    where list = map (f n y) (natsume n y)

appendama :: [Otoshidama] -> [Otoshidama] -> [Otoshidama]
appendama list [] = list
appendama list (x:xs) = if x `elem` list 
                        then appendama list xs
                        else appendama (x:list) xs

judgel :: Int -> [Otoshidama] -> Otoshidama
judgel _ [] = faildama
judgel n (x:xs) | judge n x = x
                | otherwise = judgel n xs
judge :: Int -> Otoshidama -> Bool
judge n o = n == satsu o

natsume :: Int -> Int -> [Int]
natsume n y = [n' | n' <- [0..n], mod n' 5 == mod (div y 1000) 5]

f :: Int -> Int -> Int -> [Otoshidama]
f n y n' = zipWith (\x y -> (n',x,y)) list' [0..]
    where y' = div (y - 1000*n') 5000
          list' = [y',y'-2..0]

satsu :: Otoshidama -> Int
satsu (x,y,z) = x+y+z

pOtoshidama :: Otoshidama -> String
pOtoshidama (x,y,z) = unwords $ map show [z,y,x]

だめでした。
はじめに考えていたBFSによる方法をやってみます。これ以上賢い方法は思いつかないのでこれでだめならあきらめ。
PythonでしかBFSを書いたことがないのでPythonでやります。

otoshidama.py

from collections import deque
# coding: UTF-8
#@document_it

def document_it(func):
    def new_function(*args,**kwargs):
        print('Running function:', func.__name__)
        print('Positional arguments:', args)
        print('Kewword arguments:', kwargs)
        result = func(*args,**kwargs)
        print('Result:', result)
        return result
    return new_function

def exe():
    n,y = map(int,input().split())
    p,q,r = solve(n,y)
    print(str(p)+" "+str(q)+" "+str(r))
    
def solve(n,y):
    ys = y//1000
    vstart = (0,0,ys)
    checked = set()
    depth = {}
    queue = deque()
    ###
    w = vstart
    depth[w] = 0
    if maisuu(w) == n:
        return w
    queue.appendleft(w)
    checked.add(w)
    while queue:
        v = queue.pop()
        neighbors = neighbor(v)
        for w in neighbors:
            if w in checked:
                continue
            if maisuu(w) == n:
                return w
            else:
                queue.appendleft(w)
                checked.add(w)
    return (-1,-1,-1)

def maisuu(v):
    p,q,r = v
    return p + q + r
def neighbor(v):
    p,q,r = v
    ans = []
    if r >= 5:
        ans.append((p,q+1,r-5))
    if r >= 10:
        ans.append((p+1,q,r-10))
    if q >= 2:
        ans.append((p+1,q-2,r))
    return ans

if __name__ == '__main__':
    exe()

これでもだめかーーーーーーー
でもACの個数が増えました！
満足したので先輩方の解説を読みに行ってきます。
。。。（読んでいる）。。。
枚数についての全探索をすればよかったのか！たしかに高々N^2通りしかないわけですね。
全探索から考えたのは良いものの、必要以上に頭の悪い全探索を考えてしまっていました。
明日からは枚数についての全探索を自分で書くところからはじめます。

...ということで再開しました。

otoshidama2.hs

import Control.Applicative
main :: IO()
main = do
    [n,y] <- map read . words <$> getLine
    putStrLn $ solve n y

solve :: Int -> Int -> String
solve n y = case solutions 
                of []  -> printdama faildama
                   (x:xs) -> printdama x
            where solutions = f n y

type Otoshidama = (Int,Int,Int)
printdama :: Otoshidama -> String
printdama (p,q,r) = unwords $ map show [p,q,r]

faildama = (-1,-1,-1) :: Otoshidama

f :: Int -> Int -> [Otoshidama]
f n y = [(p,q,n-p-q) | p <- [0..n], q <- [0..n], p+q <= n, 10*p + 5*q + (n-p-q) == y']
    where y' = div y 1000

これでようやくACです。 f n yのリスト内包表記のところはもっとうまく書くことができます。

#第9問 ABC049C - 白昼夢 / Daydream

難しくはない、とおもって次のコードを出したところTLE。

daydream.hs

import Control.Applicative
main = do
    s <- getLine
    putStrLn $ solve s

solve :: String -> String
solve s = if match s then "YES" else "NO"

match :: String -> Bool
match "" = True 
match str | dreamer str = or $ map match [drop 5 str, drop 7 str]
          | eraser str =  or $ map match [drop 5 str, drop 6 str]
          | dreamORerase str = match $ drop 5 str
          | otherwise = False

dreamer :: String -> Bool
dreamer s = if length s < 7 then False else (take 7 s) == "dreamer"

eraser :: String -> Bool
eraser s = if length s < 6 then False else (take 6 s) == "eraser"

dreamORerase :: String -> Bool
dreamORerase s = if length s < 5 then False else (take 5 s) `elem` ["dream","erase"]

...さすがにmatch関数のところが無駄に大きいリストを作っていてよくないのか？そういえばすごいH本によるとリストはモナドであって、非決定性の計算であるという文脈を持つのだと書いてあった。この問題もdreamとdreamer、eraseとeraserはどちらにもマッチするときがあるので、1単語マッチしたあと残る文字列はリストになる。

daydream2.hs

import Control.Applicative
main = do
    s <- getLine
    putStrLn $ solve s

solve :: String -> String
solve s = if f [s] then "YES" else "NO"

f :: [String] -> Bool
f list | list == [] = False
       | elem "" list = True
       | otherwise = f $ list >>= g

g :: String -> [String]
g s | s == "" = [""]
    | dreamer s = [drop 5 s, drop 7 s]
    | eraser s  = [drop 5 s, drop 6 s]
    | dreamORerase s = [drop 5 s]
    | otherwise = []


dreamer :: String -> Bool
dreamer s = if length s < 7 then False else (take 7 s) == "dreamer"

eraser :: String -> Bool
eraser s = if length s < 6 then False else (take 6 s) == "eraser"

dreamORerase :: String -> Bool
dreamORerase s = if length s < 5 then False else (take 5 s) `elem` ["dream","erase"]

match関数を消してfとgという関数を書いた。ちょっとHaskellらしくなったのではないでしょうか？？提出してみます。

...TLEでした。Haskellらしさが評価されるわけではないので仕方がないですね。ここらで素直に解説を読みに行くとしましょう。

これはすごい！感動しました。

• ひっくり返すと「dreamとdreamerどちらにもマッチしてしまう問題」が解消するのですね。非決定性をモナドとしてのリストで処理する！なんて力んでしまいましたが、非決定性をなくしてしまえば済むのでした。でも今は>>=を書くのが楽しい時期なので特に後悔はしていません。
• あと、複数文字列に対してマッチングしたいときは:を複数使えばパターンマッチで処理できることも気づいていませんでした。パターンマッチをするには値コンストラクタを使わないといけないから2文字以上だとどうすればいいのかわからずわざわざ関数を書いてしまいましたが、値コンストラクタを複数使えばよいのですね。

いったん休憩しまして続きはまた後程。

...さてしばらく別作業をしていて思ったのですが、上記2点のうちTLEになった原因がどちらかわからないので、文字をひっくり返すという操作はしないでパターンマッチだけ改良したものを試してみるべきだと思いました。そして次のコードを提出したところ、ACできました！

daydream3.hs

import Control.Applicative
main = do
    s <- getLine
    putStrLn $ solve s

solve :: String -> String
solve s = if f [s] then "YES" else "NO"

f :: [String] -> Bool
f list | list == [] = False
       | elem "" list = True
       | otherwise = f $ list >>= g

g :: String -> [String]
g ('d':'r':'e':'a':'m':'e':'r':xs) = [xs, 'e':'r':xs]
g ('e':'r':'a':'s':'e':'r':xs) = [xs] {-'r':xsも書こうとしていたけどどうせ次のマッチングに失敗するので省くことができる -}
g ('e':'r':'a':'s':'e':xs) = [xs]
g ('d':'r':'e':'a':'m':xs) = [xs]
g _ = []

#第10問 ABC086C - Traveling
いよいよ最終問！なのですが、この回のABCには参加していてこの問題は解いたことがあるのでした。でもその時はPythonで参加したのでHaskellでもやってみましょう。

traveling.hs

import Control.Applicative
main :: IO()
main = do
    n <- readLn
    list <- sequence $ replicate n ((\[x,y,z]->(x,y,z)) . map read . words <$> getLine)
    putStrLn $ if reachable list then "Yes" else "No"

reachable :: [(Int,Int,Int)] -> Bool
reachable list = and (map judgediff distances)
    where distances = zipWith calcdiff ((0,0,0):list) list

calcdiff :: (Int,Int,Int) -> (Int,Int,Int) -> (Int,Int,Int)
calcdiff (t1,x1,y1) (t2,x2,y2) = (t2-t1,x2-x1,y2-y1)

judgediff :: (Int,Int,Int) -> Bool
judgediff (dt,dx,dy) = distance <= dt && mod (dt-distance) 2 == 0
    where distance = abs dx + abs dy

一通り自分で書いてみたので、これからほかの方の解説を読んだりコードを読んだりしていきたいと思います！（おわり）