Haskellで幅優先探索

Haskellで幅優先探索をしようとして、キューをどうするか困ったことはないでしょうか？

まず思いつくだろうことは、Data.Sequence.Seqをキューとして使って、キューSeq nodeを状態として持ち回れば、手続き型言語で普段書いていたような幅優先探索が書ける、ということでしょう。

もちろん、Mutableな配列をキューにしてもできます。IOやSTを探索以外に使わなければならない事情があればいい選択肢です。

しかし、キューを明示的に使わなくてもできる方法がいくつかあります。それぞれ面白みがあるので紹介していきます。

例題：コインで支払い

次の例題を考えます。

この国では、金貨1枚は銀貨3枚に、プラチナ貨1枚は銀貨7枚に、ダイヤモンド貨1枚は銀貨19枚に相当します。銀貨100枚の価値がある商品を、なるべく少ない枚数の銀貨以外のコインで買う方法を見つけなさい。

（DPのほうが簡単というのは置いておいて、）この問題は、合計金額をノード、コイン1枚追加を辺とした有向非巡回グラフを考えて、合計金額100のノードまでのパスを幅優先探索で見つければいいですね。

この問題はHaskellで次のように書けます。

type Coin  = Int
type Value = Int

type Graph label node = node -> [(label, node)]

addCoin :: Graph Coin Value
addCoin !n = [ (c,n+c) | c <- [3,7,19], n+c <= 100 ]

キュー(ここでは`Seq`)を使う

import Data.Foldable
import Data.Monoid (First(..))
import qualified Data.Sequence as S
import Data.Sequence (Seq(Empty, (:<|), (:|>)))

type Tree node = node -> [node]

bfSeq :: Tree node -> node -> [node]
bfSeq step root = loop (S.singleton root)
  where
    loop Empty     = []
    loop (n :<| q) = n : loop (foldl' (:|>) q (step n))

graphToPaths :: Graph label node -> Tree ([label], node)
graphToPaths graph (path, node)
  = [ (l : path, node') | (l, node') <- graph node ]

addCoin' :: Tree ([Coin], Value)
addCoin' = graphToPaths addCoin

firstJust :: Foldable t => (a -> Maybe b) -> t a -> Maybe b
firstJust f = getFirst . foldMap (First . f)

addCoin' :: Tree ([Coin], Value)
addCoin' = graphToPaths addCoin

solvePuzzleSeq :: Maybe [Coin]
solvePuzzleSeq = firstJust f $ bfSeq addCoin' ([], 0)
  where f (path, 100) = Just (reverse path)
        f _           = Nothing

余再帰を使う

元ネタ

bfList :: Tree node -> node -> [node]
bfList step root =
    let ans = root : go 1 ans
     in ans
  where
    go n _ | n <= 0 = []
    go n (x:xs) = 
      let children = step x
      in children ++ go (n - 1 + length children) xs
    go _ [] = error "Never reach here"

solvePuzzleList :: Maybe [Coin]
solvePuzzleList = firstJust f $ bfList addCoin' ([], 0)
  where f (path, 100) = Just (reverse path)
        f _           = Nothing

ans = root : go 1 ansのように再帰的に構築されたリストが、まるでキューのように扱えます。

遅延データ構造を使う

次のLazy型を考えます。Lazy aは、a型の値が

計算できなかった … Fail
計算終了した … Ok a
計算中である … Next x

という3つの状態を表します。forceLazyは、これを単なる失敗または成功としてMaybe aに単純化します。

data Lazy a = Fail | Ok a | Next (Lazy a)
  deriving (Functor, Foldable, Traversable)

forceLazy :: Lazy a -> Maybe a
forceLazy Fail     = Nothing
forceLazy (Ok a)   = Just a
forceLazy (Next x) = forceLazy x

ApplicativeとMonadのインスタンスが次のように定義できます。

instance Applicative Lazy where
  pure = Ok
  (<*>) = ap

instance Monad Lazy where
  return = pure
  Fail   >>= _ = Fail
  Ok a   >>= k = k a
  Next x >>= k = Next (x >>= k)

さらに、“2つのLazy aのうち先に完了したほうを返す”を(<|>)として、 Alternativeにもなります。

instance Alternative Lazy where
  empty = Fail
  Fail   <|> y      = y
  Ok a   <|> _      = Ok a
  x      <|> Fail   = x
  _      <|> Ok a   = Ok a
  Next x <|> Next y = Next (x <|> y)

これを使って、BFSのようなものが実装できます。

bfSearchLazy :: Tree node -> node -> (node -> Lazy a) -> Lazy a
bfSearchLazy step root goal = go root
  where
    go x = goal x <|> Next (asum $ fmap go (step x))

solvePuzzleLazy :: Maybe [Coin]
solvePuzzleLazy = forceLazy $ bfSearchLazy addCoin' ([], 0) f
  where f (path, 100) = Ok (reverse path)
        f _           = Fail

bfSearchLazyは、「木の全ノードxに対して、ルートからの距離に応じたステップ数後にgoal xを評価する計算をさせ、一番先に完了した計算を採用する」と解釈できます。遅延評価のおかげで、これは幅優先探索と同じ深さまでしか木をたどりませんし、木が無限の深さであっても大丈夫です。

幅優先探索

Haskellで幅優先探索

例題：コインで支払い

キュー(ここではSeq)を使う

余再帰を使う

遅延データ構造を使う

キュー(ここでは`Seq`)を使う