Edited at

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

More than 1 year has passed since last update.


はじめに

2018年の1月からAtCoderを始めました。

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


参考にする記事


方針

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

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


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