川渡りパズル
川渡りパズルの Haskell による解き方は、Haskell のパターンプログラミングのいい例ではないかと思う。
川渡りパズルというのは、川岸に農夫が狐と鵞鳥と豆袋を小舟を使って向こう岸に渡るにはどうすればいいかという問題だ。ただし、小舟には漁師以外にそれらのうちの一つしか乗せられない。また、狐と鵞鳥だけを残して農夫が向こう岸へ渡ってしまうと狐は鵞鳥を食べてしまう。また、鵞鳥と豆袋を残して農夫が向こう岸へ渡ってしまうと鵞鳥が豆を食べてしまう。
狐に鵞鳥を食べさせないように、また、鵞鳥に豆を食べさせないように狐と鵞鳥と豆袋を向こう岸へ渡らせるにはどうしたらよいだろうか。
このパズルは Haskell のプログラムで解くことができる。プログラムは farmer.hs というファイルに作成した。
ファイル名：farmer.hs
module Main where
import Data.List
data Member = Fox | Goose | Beans deriving (Show, Eq, Ord) beginState :: State goal :: State -> Bool forbidden :: [Member] -> Bool available :: State -> Bool updateLeft :: State -> [State] updateRight :: State -> [State] findNext :: State -> [State] search :: State -> [State] -> [[State]] main :: IO () 実行例は次のようになる。
Prelude> :l farmer.hs State {left = [Fox,Goose,Beans], right = [], farmer = LeftSide} 面倒くさそうなプログラムの様に見えるがそうではない。ひとつづつ追いかけてみよう。対訳風にコメントをつけてみる。
data Member = Fox | Goose | Beans deriving (Show, Eq, Ord) data Farmer = LeftSide | RightSide deriving (Show, Eq) data State = State {left :: [Member], right :: [Member], farmer :: Farmer} deriving (Show, Eq) beginState = State [Fox, Goose, Beans] [] LeftSide goal s = left s == [] forbidden xs = (elem Fox xs && elem Goose xs) || (elem Goose xs && elem Beans xs) available s = (farmer s == LeftSide && (not $ forbidden $ right s)) || (farmer s == RightSide && (not $ forbidden $ left s))
利用可能な状態とは、農夫が左岸にいて右岸のメンバーが禁止された状態ではないか、または、農夫が右岸にいて左岸のメンバーが禁止された状態ではない場合である。
updateLeft s = filter available $ [State (delete x $ left s) (sort $ x:right s) RightSide | x <- left s] ++ [State (left s) (right s) RightSide] updateRight s = filter available $ [State (sort $ x:left s) (delete x $ right s) LeftSide | x <- right s] ++ [State (left s) (right s) LeftSide] findNext s search s path goal s は search s path の base case で State の left == [] のときの base case だ。
[x | x <- findNext s, (not $ elem x path)] で次に来る状態のうち、過去の状態のリスト path に含まれていないものを選び出す。さらに、このリストに含まれる次の一手となる状態について再帰的に search s (s:path) を繰り返す。このとき path は s:path に更新されて新しい状態を含んだ path になっている。search s path :: State -> [State] -> [[State]] だから、map (\x -> search x (s:path)
main = mapM_ (\x -> (mapM_ print x >> putStr "\n")) $ search beginState [] このプログラムには if ~ then ~ else ~ の制御構造は全く無い。現実の問題に対し、代数的データの定義から始めて自然にコード化しているうちに実行可能なプログラムになった。また、プログラムのパーツは、作るたびに動作確認ができるような仕組みになっている。Haskellの真骨頂は、このようなパターン処理によるプログラミングができることではないだろうか。
川渡りパズルとは
川渡りパズル解法プログラム
data Farmer = LeftSide | RightSide deriving (Show, Eq)
data State = State {left :: [Member], right :: [Member], farmer :: Farmer} deriving (Show, Eq)
beginState = State [Fox, Goose, Beans] [] LeftSide
goal s = left s == []
forbidden xs = (elem Fox xs && elem Goose xs) || (elem Goose xs && elem Beans xs)
available s = (farmer s == LeftSide && (not $ forbidden $ right s)) || (farmer s == RightSide && (not $ forbidden $ left s))
updateLeft s = filter available $ [State (delete x $ left s) (sort $ x:right s) RightSide | x <- left s] ++ [State (left s) (right s) RightSide]
updateRight s = filter available $ [State (sort $ x:left s) (delete x $ right s) LeftSide | x <- right s] ++ [State (left s) (right s) LeftSide]
findNext s
| farmer s == LeftSide = updateLeft s
| otherwise = updateRight s
search s path
| goal s = [reverse (s:path)]
| otherwise = concatMap (\x -> search x (s:path)) [x | x <- findNext s, (not $ elem x path)]
main = mapM_ (\x -> (mapM_ print x >> putStr "\n")) $ search beginState []
[1 of 1] Compiling Main ( farmer.hs, interpreted )
Ok, modules loaded: Main.
*Main> main
State {left = [Fox,Goose,Beans], right = [], farmer = LeftSide}
State {left = [Fox,Beans], right = [Goose], farmer = RightSide}
State {left = [Fox,Beans], right = [Goose], farmer = LeftSide}
State {left = [Beans], right = [Fox,Goose], farmer = RightSide}
State {left = [Goose,Beans], right = [Fox], farmer = LeftSide}
State {left = [Goose], right = [Fox,Beans], farmer = RightSide}
State {left = [Goose], right = [Fox,Beans], farmer = LeftSide}
State {left = [], right = [Fox,Goose,Beans], farmer = RightSide}
State {left = [Fox,Beans], right = [Goose], farmer = RightSide}
State {left = [Fox,Beans], right = [Goose], farmer = LeftSide}
State {left = [Fox], right = [Goose,Beans], farmer = RightSide}
State {left = [Fox,Goose], right = [Beans], farmer = LeftSide}
State {left = [Goose], right = [Fox,Beans], farmer = RightSide}
State {left = [Goose], right = [Fox,Beans], farmer = LeftSide}
State {left = [], right = [Fox,Goose,Beans], farmer = RightSide}
川渡りプログラムを読む
データ型の定義
農夫以外のメンバーには Fox と Goose と Beans がいる。
農夫は川の左岸にいるか、右岸にいるかのどちらかである。
農夫とメンバーとの位置関係を State (状態）で表す。状態のフィールドは、左岸にいるメンバーのリスト、右岸にいるメンバーのリスト、農夫が左岸にいるか右岸にいるかを表している。
ルールの定義
最初の State （状態）はメンバーが３つとも左岸にいて、農夫も左岸にいる。右岸にはメンバーは誰もいない。
State（状態の）ゴールは左岸に誰もいないことだ。
禁止された状態とは、メンバーのリスト xs の中に Fox と Goose が同時に含まれるか、Goose と Beans が同時に含まれている場合だ。
左岸の状態を更新する。左岸のメンバーの一つを右岸に移し、農夫を右岸に移すか（複数の状態の可能性がある）または、メンバーの移動はせず農夫だけが右岸に移る。さらに、filter available 関数で禁止状態のない状態を選び出す。戻り値は可能な状態のリストだ。
右岸の状態を更新する。ということは、右岸のメンバーの一つを左岸に移し、農夫を左岸に移すか（複数の状態の可能性がある）または、メンバーの移動はせず農夫だけが左岸に移る。さらに、filter available 関数で禁止状態のない状態を選び出す。戻り値は可能な状態のリストだ。
解答の探索
| farmer s == LeftSide = updateLeft s
| otherwise = updateRight s
次の一手をさがす。農夫が左岸にいれば、左岸を更新し、右岸にいれば右岸を更新する。
| goal s = [reverse (s:path)]
| otherwise = concatMap (\x -> search x (s:path)) [x | x <- findNext s, (not $ elem x path)]
移動の手順を探す。s には現在の状態が、path にはそれまでの状態のリストが束縛される。プログラムのなかで唯一技巧的なプログラム。seach s だけの再帰関数にしても良いのだが、search s path という末尾再帰関数にしてある。理由は not $ elem x path のように、選んだ状態が、過去の状態と重複しないようにするために、過去の状態のリストを参照するからだ。そうしないと、search s path 関数が巡回してプログラムが停止しなくなる。
main 関数は beginState を出発点に search s path を適用してできた [[State]] 型の発見された状態のリストを端末に出力するだけ。
まとめ