【paizaラーニング・レベルアップ問題集】DPメニューをHaskellで解いてみた

前置き

解いてみました。

paizaラーニング『レベルアップ問題集』についてはコードの公開などが自由らしく、折角だということで自分自身のメモも兼ねてひとつ記事として書くことにしました。

なお、このコーナー内の問題については、ユーザー同士で解答を教え合ったり、コードを公開したりするのは自由としています。

paizaラーニング・レベルアップ問題集 DPメニュー

• とてもいい感じです
• 基礎のキを学べる
  • 問題文中にヒントとして解く手順を表す図や擬似コードもある
• DPは様々な要素が複合しているので丁寧に見ると言語機能についての理解が深められる

この記事について

• 問題・アルゴリズムについての解説ではない
• 各問題群について全問の解答を載せるわけではなく適当なものをピックアップする
• 可能な限りリストを利用する
  • 競プロでバトるときには Unboxed な Data.Vector、Data.Array などを使う方が良いと思います。良いことしかないです。
  • 入力も特に拘泥していないのでそこで遅くなっていることもあるかもしれません。競プロ以下略ならば Data.ByteString や Data.Text を利用する方がお得です。

本題

自分の解答に至るまでのプロセスを適当に追いつつそのコードを示します。

【漸化式】特殊な2項間漸化式 1

問われている数列を実際に書き下してみると実装すべきものがわかります。少し工夫して横に倒したものを書いてみます。

\begin{array}{ccccccc}
a_1 & a_2 & a_3 & a_4 & a_5 & a_6 & \cdots \\
\parallel & \parallel & \parallel & \parallel & \parallel & \parallel & \cdots \\
x   & a_1 & a_2 & a_3 & a_4 & a_5 & \cdots \\
    &  +  &  +  &  +  &  +  &  +  & \cdots \\
    & d_2 & d_1 & d_2 & d_1 & d_2 & \cdots
\end{array}

以上から、求める数列は初めの要素が x すなわち

a = x : ???

の形をしていることがわかり、それ以降の要素に関しては a 自身と [d2, d1] を繰り返したものの和をとっていけば良いことがわかります。

zipWith (+) a (cycle [d2, d1])

ここまで来るともう解答です。

Main.hs

generate :: (Int, Int, Int) -> [Int]
generate (x, d1, d2) = a where
  a = x : zipWith (+) (cycle [d2, d1]) a

main :: IO ()
main = do
  [x, d1, d2, k] <- map read . words <$> getLine
  print $ generate (x, d1, d2) !! (k - 1)

いわゆる遅延評価ってものでしょうか。フィボナッチ数列の例があまりにも有名ですが、要素の評価が後回しになってくれるおかげでこのように簡潔な記述ができるようです。

fib.hs

-- fibonacci
fib = 1 : 1 : zipWith (+) fib (tail fib)

【階段の上り方】階段の上り方 2

この前問に擬似コードがあります。

dp[i] = dp[i-a] + dp[i-b] をして欲しいのでしょう。とりあえず関係しそうな要素の位置関係を考えてみます。

\begin{array}{cccccc}
dp_0 & \cdots & & & dp_i & \cdots \\
dp_0 & \cdots & & dp_{i-a} & \cdots & \\
dp_0 & \cdots & dp_{i-b} & \cdots & &\\
\end{array}

特に何もわかりませんね。わかりやすくするために足す箇所を縦に並べます。

\begin{array}{cccccccc}
(dp_0 = 1) & \cdots & & & dp_{i-1} & dp_i & dp_{i+1} & \cdots \\
 & & & & \parallel & \parallel & \parallel & \cdots \\
 & dp_0 & \cdots & & dp_{i-a-1} & dp_{i-a} & dp_{i-a+1} & \cdots \\
 & & & & + & + & + & \cdots \\
 & & dp_0 & \cdots & dp_{i-b-1} & dp_{i-b} & dp_{i-b+1} & \cdots \\
\end{array}

これで直感的に分かるかは人によると思いますが、位置関係はわかりやすくなりました。

dp[0] は 1 であることがわかっているため、形は次のようになるはずです。

dp = 1 : ???

dp を「右に a-1 個ずらした数列」と「右に b-1 個ずらした配列」の和をとっていけばよさそうです。

dp = 1 : zipWith (+) (unshift (a - 1) dp) (unshift (b - 1) dp)

ここで「右にずらす」ためには先頭にいくつかの要素を置くことが必要であって、この場合は「足し算の結果が変わらない」ものを採用すれば良いでしょう。
つまり、先ほどの unshift は次のように定義できそうです。

unshift n l = replicate n 0 ++ l

道具が揃ったので解答を書くことができました。

Main.hs

step :: Int -> Int -> [Int]
step a b = l where
  l = 1 : zipWith (+) v u
  v = replicate (a - 1) 0 ++ l
  u = replicate (b - 1) 0 ++ l

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

【最安値】最安値を達成するには 3

