Zenn
📶

Levelsモナドを使った幅優先探索の仕組み

2021/09/03に公開
1件
Haskell
algorithm
tech

Haskellは関数型プログラミング言語と呼ばれますが、関数だけでなく型も重要な役割を担っています。アルゴリズムを考える時、手続きの最適化だけでなく、正しいデータ型を選択することがシンプルなアルゴリズムを導き、実装をコンパクトにできるというのはよくある話です。今回は非常に単純な型でありながら幅優先探索というアルゴリズムのエッセンスを詰め込んだ Levelsというデータ型 について紹介したいと思います。

ピタゴラス数を列挙する

ピタゴラス数とはピタゴラスの定理における関係式

a^2 + b^2 = c^2

を満たす自然数の三つ組です。

Haskellのリストは遅延評価なので

  1. 全ての自然数の三つ組を列挙する
  2. 列挙した自然数の中から関係式を満たすものだけ抽出する

という手順でピタゴラス数を列挙することを考えてみましょう。

実際この方法は有限な探索範囲ではうまく機能します。

pyth :: [(Integer, Integer, Integer)]
pyth = do
   a <- [1..10]
   b <- [1..10]
   c <- [1..10]
   guard $ a^2 + b^2 == c^2
   pure (a, b, c)

> pyth
[(3,4,5),(4,3,5),(6,8,10),(8,6,10)]

しかし上限の10を取り払い、全ての自然数（無限リスト）に対して同様の処理を行うとどうなるでしょうか。

pyth :: [(Integer, Integer, Integer)]
pyth = do
   a <- [1..]
   b <- [1..]
   c <- [1..]
   guard $ a^2 + b^2 == c^2
   pure (a, b, c)

> pyth

今度は何も結果が返ってこなくなり、延々と計算が続いている状態になりました。

なぜこのような動作になるのかはリストモナドの挙動を考えると分かります。試しに以下のように自然数の二つ組を列挙する単純なプログラムを考えてみましょう。

> mapM_ print $ do
|   x <- [1..3]
|   y <- [1..3]
|   pure (x, y)
(1,1)
(1,2)
(1,3)
(2,1)
(2,2)
(2,3)
(3,1)
(3,2)
(3,3)

このようにリストモナドは列挙するリストがネストしてる場合、最も内側のリストを全て列挙してから一つ外側のリストを列挙するという挙動になります。他の言語におけるfor文と同じ挙動で、ある意味深さ優先探索を行ってると言えるでしょう。

先程の無限リストを使ったピタゴラス数を列挙する例の場合、a=1, b=1のまま延々とcを無限まで列挙し続けていったのでピタゴラス数も見つからずに計算が止まらない状態になっていたのです[1]。

Levels

上記の問題を解決する一つの方法としてLevelsモナドを使うというものがあります。リストは単純に値が列挙されているデータ構造でしたがLevelsは列挙された値がさらにレベルごとにグループ分けされているデータ構造になっています。これを単純に二重リストで表現してみましょう。

newtype Levels a = Levels [[a]]

この値は以下のようなイメージになります。

これからこのLevelsに対してFunctor, Applicative, Monadのインスタンスを定義していくのですが、その前にピタゴラス数を列挙するプログラムが実際にどのように改善されるのか先に見ておきましょう。
（この記事では自然数は正の整数としますが、悪しからず）

nats :: Levels Integer
nats = Levels [[n] | n <- [1..]]

pyth :: Levels (Integer, Integer, Integer)
pyth = do
  a <- nats
  b <- nats
  c <- nats
  guard $ a^2 + b^2 == c^2
  pure (a, b, c)

> mapM_ print pyth
(3,4,5)
(4,3,5)
(6,8,10)
(8,6,10)
(5,12,13)
(12,5,13)
(9,12,15)
(12,9,15)
(8,15,17)
(15,8,17)
...

期待通りにピタゴラス数が小さいものから順に出力されていっていますね！

からくりは先程と同じように自然数の二つ組を列挙するプログラムを考えてみると分かります。

> mapM_ print $ do
|   x <- Levels [[1],[2],[3]]
|   y <- Levels [[1],[2],[3]]
|   pure (x, y)
(1,1)
(1,2)
(2,1)
(1,3)
(2,2)
(3,1)
(2,3)
(3,2)
(3,3)

