リストは非決定性のモナド

Haskell のリストはモナドであり、それは非決定性の文脈を表すと言われます。しかし、そのことを扱った例題は少なくて、しかもイマイチでした。そこで、Scheme で書かれたよい例題を Haskell で書き直してみました。

「On Lisp」の「非決定性」の章では、謎めいた関数 choose と fail が出てきます。こんな難しい話をしなくても、Haskell では単に全探索することで非決定性を実現できます。なぜなら、Haskell の評価戦略は遅延評価なので、答えの先頭しか要求しなければ、残りの答えは探さないからです。

というわけで、Haskell で非決定性の問題を解くことは、リストを使って普通にプログラミングすることとなんら変わりません。

三平方の定理

「もうひとつの Scheme 入門」に載っている三平方の定理に関する問題を解いてみましょう。

x = [1,2,3,4,5], y = [3,4,5,6,7], z = [4,5,6,8,9] のとき、x^2+y^2=z^2 を満たす整数の組 (x,y,z) を求めなさい。

リスト内包表記を使えば、簡単ですね。

[(x,y,z)| x <- [1,2,3,4,5], 
          y <- [3,4,5,6,7], 
          z <- [4,5,6,8,9],
          x^2 + y^2 == z^2]
→ [(3,4,5),(4,3,5)]

経路探索

次に、「お気楽 Scheme プログラミング入門」に載っている経路探索の問題を解いてみます。

以下のネットワークにおいて、A から F への経路を見つけなさい。

A -- B -- D
  \  |    | \
   \ |    |  \
     C -- E -- F

実装を最後に示します。経路探索をする関数が pathFind で、ネットワークの情報、ゴール、そして現時点での経路を代入すると、ゴールに至るまでのすべての経路を探します。

pathFind network F (S.singleton A)
→ [fromList [A,B,C,E,D,F],fromList [A,B,C,E,F],fromList [A,B,D,E,F],fromList [A,B,D,F],fromList [A,C,B,D,E,F],fromList [A,C,B,D,F],fromList [A,C,E,D,F],fromList [A,C,E,F]]

pathFind は、リストに対して do を用いています。ここが非決定性を実現する核心です。

以下のコードでは、本当にリストである必要がある部分にだけリストを用いています。型をよく見て下さいね。

import Control.Monad
import Data.Maybe
import qualified Data.Map as M
import qualified Data.Sequence as S

data Node = A | B | C | D | E | F deriving (Eq, Ord, Show)

type Network = M.Map Node [Node]

network :: Network
network = M.fromList [
    (A, [B, C])
  , (B, [A, C, D])
  , (C, [A, B, E])
  , (D, [B, E, F])
  , (E, [C, D, F])
  , (F, [E])
  ]

neighbors :: Node -> Network -> [Node]
neighbors n g = fromJust $ M.lookup n g

noLoop :: Node -> S.Seq Node -> Bool
noLoop x sq = isNothing $ S.elemIndexL x sq

addTo :: Node -> S.Seq Node -> S.Seq Node
addTo = flip (S.|>)

currentNode :: S.Seq Node -> Node
currentNode path = case S.viewr path of
    _ S.:> x -> x
    _        -> error "currentNode"

pathFind :: Network -> Node -> S.Seq Node -> [S.Seq Node]
pathFind net goal path = do
    x <- neighbors (currentNode path) net
    guard $ noLoop x path
    let path' = x `addTo` path
    if x == goal
        then return path'
        else pathFind net goal path'