この前々問に漸化式があります。

x 個が a 円、y 個が b 円ということですが、この問題も先に挙げた問題とほとんど同様の図になります。+ が min に変わっただけというところです。

\begin{array}{cccccccc}
(dp_0 = 0) & \cdots & & & dp_{i-1} & dp_i & dp_{i+1} & \cdots \\
 & & & & \parallel & \parallel & \parallel & \cdots \\
 & & & & min & min & min & \cdots \\
 & dp_0 & \cdots & & dp_{i-x-1}+a & dp_{i-x}+a & dp_{i-x+1}+a & \cdots \\
 & & dp_0 & \cdots & dp_{i-y-1}+b & dp_{i-y}+b & dp_{i-y+1}+b & \cdots \\
\end{array}

先頭の要素は 0、min の結果が変わらないものとして $\infty$ を採用します。あとは先の問題と同様です。

Main.hs

inf :: Int
inf = 10^9

apples :: (Int, Int) -> (Int, Int) -> [Int]
apples (x, a) (y, b) = l where
  l = 0 : zipWith min v u
  v = replicate (x - 1) inf ++ map (+ a) l
  u = replicate (y - 1) inf ++ map (+ b) l

main :: IO ()
main = do
  [n, x, a, y, b] <- map read . words <$> getLine
  print $ minimum (take y . drop n $ apples (x, a) (y, b))

【連続列】最長増加連続部分列

隣接している 2 つを取ってくる場合は、フィボナッチ数列の例で見たように a (tail a) を zip なりすると良いと思います。

今回は隣接する 2 つの大小によって持ち回っている数値を + 1 するか const 1 するかを切り替え、途中経過が残る foldl のような scanl で目標を達成していけば良さそうです。

f p q = if p <= q then (+ 1) else const 1
funcs = zipWith f a (tail a)

flip ($) でなくて Data.Function の & でもいいのですが、import に一行使って数文字節約というのも変な話なのでそのまま突貫です。

Main.hs

lisc :: [Int] -> [Int]
lisc a = scanl (flip ($)) 1 (zipWith f a (tail a))
  where f p q = if p <= q then (+ 1) else const 1

main :: IO ()
main = do
  (_ : a) <- map read . words <$> getContents
  print $ maximum (lisc a)

【部分列】最長増加部分列

Data.List.inits というリストの先頭を含む連続部分リスト（？）を小さい順に全て返す関数を利用しているのですが、これはいつもの遅延評価か何かで先頭が必ず [] となります。

実際に手元の ghci なり何なりで次を試すと「引数を評価する前に必ず返るものがあるんだなあ」とわかります。

head $ inits undefined -- []

次のようなものも作れてしまいます。

l = map length (inits l) -- [0, 1, 2, 3, 4, ...

このリストができていく流れとしては、

l = map length (inits l)
  = map length ([] : ???)
  = 0 : map length (???)
  = 0 : map length ([0] : ???')
  = 0 : 1 : map length (???')
  = 0 : 1 : map length ([0, 1] : ???'')
  = ...

というような雰囲気だと思います。

計算量には気をつけないといけませんが、リストを作っていく中で自分自身を見る（？）ことができそうです。

実装なのですが、問題文中にヒントとして示されている擬似コードを落とし込んだものです。

inits dp で作成中のリスト全体が取れるということで、zipWith f (inits dp) a では

• 作成中のリストを持ちながら a の各要素を参照していく
• a のある要素と作成中のリストから作られる新しい要素をリストの末尾に追加する

ということができています。

Main.hs

import           Data.Function ((&))
import           Data.List     (inits)

lis :: [Int] -> [Int]
lis a = dp where
  dp = zipWith f (inits dp) a
  f l e = maximum (1 : v l e)
  v l e = l `zip` a & filter ((< e) . snd) & map (succ . fst)

main :: IO ()
main = do
  (_ : a) <- map read . words <$> getContents
  print $ maximum (lis a)

今回の問題の「最大値を取る」というような線形の操作の類であれば Data.Vector を利用せずとも話ができそうです。流石に盛ってますけど。
Data.List.inits が利用できると思いついたときはしばらく感動していましたが、こういうものって結構定石だったりしそうですよね。

##【部分和】部分和問題 2

典型題という雰囲気がする問題です。

Main.hs

choices :: Int -> [Int] -> [Int]
choices x = foldl gen (1 : replicate x 0)
  where gen l e = zipWith (+++) l (replicate e 0 ++ l)
        a +++ b = (a + b) `mod` (10^9 + 7)

main :: IO ()
main = do
  (_ : x : a) <- map read . words <$> getContents
  print $ last (choices x a)

忘れないためのメモというつもりでこれを書いていましたが、この問題に関してはよく覚えていません。
どうやら記憶力との勝負に負けてしまったようです。記憶力の方が負けてるのかもしれません。

まとめ

良い問題集でした。
遅延評価も良いものでした。