先程とは違って単純に内側のLevelsの値が先に全て列挙されるというわけではなく、不思議な順番でならんでいますね。この順番は以下のような行列に並べて図示してみると分かりやすいでしょう。

リストモナドの場合は以下のように各行を順番に列挙していくというものでした。

一方でLevelsモナドは対角線方向に直交する斜線沿いの値を列挙していく挙動になっています。リストモナドの実装が深さ優先探索と思えるのに対し、こちらは幅優先探索のような挙動になっています。

この斜線は各Levelsのレベルの和が等しい順に並んでいます。

実際この順番は以下のような多項式の計算に対応していると考えられます。

\begin{matrix} &&(1+2x+3x^2)\times(1+2x+3x^2) \\ \\ &=&\begin{matrix} &&(1\times 1) &+& (1\times 2)x &+& (1\times 3)x^2 \\ &+& (2\times 1)x &+& (2\times 2)x^2 &+& (2\times 3)x^3 \\ &+& (3\times 1)x^2 &+& (3\times 2)x^3 &+& (3\times 3)x^4 \\ \end{matrix} \end{matrix}

この多項式における xの指数がレベルに対応している のです。

Functor, Applicative, (Alternative), Monad

それでは実際にLevelsの各型クラスのインスタンスの実装を見てみましょう。

まずはFunctorとFoldableのインスタンスです（FoldableはmapM_を使用するために必要）。

instance Functor Levels where
  fmap f (Levels xss) = Levels (map (map f) xss)

instance Foldable Levels where
  foldMap f (Levels xss) = mconcat $ map (mconcat . map f) xss

いずれも二重リストに対する標準的な実装になっています。

次にApplicativeとAlternativeの実装を見てみましょう。この2つの型クラスのメソッドである<|>と<*>は、先程のように多項式と考えた時の足し算と掛け算に関連しています。

instance Applicative Levels where
  pure x = Levels [[x]]
  (Levels []) <*> _ = Levels []
  (Levels (fs:fss)) <*> (Levels xss) = Levels (map (fs <*>) xss) <|>  wrap (Levels fss <*> Levels xss)

instance Alternative Levels where
  empty = Levels []
  (Levels xss) <|> (Levels yss) = Levels (zipL xss yss)

wrap :: Levels a -> Levels a
wrap (Levels xs) = Levels ([] : xs)

zipL :: [[a]] -> [[a]] -> [[a]]
zipL     []      yss   = yss
zipL     xss      []   = xss
zipL (xs:xss) (ys:yss) = (xs ++ ys) : zipL xss yss

まず先にApplicativeではなくAlternativeの実装から見てみましょう。重要なのは<|>で、実装はzipLが中心的な役割を担っています。zipLは2つのLevelsを取り、同じレベルのリストを結合するという関数です。つまり<|>は同じレベルの要素をマージしていくような挙動になっている わけです（ここでzipLの実装に++が使われていますが、<|>は左結合なので実際のプログラムではこの部分が非効率的になってきます。これを改善するためにLevelsの定義における内側のリストを差分リストに置き換えるとより効率的でしょう）。

次にApplicativeの実装を見てみましょう。重要なのは<*>の実装です。まず片方がLevels []の場合は結果もLevels []となります（0\times x = 0）。それ以外の場合は足し算と掛け算の分配法則を思い出すと分かりやすいでしょう。wrapは内側のリストの先頭に空リストを付け加えるという実装になっており、これは与えられたLevelsの中の要素のレベルを全て1上げると考えることができます。fssは先頭の要素がパターンマッチで取り除かれレベルが1つ下がっていしまっているので wrapを使って元のレベルの水準に戻している というわけです。

最後に Monad の実装を見てみましょう。

choices :: Alternative f => (a -> f b) -> [a] -> f b
choices f []     = empty
choices f (x:xs) = f x <|> choices f xs

instance Monad Levels where
  (Levels      [])  >>= k = empty
  (Levels (xs:xss)) >>= k = choices k xs <|> wrap (Levels xss >>= k)

>>= の実装で重要な役割を果たすのはchoicesです。>>=は1つ目の引数の先頭の要素と後続計算のkをchoicesに適用し、再帰的に残りを計算したものをwrapして足し算<|>する形の実装になっています。choicesは計算結果としてAlternativeを返す関数をリストに適用し<|>で結合した値を返す関数です。

