それでは 12 穴盤 の解法プログラムを作りましょう。最小手数を求めるアルゴリズムといえば「幅優先探索」ですが、12 穴盤は単純な「反復深化」でも簡単に解くことができます。
プログラムのポイントは、ペグを跳び越すときに手数も同時に数えていくことです。直前に動かしたペグと違うペグを動かすときは手数をカウントし、同じペグを動かすときは手数をカウントしません。これで連続跳び越しを 1 手と数えることができます。そして、この手数を使って反復深化を実行するわけです。
最初にデータ構造を定義しましょう。盤面はリストで表して、ペグがある状態を t で、ペグがない状態を nil で表すことにします。盤面とリストの対応は、図 1 の座標を見てください。
図 1 : ペグ・ソリテア (12 穴盤) |
---|
●───● 0───1 / \ / \ / \ / \ ●───●───● 2───3───4 / \ / \ / \ / \ / \ / \ ●───●───●───● 5───6───7───8 \ / \ / \ / \ / \ / \ / ●───●───● 9───10───11 (1) 12 穴盤 (2) 座標 |
ペグの移動は跳び先表を用意すると簡単にプログラムできます。List 1 を見てください。
List 1 : 跳び先表 |
---|
; 跳び先表 (跳び越される位置 . 跳び先の位置) (defvar *jump-table* #(((2 . 5) (3 . 7)) ; 0 ((3 . 6) (4 . 8)) ; 1 ((3 . 4) (6 . 10)) ; 2 ((6 . 9) (7 . 11)) ; 3 ((3 . 2) (7 . 10)) ; 4 ((2 . 0) (6 . 7)) ; 5 ((3 . 1) (7 . 8)) ; 6 ((3 . 0) (6 . 5)) ; 7 ((4 . 1) (7 . 6)) ; 8 ((6 . 3) (10 . 11)) ; 9 ((6 . 2) (7 . 4)) ; 10 ((7 . 3) (10 . 9)))) ; 11 |
ペグの跳び先表はベクタ *jump-table* で定義します。ベクタの要素はリストであることに注意してください。リストの要素は、跳び越されるペグの位置と跳び先の位置を格納したドット対です。たとえば、0 番の位置にあるペグは、2 番を跳び越して 5 番へ移動する場合と、3 番を跳び越して 7 番へ移動する場合の 2 通りがあります。これをドット対 (2 . 5) と (3 . 7) で表しています。
実際にペグを動かす場合、動かすペグと跳び越されるペグがあり、跳び先の位置にペグがないことを確認しなければいけません。このチェックはペグを移動するときに行ってもいいのですが、今回はあらかじめペグの移動パターンをすべて求めることにします。プログラムは次のようになります。
List 2 : ペグの移動パターンをすべて求める |
---|
(defun get-move-pattern (board) (let (result del to) (dotimes (from 12 result) (when (nth from board) (dolist (pos (aref *jump-table* from)) (setq del (car pos) to (cdr pos)) (if (and (nth del board) (not (nth to board))) (push (list from del to) result))))))) |
引数 board は局面(盤面)を表します。dotimes の変数 from が動かすペグの位置を表します。最初に from の位置にペグがあることを (nth from board) で確認します。それから、跳び先表から跳び越されるペグの位置と跳び先の位置を取り出して del と to にセットします。del の位置にペグがあり to の位置にペグがなければ、from のペグを to へ移動することができます。
ペグの移動パターンはリスト (from del to) で表すことにして、このリストを変数 result に push します。dotimes が終了したら result を返します。これで盤面 board におけるペグの移動パターンをすべて求めることができます。
次は、ペグを動かして新しい盤面を返す関数 move-peg を作ります。
List 3 : ペグを動かす |
---|
(defun move-peg (n board pattern) (if board (cons (if (member n pattern) (not (car board)) (car board)) (move-peg (1+ n) (cdr board) pattern)))) |
引数 n が位置、board が盤面、pattern が関数 get-move-pattern で求めたペグの移動パターンです。move-peg は再帰定義で盤面 board をコピーしますが、pattern の位置にある要素は not で反転します。これで from と del の位置にある要素は t から nil に、to の位置にある要素は nil から t に書き換えられます。
次は反復深化を行う関数 solve-id を作ります。
List 4 : 反復深化 |
---|
(defun solve-id (n jc limit board history) (when (<= jc limit) (if (= n 10) ; 解を見つけた (print-answer (reverse history)) ; ペグを移動する (dolist (pattern (get-move-pattern board)) (solve-id (1+ n) ; 連続跳び越しのチェック (if (eql (third (car history)) (first pattern)) jc (1+ jc)) limit (move-peg 0 board pattern) (cons pattern history)))))) |
引数 n がペグを動かした回数、jc が手数(跳んだ回数)、limit が反復深化の上限値、board が盤面、history がペグの移動手順(履歴)を表します。移動手順は移動パターンをリストに格納して表します。
ペグ・ソリテアを反復深化で解く場合、上限値 limit に達していても連続跳び越しによりペグを移動できることに注意してください。最初に、jc をチェックして limit 以下であればペグを移動します。12 穴盤の場合、ペグの総数は 11 個なので、10 回ペグを移動すると残りのペグは 1 個になります。解を見つけたら print-answer で手順を表示します。
そうでなければペグを移動します。get-move-pattern でペグの移動パターンをすべて求め、dolist でひとつずつ取り出して変数 pattern にセットします。そして、このプログラムのポイントが、solve-id を再帰呼び出しするときに連続跳び越しのチェックをするところです。
1 手前の跳び先の位置を (third (car history)) で求め、動かすペグの位置を (first pattern) で求めて eql で比較します。同じ場合は連続跳び越しなので jc の値はそのままにし、違う場合は jc の値を 1 つ増やします。history の初期値は空リスト (nil) なので、比較には eql を使っています。
最後に、手順を表示する関数 print-answer と solve-id を呼び出す関数 solve-peg12 を作ります。
List 5 : ペグ・ソリテア 12 穴盤の解法 |
---|
; 手順を表示する (defun print-answer (history) (let ((prev (third (car history)))) ; 初手を表示 (format t "[~D, ~D" (first (car history)) prev) ; 2 手目以降を表示 (dolist (pos (cdr history)) (cond ((= prev (first pos)) ; 同じ駒が続けて跳ぶ (setq prev (third pos)) (format t ",~D" prev)) (t ; 違う駒が跳ぶ (setq prev (third pos)) (format t "][~D, ~D" (first pos) prev)))) (format t "]~%") (incf *count*))) ; ペグ・ソリテア 12 穴盤の解法 (defun solve-peg12 (pos) (let ((board (make-list 12 :initial-element t))) ; ペグをひとつ取り除く (setf (nth pos board) nil *count* 0) (dotimes (x 10) (format t "----- ~D 手 を探索 -------~%" (1+ x)) (solve-id 0 0 (1+ x) board nil) (if (plusp *count*) (return))))) |
移動手順は 1 手を [from, to] で表し、連続跳び越しの場合は [from, to1, to2, ..., to3] とします。1 手前の跳び先の位置を変数 prev にセットしておいて、それと動かすペグの位置が同じであれば連続跳び越しです。跳び先の位置を prev にセットして、それを表示します。違うペグが跳ぶ場合は、] [ を表示してから動かすペグの位置と跳び先の位置を表示します。
それから、このプログラムでは移動手順をすべて求めています。解の総数をスペシャル変数 *count* でカウントし、solve-id で *count* が 0 よりも大きくなったならば探索を終了します。解をひとつだけ求める場合は、catch と throw を使うといいでしょう。
solve-id の引数 pos は、最初に取り除くペグの位置を表します。関数 make-list で board を初期化したら、setf で pos の位置のペグを取り除き、*count* を 0 に初期化します。あとは、dotimes で上限値を 1 手ずつ増やしていくだけです。(plusp *count*) が真ならば return で dotimes から脱出します。
これでプログラムは完成です。最初に取り除くペグの位置ですが、12 穴盤の対称性から 0, 2, 3 番の 3 か所を調べれば十分です。結果は次のようになりました。
(solve-peg12 0) ----- 1 手 を探索 ------- ----- 2 手 を探索 ------- ----- 3 手 を探索 ------- ----- 4 手 を探索 ------- ----- 5 手 を探索 ------- ----- 6 手 を探索 ------- ----- 7 手 を探索 ------- [7, 0][9, 3][0, 7][8, 6][11, 9,3][5, 0,7][1, 8,6] [7, 0][5, 7][11, 3][1, 6][0, 5,7][9, 11,3][8, 1,6] [5, 0][10, 2][1, 6][11, 3][0, 5,7][8, 1,6][9, 3,11] [5, 0][10, 2][1, 6][9, 3][8, 1,6][11, 3][0, 7,5,0] [5, 0][10, 2][1, 6][9, 3][8, 1,6][11, 3][0, 5,7,0] [5, 0][4, 2][9, 3][8, 6][0, 5,7][1, 6][11, 9,3,11] [5, 0][4, 2][9, 3][8, 6][0, 5,7][1, 6][11, 3,9,11] [5, 0][4, 2][9, 3][1, 6][11, 9,3][8, 6][0, 7,5,0] [5, 0][4, 2][9, 3][1, 6][11, 9,3][8, 6][0, 5,7,0] nil (solve-peg12 2) ----- 1 手 を探索 ------- ----- 2 手 を探索 ------- ----- 3 手 を探索 ------- ----- 4 手 を探索 ------- ----- 5 手 を探索 ------- ----- 6 手 を探索 ------- ----- 7 手 を探索 ------- [10, 2][8, 6][0, 7][11, 3][5, 0,7][9, 3][1, 8,6,1] [10, 2][8, 6][0, 7][11, 3][5, 0,7][9, 3][1, 6,8,1] [10, 2][8, 6][0, 7][9, 3][1, 8,6][5, 0,7][11, 3,9] [4, 2][11, 3][5, 7][8, 6][0, 5,7][1, 6][9, 11,3,9] [4, 2][11, 3][5, 7][8, 6][0, 5,7][1, 6][9, 3,11,9] [4, 2][11, 3][5, 7][1, 6][9, 11,3][0, 5,7][8, 6,1] nil (solve-peg12 3) ----- 1 手 を探索 ------- ----- 2 手 を探索 ------- ----- 3 手 を探索 ------- ----- 4 手 を探索 ------- ----- 5 手 を探索 ------- ----- 6 手 を探索 ------- [11, 3][5, 7][1, 6][9, 11,3][0, 5,7][8, 6,1,8] [11, 3][5, 7][1, 6][9, 11,3][0, 5,7][8, 1,6,8] [9, 3][8, 6][0, 7][11, 9,3][1, 8,6][5, 7,0,5] [9, 3][8, 6][0, 7][11, 9,3][1, 8,6][5, 0,7,5] nil
3 番のペグを取り除いた場合が最小手数 (6 手) になりました。この場合、最初に取り除いた位置と最後に残ったペグの位置が同じになる「補償型の解」にはなりません。実は、0 番のペグを取り除いた場合が「補償型の解」の最小手数 (7 手) になります。2, 3 番を取り除いた場合でも「補償型の解」は存在しますが、その手数は 7 手よりも多くなります。プログラムは簡単に改造できるので、興味のある方は試してみてください。
ペグ・ソリテアは拙作のページ Puzzle DE Programming で 13 穴盤, チャイニーズチェッカー, 変形三角盤 (1) (2), を取り上げています。また、Prolog Programming では パズルに挑戦! で Hoppers というペグ・ソリテアを Prolog で解いています。興味のある方は読んでみてください。
今回は「ペグ・ソリテア 18 穴盤」を Lisp で解いてみましょう。18 穴盤を図 2 に示します。
図 2 : ペグ・ソリテア (18 穴盤) |
---|
●───● 0───1 / \ / \ / \ / \ ●───●───● 2───3───4 / \ / \ / \ / \ / \ / \ ●───●───●───● 5───6───7───8 / \ / \ / \ / \ / \ / \ / \ / \ ●───●───●───●───● 9───10───11───12───13 \ / \ / \ / \ / \ / \ / \ / \ / ●───●───●───● 14───15───16───17 (1) 18 穴盤 (2) 座標 |
ここではペグをどれかひとつ取り除き、最後にペグがひとつ残る跳び方の最小手数を求めることにします。
今回は catch と throw を使って解をひとつ見つけたら探索を終了します。あとは、跳び先表 *jump-table* と関数 solve-peg12 を 18 穴盤用に修正するだけです。次のリストを見てください。
List 6 : ペグ・ソリテア 18 穴盤の解法 |
---|
; 跳び先表 : (跳び越される位置 . 跳び先の位置) (defvar *jump-table* #(((2 . 5) (3 . 7)) ; 0 ((3 . 6) (4 . 8)) ; 1 ((3 . 4) (5 . 9) (6 . 11)) ; 2 ((6 . 10) (7 . 12)) ; 3 ((3 . 2) (7 . 11) (8 . 13)) ; 4 ((2 . 0) (6 . 7) (10 . 15)) ; 5 ((3 . 1) (7 . 8) (10 . 14) (11 . 16)) ; 6 ((3 . 0) (6 . 5) (11 . 15) (12 . 17)) ; 7 ((4 . 1) (7 . 6) (12 . 16)) ; 8 ((5 . 2) (10 . 11)) ; 9 ((6 . 3) (11 . 12)) ; 10 ((6 . 2) (7 . 4) (10 . 9) (12 . 13)) ; 11 ((7 . 3) (11 . 10)) ; 12 ((8 . 4) (12 . 11)) ; 13 ((10 . 6) (15 . 16)) ; 14 ((10 . 5) (11 . 7) (16 . 17)) ; 15 ((11 . 6) (12 . 8) (15 . 14)) ; 16 ((12 . 7) (16 . 15)))) ; 17 ; ペグ・ソリテア 18 穴盤の解法 (defun solve-peg18 (pos) (let ((board (make-list 18 :initial-element t))) ; ペグをひとつ取り除く (setf (nth pos board) nil) (catch 'find-answer (dotimes (x 16) (format t "----- ~D 手 を探索 -------~%" (1+ x)) (solve-id 0 0 (1+ x) board nil))))) |
このほかに、関数 print-answer で解を表示したら throw する処理を追加します。プログラムの修正はこれでだけです。
さっそく M.Hiroi のオンボロマシン (Pentium 166 MHz) で実行してみましたが、いつまでたっても答えがでません。18 穴盤の大きさになると、単純な反復深化では時間がとてもかかるようです。そこで、「下限値枝刈り法」を使うことにしましょう。
ペグ・ソリテアでは、コーナーと辺にあるペグから下限値を求めることができます。次の図を見てください。
図 3 : 下限値の求め方 |
---|
●───● ○───○ / \ / \ / \ / \ ○───○───○ ●───○───● / \ / \ / \ / \ / \ / \ ○───○───○───○ ●───○───○───● / \ / \ / \ / \ / \ / \ / \ / \ ●───○───○───○───● ○───○───○───○───○ \ / \ / \ / \ / \ / \ / \ / \ / ●───○───○───● ○───●───●───○ (1) コーナーにあるペグ (2) 辺にあるペグ |
ペグ・ソリテアの場合、コーナーにあるペグはほかのペグから跳び越されることはありません。つまり、コーナーのペグは自分でジャンプするしか移動する方法がないのです。したがって、コーナーにペグが残っていれば、最低でもその個数だけ移動手数が必要になります。18 穴盤の場合、コーナーは 0, 1, 9, 13, 14, 17 番の 6 か所あります。これを下限値として利用することができます。
ところが、コーナーペグの下限値だけでは不十分のようで、M.Hiroi のオンボロマシン (Pentium 166 MHz) では時間がとてもかかるのです。そこで、辺にあるペグを下限値として使うことにします。
図 3 (2) を見てください。辺にあるペグが 2 つ並んでいます。この状態では、ほかのペグから跳び越されることはありません。つまり、コーナーペグと同様に自分でジャンプするしか移動する方法がないのです。だからといって、移動手数が 2 手必要になるわけではありません。どちらかのペグがもう一方のペグを跳び越せば、辺にあるペグを取り除くことができますね。つまり、辺にあるペグが 2 つ並んでいる場合、移動手数は最低でも 1 手必要になるのです。辺は (2, 5), (4, 8), (15, 16) の 3 か所あります。コーナーと辺にあるペグを合わせて下限値として利用することにしましょう。
ところで、これらの下限値を利用する場合、注意点がひとつだけあります。それはペグが連続跳びをしている場合です。次の局面を見てください。
図 4 : 最終手で連続跳びする局面 |
---|
○───○ 0───1 / \ / \ / \ / \ ●───●───○ 2───3───4 / \ / \ / \ / \ / \ / \ ○───●───○───○ 5───6───7───8 / \ / \ / \ / \ / \ / \ / \ / \ ○───○───●───○───○ 9───10───11───12───13 \ / \ / \ / \ / \ / \ / \ / \ / ○───●───○───○ 14───15───16───17 (1) 最終手の開始局面 (2) 座標 |
上限値を N 手とします。今、上限値の 1 手前で (1) の局面になりました。ここで、[15, 7, 5, 0, 7] または [15, 7, 0, 5, 7] と連続跳びすると、N 手で解くことができますね。ここで [15, 7, 5] と跳んだ局面に注目してください。辺のペグ (2 番と 5 番) が 2 つ並びますが、ここで下限値に 1 を加えると上限値 N を越えるため枝刈りされてしまいます。[15, 7, 0] と跳ぶ場合も同じです。ペグはコーナー (0 番) に移動しますが、ここで下限値に 1 を加えると上限値 N を越えてしまいます。これでは解を求めることができませんね。
そこで、直前に移動したペグは下限値の計算から除外することにします。ようするに、直前に移動したペグは連続跳びする可能性があるので、下限値の対象にしてはいけないのです。[15, 7, 5] と跳んで 2 番と 5 番のペグが並んだ場合、直前に移動したペグは 5 番なので下限値の計算から除外します。[15, 7, 0] と跳んでペグがコーナーに移動した場合も同様です。これで条件を満たす手順が枝刈りされることはありません。
それではプログラムを作りましょう。下限値を計算する関数 get-lower-value は次のようになります。
List 7 : 下限値の計算 |
---|
(defun get-lower-value (board prev) (let ((value 0)) ; コーナーのチェック (dolist (c '(0 1 9 13 14 17)) (if (and (nth c board) (not (eql c prev))) (incf value))) ; 辺のチェック (dolist (edge '((2 5) (4 8) (15 16)) value) (unless (member prev edge) (if (and (nth (first edge) board) (nth (second edge) board)) (incf value)))))) |
引数 board が盤面で、prev が直前に移動したペグの位置を表します。コーナーと辺のペグをチェックするとき、prev と同じ位置であれば下限値の計算から除外します。
最後に solve-id と solve-peg18 を修正します。次のリストを見てください。
List 8 : 下限値枝刈り法 |
---|
; 反復深化(下限値枝刈り法) (defun solve-id (n jc limit board history) (when (<= (+ jc (get-lower-value board (third (car history)))) limit) (if (= n 16) (print-answer (reverse history)) (dolist (pattern (get-move-pattern board)) (solve-id (1+ n) (if (eql (third (car history)) (first pattern)) jc (1+ jc)) limit (move-peg 0 board pattern) (cons pattern history)))))) ; ペグ・ソリテア 18 穴盤の解法 (defun solve-peg18 (pos) (let ((board (make-list 18 :initial-element t))) ; ペグをひとつ取り除く (setf (nth pos board) nil) (catch 'find-answer (do ((limit (get-lower-value board nil) (1+ limit))) ((> limit 16)) (format t "----- ~D 手 を探索 -------~%" limit) (solve-id 0 0 limit board nil))))) |
solve-id は get-lower-value で下限値を求め、jc + 下限値 が上限値 limit よりも大きくなったならば枝刈りを行います。あとのプログラムは今までと同じです。solve-peg18 は get-lower-value で初期状態の下限値を求め、上限値 limit は 1 手からではなく下限値から始めるように修正します。これでプログラムは完成です。
それでは実行してみましょう。最初に取り除くペグの位置は、18 穴盤の対称性から 0, 2, 3, 6 の 4 ヵ所だけで十分です。結果は次のようになりました。
(solve-peg18 0) ----- 8 手 を探索 ------- ----- 9 手 を探索 ------- ----- 10 手 を探索 ------- [7, 0][15, 7][17, 15][14, 16][4, 11][13, 4][5, 7,17,15,7][9, 11][1, 8,6][0, 5,7,15] 実行時間 約 1.6 秒 (solve-peg18 2) ----- 8 手 を探索 ------- ----- 9 手 を探索 ------- [9, 2][0, 5][11, 9,2,11][16, 6][14, 16][4, 11][17, 15,7][13, 4,11,2,4][1, 8,16] 実行時間 約 3.2 秒 (solve-peg18 3) ----- 9 手 を探索 ------- ----- 10 手 を探索 ------- [12, 3][15, 7][17, 15][4, 11][13, 4][5, 7][1, 8,6][0, 5,7][14, 16,6][9, 11,4,2,11] 実行時間 約 11.1 秒 (solve-peg18 6) ----- 9 手 を探索 ------- [16, 6][14, 16][17, 15][2, 11][9, 2][8, 6,16,14,6][0, 5,7][1, 8,6][13, 11,2,4] 実行時間 約 8.7 秒
実行時間は 3 番のペグを取り除いた場合がいちばん長く、オンボロマシン (Pentium 166 MHz) で約 11 秒でした。下限値枝刈り法の効果は十分に出ていると思います。最短手数は 6 番と 2 番のペグを取り除いた場合の 9 手になりました。最短手数はもっと長くなると思っていたので、この結果にはちょっと驚きました。
ところで、実行時間をもっと短縮したい場合は、盤面をリストではなく整数値のビットを使って表すといいでしょう。つまり、ペグがある状態をビットオンで、ペグがない状態をビットオフで表します。ペグの移動は該当する位置のビットを反転するだけなので、排他的論理和 logxor で簡単に実現できます。
実際に試してみると、3 番のペグを取り除いた場合で 11.1 秒から 4.5 秒まで短縮することができました。興味のある方はプログラムリストをお読みくださいませ。