パズルに挑戦！
今回は 4 つのパズルを出題します。Lisp で解法プログラムを作成してください。プログラムを作る前に、自分で考えてみるのも面白いでしょう。
●問題１「騎士の周遊」
騎士（ナイト）はチェスの駒のひとつで、将棋の桂馬の動きを前後左右にとることができます。次の図を見てください。
このナイトを動かして、どのマスにもちょうど一回ずつ訪れて出発点に戻る周遊経路を求めるのが問題です。ちなみに、4 行 4 列の盤面には解がありませんが、6 行 6 列、8 行 8 列の盤面には解が存在します。大きな盤面を解くのは大変なので、問題 A の盤面でナイトの周遊経路を求めてください。
●問題２「嫉妬深い夫の問題」
「嫉妬深い夫の問題」は「川渡りの問題」と呼ばれる古典的なパズルの一種です。このパズルにはたくさんのバリエーションがありますが、その中で「農夫と山羊と狼とキャベツの問題」や「宣教師と人食い人」という危険な名前のパズルが有名です。
それでは問題です。3 組の夫婦が川を渡ることになりました。ボートには 2 人しか乗ることができません。どの夫も嫉妬深く、彼自身が一緒にいない限り、ボートでも岸でも妻がほかの男といることを許しません。なお、6 人ともボートを漕ぐことができます。この条件で、3 組の夫婦が川を渡る最短手順を求めてください。
●問題３「ペグ・ソリテア」
ペグ・ソリテアは、盤上に配置されたペグ（駒）を、最後にはひとつ残るように取り除いていく古典的なパズルです。ペグは次のルールに従って移動し、除去することができます。
- ペグは隣にあるペグをひとつだけ跳び越して、空いている場所へ着地します。
- 跳び越されたペグは盤上から取り除かれます。
- 移動方向は、ふつう縦横のみの 4 方向ですが、 ルールによっては斜め方向の移動を許す場合もあります。
- 同じペグの連続跳び越しは 1 手と数えます。
盤は今までに多数考案されていますが、33 穴英国盤、37 穴フランス盤、41 穴盤が有名でしょう。33 穴英国盤とペグの個数を減らした 12 穴盤を下図に示します。
それぞれのマスにペグがありますが、そこからひとつペグを取り除いてゲームを始めます。上図では黒丸でペグを表し、白丸で空き場所を表しています。ルールに従ってペグを移動し、最後にひとつだけ残ればクリアとなります。ただし、ペグを取り除く位置によっては解けない場合もあるので注意してください。
それでは問題です。上図 (2) に示した 12 穴盤でどれかペグをひとつ取り除き、最後にペグがひとつ残る跳び方の最小手数を求めてください。それから、最初に取り除いた位置と最後に残ったペグの位置が同じになることを「補償型の解」といいます。興味のある方は、この条件で最小手数を求めてください。
●問題４「スライドパズル」
最後の問題はスライドパズルです。次の図を見てください。
「8 パズル」の変形バージョンです。このスライドパズルは数字ではなく 6 種類の駒 (┘┐┌└│─) を使います。─と│は 2 個ずつあるので駒は全部で 8 個になります。START から GOAL までの最短手順を求めてください。
●問題１「騎士の周遊」の解答
それではプログラムを作りましょう。この問題は盤面が小さいので、単純な深さ優先探索で簡単に解くことができます。下図に示すように、盤面のマスに番号をつけます。
あとは隣接リストを定義して、深さ優先探索で周遊経路を探索するだけです。プログラムは次のようになります。
List 1 : 「騎士の周遊」解法プログラム
; 隣接リスト
(defvar *adjacent* #((5 6 8) ; 0
(2 7 9) ; 1
(1 8 10) ; 2
(9 11) ; 3
(6 10) ; 4
(0 7 11) ; 5
(0 4 11) ; 6
(1 5) ; 7
(0 2) ; 8
(1 3 10) ; 9
(2 4 9) ; 10
(3 5 6))) ; 11
; 単純な深さ優先探索
(defun knight-tour (&optional (n 1) (goal 0) (path '(0)))
(if (= n 12)
(if (member goal (aref *adjacent* (car path)))
; 周遊コースを発見
(print (reverse (cons goal path))))
(dolist (x (aref *adjacent* (car path)))
(unless (member x path)
; 再帰呼び出し
(knight-tour (1+ n) goal (cons x path))))))
隣接リストはベクタ *adjacent* に定義します。要素はリストであることに注意してください。関数 knight-tour は深さ優先探索で騎士の周遊経路を求めます。引数 n は訪れたマスの個数、goal はゴール地点（出発点）、path は経路を表します。周遊経路を求めるので出発点はどこでもいいのですが、今回は 0 を出発点としてます。
全部のマスを 1 回ずつ訪れると n の値は 12 になります。最後のマスから出発点 (goal) に戻ることができれば周遊経路になります。これは最後のマスの隣接リストに goal が含まれているかチェックすればいいですね。そうであれば、周遊経路になるので print で path を表示します。
n が 12 より小さい場合は、深さ優先で騎士を進めていきます。この処理は経路の探索と同じなので、詳しく説明する必要はないでしょう。これでプログラムは完成です。
それでは、実行してみましょう。
(knight-tour) (0 5 7 1 9 3 11 6 4 10 2 8 0) (0 6 4 10 9 3 11 5 7 1 2 8 0) (0 8 2 1 7 5 11 3 9 10 4 6 0) (0 8 2 10 4 6 11 3 9 1 7 5 0) nil
4 通りの周遊経路が表示されましたが、逆回りの経路があるので、実際の経路は次の 2 通りになります。
「騎士の周遊」は、拙作のページ Puzzle DE Programming の 「騎士の巡歴 (Knight's Tour)」 でも取り上げています。興味のある方はお読みくださいませ。
●問題２「嫉妬深い夫の問題」の解答
それではプログラムを作ります。この問題は、単純な反復深化でも簡単に最短手順を求めることができます。今回は左岸から右岸へ渡ることにしましょう。
まず最初に、夫婦と岸の状態を表すデータ構造を決めます。いろいろな方法が考えられますが、今回は 3 組の夫婦をシンボル Ha, Wa, Hb, Wb, Hc, Wc で、岸の状態をリストで表すことにします。ボートがある場合はリストの先頭に t をセットし、無い場合は nil をセットします。H で始まるシンボルが夫、W で始まるシンボルが妻を表します。最初の状態は、左岸が (t Ha Hb Hc Wa Wb Wc) で右岸が (nil) となります。ここで、同一局面のチェックを簡単にするため、夫婦を表すシンボルは string< を満たすように並べることにします。
同一局面のチェックは人の状態だけでは不十分で、ボートの有無も必要でした。そこで、状態を表すリストの先頭にボートの有無を表すデータ (t, nil) を追加することにしました。修正するとともにお詫び申し上げます。
●プログラムの作成
次は、岸やボートの状態が安全かチェックする関数 safep を作ります。次のリストを見てください。
List 2 : 状態のチェック
(defun safep (state)
(let ((female (intersection state '(Wa Wb Wc)))
(male (intersection state '(Ha Hb Hc))))
(if (and female male)
; 女性と男性が同じ場所にいる
(dolist (w female t)
(unless (member (cdr (assoc w '((Wa . Ha) (Wb . Hb) (Wc . Hc)))) male)
; 夫がいない場合は危険！
(return nil)))
; 女性だけ男性だけならば安全
t)))
引数 state はボートや岸にいる人を表すリストです。まず最初に、state から女性を取り出して female に、男性を取り出して male にセットします。この処理は関数 intersection を使えば簡単です。intersection の説明は拙作のページ ちょっと寄り道「集合としてのリスト」 をお読みくださいませ。
問題になるのは、男性と女性がいっしょにいる場合です。このときは、女性の夫がいっしょにいるかチェックします。dolist で female から女性をひとりずつ変数 w に取り出して、その夫が male に含まれているか member でチェックします。夫婦は連想リストで表していて、assoc で w の夫を求めています。夫がいっしょにいなければ危険な状態なので、return で dolist を脱出して nil を返します。それ以外の場合は安全な状態なので t を返します。
次は、ボートに乗る組み合わせをすべて求める関数 get-boat-pattern を作ります。たとえば、岸にいる人が (Ha Wa) の場合、ボートに乗る組み合わせは 2 人で乗る (Ha Wa) と 1 人で乗る Ha, Wa の合計 3 通りがあります。get-boat-pattern は 1 人乗りの場合もリストに格納します。つまり、(Ha Wa) の場合は ((Ha Wa) (Ha) (Wa)) を返します。プログラムは次のようになります。
List 3 : ボートに乗る組み合わせ
(defun get-boat-pattern (state)
(let ((result (mapcar #'(lambda (x) (list x)) state))
boat a)
; 2 人乗りの組み合わせ
(while (cdr state)
(setq a (pop state))
(dolist (b state)
(setq boat (list a b))
(if (safep boat)
(push boat result))))
; 結果を返す
result))
最初に 1 人乗りの場合を求めて result にセットします。この処理は mapcar を使えば簡単です。state が (Ha Wa) であれば、この処理で ((Ha) (Wa)) が result にセットされます。
次の処理で 2 人乗りの場合を求めます。この処理も簡単で、リストの先頭の要素と残りの要素の組み合わせを求めたあと、先頭の要素を取り除いたリストに対して同じ処理を適用するだけです。このとき、述語 safep でボートの状態をチェックすることを忘れないで下さい。
たとえば (Ha Hb Wa Wb) の場合、最初に先頭の要素 Ha と残りの要素 (Hb Wa Wb) を組み合わせます。そして、次は先頭の要素を取り除いた (Hb Wa Wb) の組み合わせを求めます。今度は Hb と (Wa Wb) を組み合わせればいいわけです。このプログラムは繰り返しを使いましたが、再帰定義でも簡単にプログラムできます。興味のある方はプログラムを改造してみてください。
次はボートを動かす関数 move-boat を作ります。List 4 を見てください。
List 4 : ボートを動かす
(defun move-boat (n limit from to)
(if (= n limit)
(if (null (cdar to))
; ゴール
(print-answer (reverse to) (reverse from)))
; ボートを動かす
(dolist (boat (get-boat-pattern (cdar from)))
(let ((new-from (cdar from))
(new-to (cdar to)))
; 移動
(dolist (a boat)
(setq new-to (add-person a new-to)
new-from (remove a new-from)))
; ボートの状態を追加
(push t new-to)
(push nil new-from)
; チェック
(if (and (safep (cdr new-from))
(safep (cdr new-to))
; 同一局面のチェック
(not (member new-from from :test #'equal)))
; 再帰
(move-boat (1+ n) limit (cons new-to to) (cons new-from from)))))))
引数 n が手数、limit が反復深化の上限値、from と to は岸の状態の履歴を格納するリストです。ボートがある岸の状態が from で、対岸の状態が to です。リストの先頭の要素が現在の状態を表します。
n が limit に達したら、全員が右岸へ渡ったかチェックします。ボートが右岸にあるときは n が奇数なので、limit には奇数を設定することに注意してください。このとき、左岸にいる人 (cdar to) が空リストであれば、全員が右岸へ渡ったことになります。関数 print-answer で手順を表示します。
n が limit 未満ならば、ボートを form から to へ動かします。両岸の人の状態を cdr で取り出して new-from と new-to にセットします。それから、get-boat-pattern で new-from からボートに乗り込むパターンを求めて、new-to へ移動させます。ボートには 1 or 2 人乗っているので、dolist でボートに乗っている人を new-from から削除して、new-to へ追加します。関数 add-person は string< を満たすように要素を追加します。
次に、ボートの状態を push で追加したら、new-from と new-to のチェックを行います。safep でチェックするときは、new-from と new-to に cdr を適用することを忘れないで下さい。それから member で同一局面のチェックを行います。これは片側の岸だけ行えば十分です。要素はリストなので、キーワード :test には equal を指定することに注意してください。最後に move-boat を再帰呼び出しします。
次は関数 add-person を作ります。
List 5 : 状態 state に人を追加
(defun add-person (a state)
(cond ((endp state) (list a))
((string< a (car state))
(cons a state))
(t (cons (car state) (add-person a (cdr state))))))
引数 a が追加する人で、引数 state が人の状態を表すリストです。リストの要素は string< を満たす順番で並べられています。a よりも大きい要素を先頭から順番に探して、その直前に a を追加すれば string< を満たすことができます。add-person は、この処理を再帰定義で実現しています。
a が一番大きい場合は、リストの最後に追加します。この場合、引数 state は空リストになるので、list で a をリストに格納して返します。(string< a (car state)) を満たす場合は、この位置に a を追加します。(cons a state) を返せば、この位置に a を追加することができます。それ以外は add-person を再帰呼び出しします。
ところで、string= や string< などの文字列を比較する関数は、文字列だけではなくシンボルも比較することができます。Common Lisp の場合、シンボルは関数 string で文字列に変換することができますが、文字列を比較する関数は引数に string を適用します。ご注意くださいませ。
最後に、解を表示する関数 print-answer と move-boat を呼び出す関数 solve を作ります。
List 6 : 「嫉妬深い夫の問題」の解法
; 解の表示
(defun print-answer (from to)
(let ((n 0))
(while from
(format t "~D : ~S ~S~%" n (pop from) (pop to))
(incf n))
(throw 'find-answer t)))
; パズルの解法
(defun solve ()
(catch 'find-answer
(do ((limit 9 (+ limit 2)))
((> limit 20))
(format t "----- ~D 手を探索 -----~%" limit)
; 初手を (Ha Wa) に限定
(move-boat 1 limit '((t Ha Wa) (nil)) '((nil Hb Hc Wb Wc) (t Ha Hb Hc Wa Wb Wc))))))
print-answer は左右の岸の状態を表示するだけです。solve は上限値 limit を 2 手ずつ増やしながら move-boat を呼び出します。
制約のない 6 人が 2 人乗りのボートで川を渡る場合、1 往復で対岸に渡ることができる人数は 1 人ですから、4 往復で 4 人を対岸へ送ってから最後に 2 人が対岸へ渡ることになります。したがって limit の初期値は 9 手に設定します。
また、最初にボートに乗る組み合わせは夫婦、女性 2 人、男性 2 人の 3 通りありますが、男性 2 人が乗り込む場合は条件を満たさないので、初手は夫婦か女性 2 人の 2 通りしかありません。そこで、今回は初手を夫婦 (Ha, Wa) に限定しました。興味のある方は、ほかの組み合わせでも試してみてください。
●実行結果
これでプログラムは完成です。さっそく実行してみましょう。
(solve) ----- 9 手を探索 ----- ----- 11 手を探索 ----- 0 : (t Ha Hb Hc Wa Wb Wc) (nil) 1 : (nil Hb Hc Wb Wc) (t Ha Wa) 2 : (t Ha Hb Hc Wb Wc) (nil Wa) 3 : (nil Ha Hb Hc) (t Wa Wb Wc) 4 : (t Ha Hb Hc Wa) (nil Wb Wc) 5 : (nil Ha Wa) (t Hb Hc Wb Wc) 6 : (t Ha Hc Wa Wc) (nil Hb Wb) 7 : (nil Wa Wc) (t Ha Hb Hc Wb) 8 : (t Wa Wb Wc) (nil Ha Hb Hc) 9 : (nil Wa) (t Ha Hb Hc Wb Wc) 10 : (t Ha Wa) (nil Hb Hc Wb Wc) 11 : (nil) (t Ha Hb Hc Wa Wb Wc) t
11 手で解くことができました。print-answer はリストを表示しているだけなので、手順はちょっとわかりにくいかもしれません。手順をきれいに表示することは皆さんにお任せしたいと思います。
ところで、もっと簡単にプログラムできると思っていたのですが、ちょっと複雑なプログラムになってしまいました。データ構造を工夫すると、もっと簡単にプログラムできるかもしれません。興味のある方はプログラムを改造してみてください。また、Puzzle DE Programming では 「農夫と山羊と狼とキャベツの問題」 を取り上げています。興味のある方は参考にしてください。
●プログラムリスト
;
; 「嫉妬深い夫の問題」：反復深化による解法
;
; Copyright (C) 2002 Makoto Hiroi
;
; 夫を表すシンボル Ha, Hb, Hc
; 妻を表すシンボル Wa, Wb, Wc
;
; 状態のチェック
(defun safep (state)
(let ((female (intersection state '(Wa Wb Wc)))
(male (intersection state '(Ha Hb Hc))))
(if (and female male)
; 女性と男性が同じ場所にいる
(dolist (w female t)
(unless (member (cdr (assoc w '((Wa . Ha) (Wb . Hb) (Wc . Hc)))) male)
; 夫がいない場合は危険！
(return nil)))
; 女性だけ男性だけならば安全
t)))
; 解の表示
(defun print-answer (from to)
(let ((n 0))
(while from
(format t "~D : ~S ~S~%" n (pop from) (pop to))
(incf n))
(throw 'find-answer t)))
; 状態 state に人を追加
(defun add-person (a state)
(cond ((endp state) (list a))
((string< a (car state))
(cons a state))
(t (cons (car state) (add-person a (cdr state))))))
; ボートに乗る組み合わせ
(defun get-boat-pattern (state)
(let ((result (mapcar #'(lambda (x) (list x)) state))
boat a)
; 2 人乗りの組み合わせ
(while (cdr state)
(setq a (pop state))
(dolist (b state)
(setq boat (list a b))
(if (safep boat)
(push boat result))))
; 結果を返す
result))
; ボートを動かす
(defun move-boat (n limit from to)
(if (= n limit)
(if (null (cdar to))
; ゴール
(print-answer (reverse to) (reverse from)))
; ボートを動かす
(dolist (boat (get-boat-pattern (cdar from)))
(let ((new-from (cdar from))
(new-to (cdar to)))
; 移動
(dolist (a boat)
(setq new-to (add-person a new-to)
new-from (remove a new-from)))
; ボートの状態を追加
(push t new-to)
(push nil new-from)
; チェック
(if (and (safep (cdr new-from))
(safep (cdr new-to))
; 同一局面のチェック
(not (member new-from from :test #'equal)))
; 再帰
(move-boat (1+ n) limit (cons new-to to) (cons new-from from)))))))
; パズルの解法
(defun solve ()
(catch 'find-answer
(do ((limit 9 (+ limit 2)))
((> limit 20))
(format t "----- ~D 手を探索 -----~%" limit)
; 初手を (Ha Wa) に限定
(move-boat 1 limit '((t Ha Wa) (nil)) '((nil Hb Hc Wb Wc) (t Ha Hb Hc Wa Wb Wc))))))
ちょっと寄り道
■続・嫉妬深い夫の問題
今度は「続・嫉妬深い夫の問題」を Lisp で解いてみましょう。
3 組の夫婦が川を渡ることになりました。ボートには 2 人しか乗ることができません。どの夫も嫉妬深く、彼自身が一緒にいない限り、ボートでも岸でも妻がほかの男といることを許しません。なお、男性 3 人はボートを漕ぐことができますが、
ボートを漕ぐことができる女性は 1 人しかいません。 この条件で、3 組の夫婦が川を渡る最短手順を考えてください。この問題を解くプログラムは、「嫉妬深い夫の問題」を解くプログラムを少し修正するだけで作ることができます。関数 get-boat-pattern を修正します。
List 7 : ボートに乗る組み合わせ（修正）
(defun get-boat-pattern (state)
(let* ((rower '(Ha Hb Hc Wa))
(result (mapcar #'(lambda (x) (list x)) (intersection state rower)))
boat a)
(while (cdr state)
(setq a (pop state))
(dolist (b state)
(setq boat (list a b))
(if (and (intersection boat rower) (safep boat))
(push boat result))))
; 結果を返す
result))
変数 rower にボートを漕ぐことができる人を定義します。今回はボートを漕ぐことができる女性を Wa としました。ボートに 1 人乗る場合、(intersection state rower) とすればボートに乗る人を求めることができます。2 人乗りの場合、ボートに乗る組み合わせ boat を求めたあと、(intersection boat rower) でボートを漕ぐ人がいるかチェックします。結果が nil であればボートを動かすことはできません。
あとは関数 solve を修正します。前回のプログラムでは初手を (Ha Wa) としましたが、今回はこの制限をはずします。関数 move-boat は次のように呼び出します。
(move-boat 0 limit '((t Ha Hb Hc Wa Wb Wc)) '(nil))
プログラムの修正はこれだけです。
■実行結果
それでは実行してみましょう。
----- 9 手を探索 ----- ----- 11 手を探索 ----- ----- 13 手を探索 ----- 0 : (t Ha Hb Hc Wa Wb Wc) (nil) 1 : (nil Ha Hb Hc Wb) (t Wa Wc) 2 : (t Ha Hb Hc Wa Wb) (nil Wc) 3 : (nil Ha Hb Hc) (t Wa Wb Wc) 4 : (t Ha Hb Hc Wa) (nil Wb Wc) 5 : (nil Ha Wa) (t Hb Hc Wb Wc) 6 : (t Ha Hc Wa Wc) (nil Hb Wb) 7 : (nil Hc Wc) (t Ha Hb Wa Wb) 8 : (t Hb Hc Wb Wc) (nil Ha Wa) 9 : (nil Wb Wc) (t Ha Hb Hc Wa) 10 : (t Wa Wb Wc) (nil Ha Hb Hc) 11 : (nil Wb) (t Ha Hb Hc Wa Wc) 12 : (t Wa Wb) (nil Ha Hb Hc Wc) 13 : (nil) (t Ha Hb Hc Wa Wb Wc) t
13 手で解くことができました。興味のある方は、ほかの条件でも試してみてください。