自然数を列挙する関数の実装

以上の実装を元に自然数の二つ組を列挙する関数の実装を展開してみましょう。

do
  x <- Levels [[1],[2],[3]]
  y <- Levels [[1],[2],[3]]
  pure (x, y)

まずdo構文の糖衣構文を剥がすと、

Levels [[1],[2],[3]] >>= (\x -> Levels [[1],[2],[3]] >>= (\y -> pure (x, y)))

となります。最初に内側の>>=を展開してみましょう。

Levels [[1],[2],[3]] >>= (\x ->  choices (\y -> pure (x, y)) [1] <|> wrap (List [[2], [3]] >>= (\y -> pure (x, y))))

出てきたchoicesの項とpureを評価すると

Levels [[1],[2],[3]] >>= (\x -> Levels [[(x, 1)]] <|> wrap (List [[2], [3]] >>= (\y -> pure (x, y))))

となります。同様に内側に出てきた>>=を展開してchoicesとpureの評価を繰り返すと、

Levels [[1],[2],[3]] >>= (\x -> Levels [[(x, 1)]] <|> wrap (Levels [[(x, 2)]] <|> wrap (Levels [[(x, 3)]])))

となります。

wrap は wrap (x <|> y) == wrap x <|> wrap y という関係式を満たすので

Levels [[1],[2],[3]] >>= (\x -> Levels [[(x, 1)]] <|> wrap (Levels [[(x, 2)]]) <|> wrap (wrap (Levels [[(x, 3)]])))

と変形できます。wrapはレベルと1つ上げる関数だったので評価すると

Levels [[1],[2],[3]] >>= (\x -> Levels [[(x, 1)]] <|> Levels [[], [(x, 2)]] <|> Levels [[], [], [(x, 3)]])

のようになります。<|>は対応するレベルのリストを結合する関数なので、

Levels [[1],[2],[3]] >>= (\x -> Levels [[(x, 1)], [(x, 2)], [(x, 3)]]))

となり内側の>>=の評価が完了しました。

残った外側の>>=を評価していきましょう。

choices (\x -> Levels [[(x, 1)], [(x, 2)], [(x, 3)]]) [1] <|> wrap Levels [[2],[3]] >>= (\x -> Levels [[(x, 1)], [(x, 2)], [(x, 3)]]))

これは>>=の展開とchoicesの評価を繰り返すと

Levels [[(1, 1)], [(1, 2)], [(1, 3)]] <|> wrap (Levels [[(2, 1)], [(2, 2)], [(2, 3)]] <|> wrap (Levels [[(3, 1)], [(3, 2)], [(3, 3)]]))

となります。wrapと<|>の関係式を使うと、

Levels [[(1, 1)], [(1, 2)], [(1, 3)]] <|> wrap (Levels [[(2, 1)], [(2, 2)], [(2, 3)]]) <|> wrap (wrap (Levels [[(3, 1)], [(3, 2)], [(3, 3)]]))

となります。wrapを評価すると

Levels [[(1, 1)], [(1, 2)], [(1, 3)]] <|> Levels [[], [(2, 1)], [(2, 2)], [(2, 3)]] <|> Levels [[], [], [(3, 1)], [(3, 2)], [(3, 3)]]

となり、<|>を評価して同じレベルのリストを結合すると

Levels [[(1, 1)], [(2, 1), (1, 2)], [(2, 2), (3, 1), (1, 3)], [(2, 3), (3, 2)], [(3, 3)]])

となり評価が完了します。

結果を見ると単なる二つ組のリストが出力されるわけではありません。mapM_ printで出力する際はFoldableの性質を利用して単純にconcatしたものが順番に出力されていましたが、実際はレベルの情報も含めて計算されていることが分かります。

幅優先探索

Levelsモナドの合成の走査順序が幅優先探索と思えるという話をしましたが、実際に幅優先探索をLevelsを使って非常に簡単に実装することができます。

まずは木構造とリストを使った深さ優先探索の実装を見てみましょう。

data Tree = Node a [Tree a]

dfe :: Tree a -> [a]
dfe (Node x xs) = [x] ++ choices dfe xs

木構造にはノードに値を持ち任意の枝を持つことができるRose Treeを採用しています。dfeはdepth-first enumerationの略で深さ優先で値を列挙する関数です。この関数は値を列挙するだけですが、遅延評価のおかげでリストから条件に合致する最初の要素を見つける関数を後から合成すれば深さ優先探索を行う関数が手に入ります。リストのAlternativeではemptyは空リスト、<|>は++になっているのでdfeはデータ構造が走査される順番、すなわち深さ優先で走査が行われることになります。

実際にdfeを実行してみましょう。

> tree = Node 1 [ Node 2 [Node 5 [] ]
|               , Node 3 [Node 6 [] ]
|               , Node 4 []
|               ]

> dfe tree
[1,2,5,3,6,4]

期待通り深さ優先で値が列挙されていますね！

今度はLevelsを使った幅優先探索の実装を見てみましょう。

bfe :: Tree a -> Levels a
bfe (Node x xs) = pure x <|> wrap (choices bfe xs)

bfe(breadth-first enumeration)の実装もdfeとほとんど同じような形です。

これを実行してみると、

> bfe tree
Levels [[1],[2,3,4],[5,6]]

となり期待通りに幅優先で走査されていることが分かります。

それではこの幅優先の走査がどのように行われているのか展開して確認してみましょう。

bfe $ Node 1 [Node 2 [Node 5 []], Node 3 [Node 6 []], Node 4 []]

まずはbfeの定義より

pure 1 <|> wrap (choices bfe [Node 2 [Node 5 []], Node 3 [Node 6 []], Node 4 []])

となります。choicesを評価すると

pure 1 <|> wrap (bfe (Node 2 [Node 5 []]) <|> bfe (Node 3 [Node 6 []]) <|> bfe (Node 4 []))

と展開できます。更に内側のbfeを全て評価すると

pure 1 <|> wrap ((pure 2 <|> wrap (pure 5)) <|> (pure 3 <|> wrap (pure 6)) <|> pure 4)

となり、wrapと<|>の関係式から

pure 1 <|> wrap (pure 2) <|> wrap (wrap (pure 5)) <|> wrap (pure 3) <|> wrap (wrap (pure 6)) <|> wrap (pure 4)

となります。pureとwrapを評価してみましょう。

Levels [[1]] <|> Levels [[], [2]] <|> Levels [[], [], [5]] <|> Levels [[], [3]] <|> Levels [[], [], [6]] <|> Levels [[], [4]]

ここまでくれば何が行われているのか良く理解できると思います。木の深さはLevelsのレベルとして表現されているわけですね。

最後に <|> を評価すると

Levels [[1],[2,3,4],[5,6]]

となり期待通り幅優先で値が列挙されていることが分かりました。

あとがき

通常、幅優先探索を実装するためにはキューを使用する必要があり、手続き的な処理が多くなってしまうので簡潔に実装するのは難しい印象がありました。なので、キューが担ってた役割をデータ構造の自然な性質としてうまく表現できるLevelsというデータ型を使えば幅優先探索を簡潔に実装することができると知ってとても感動し、自分の言葉でまとめておこうと思いこの記事を書きました。

この話を知ったのは関数型プログラミングの国際学会であるICFP2021 / Accepted Papersの内の一つである"Algebras for Weighted Search"の前半の前半で、この記事の内容も大いに参考にして書かれています。この論文ではこの後、Levelsの多項式のイメージをFree Applicativeを使って一般化し、幅優先で探索するTraversableを実装しています。さらにCayley表現を使った効率化やLevelsのモナドトランスフォーマー版であるLevelsTの実装とhyperfunctionsを使った効率化、探索コストの代数構造を使って一般化したダイクストラ法を包含する探索アルゴリズムなど面白い話が続いているので気になった人は是非見てみてください！学会での動画も公開されています。

https://www.youtube.com/watch?v=n6oS6X-DOlg

＼読んでいただきありがとうございました！／
この記事が面白かったら いいね♡ をいただけると嬉しいです☺️
バッジを贈っていただければ次の記事を書くため励みになります🙌

脚注

  1. 余談ですがリストモナドを使った場合でも探索範囲を工夫することでピタゴラス数の無限リストを作成することは可能です。例えば do {c <- [1..], a <- [1..c], b <- [a..c]} のように互いの値に依存して探索範囲を広げていけば良いでしょう。 ↩︎

Discussion