今回は「ペグ・ソリテア」というパズルを解きましょう。ペグ・ソリテアは盤上に配置されたペグ（駒）を、最後にはひとつ残るように取り除いていく古典的なパズルです。ペグは、次のルールに従って移動し、除去することができます。
盤は今までに多数考案されていますが、33 穴英国盤、37 穴フランス盤、41 穴盤が有名です。下図に 33 穴英国盤を示します。
●─●─●
│ │ │
●─●─●
│ │ │
●─●─●─●─●─●─●
│ │ │ │ │ │ │
●─●─●─○─●─●─●
│ │ │ │ │ │ │
●─●─●─●─●─●─●
│ │ │
●─●─●
│ │ │
●─●─●
図 : 33 穴英国盤
33 のマスにペグがありますが、そこからひとつペグを取り除いてゲームを始めます。上図では黒丸でペグを表し、白丸で空き場所を表しています。ルールに従ってペグを移動し、最後にひとつだけ残ればクリアとなります。ただし、ペグを取り除く位置によって、解けない場合もあるので注意してください。
橋本哲氏の記事『特集コンピュータパズルへの招待 ペグ・ソリテア編』によると、最初の空き位置と最後に残ったペグの位置が同じになることを「補償型の解」といい、最初の空き位置が盤の中央で、なおかつ、補償型の解がある場合を「中央補償型の解」と呼ぶそうです。33 穴英国盤には、中央補償型の解があるそうです。
ペグ・ソリテアの場合、昔から補償型や中央補償型の解の最小手数を求めることが行われてきました。33 穴英国盤のように、ペグの数が多くなるとパソコンで解くのは大変になります。そこで、今回はサイズを小さくした簡単なペグ・ソリテアを反復深化で解いてみましょう。
下図は「変形三角盤」と呼ばれるペグ・ソリテアです。21 個のマスが少し変わった三角形に並んでいて、そこにペグを配置します。ペグは別のペグをひとつだけ跳び越えることで、任意の方向へ移動することができます。もちろん、着地する地点が空いていなければ、跳び越すことはできません。
●───●
＼ ／
●
／ ＼
●───●
／ ＼ ／ ＼
●───○───●
／ ＼ ／ ＼ ／ ＼
●───●───●───●
／ ＼ ／ ＼ ／ ＼ ／ ＼
●───●───●───●───●───●───●
＼ ／ ＼ ／
● ●
図 : 変形三角盤
今回は上図のように 21 個のペグの中からひとつのペグを取り除き、最初の空き位置と最後に残ったペグの位置が同じになる「補償型の解」の最短手数を、反復深化で求めることにします。
ペグ・ソリテアの場合、ペグの「跳び先表」を用意すると簡単にプログラムできます。盤面は 1 次元配列を使って表し、座標を下図のように定義すると、跳び先表は次のようになります。
０───１
＼ ／
２
／ ＼
３───４
／ ＼ ／ ＼
５───６───７
／ ＼ ／ ＼ ／ ＼
８───９───10───11
／ ＼ ／ ＼ ／ ＼ ／ ＼
12───13───14───15───16───17───18
＼ ／ ＼ ／
19 20
図 : 変形三角盤の座標
リスト : 跳び先表
(defconstant jump-table
#(((2 4)) ; 0
((2 3)) ; 1
((3 5) (4 7)) ; 2
((2 1) (5 8) (6 10)) ; 3
((2 0) (6 9) (7 11)) ; 4
((3 2) (6 7) (8 13) (9 15)) ; 5
((9 14) (10 16)) ; 6
((4 2) (6 5) (10 15) (11 17)) ; 7
((5 3) (9 10) (13 19)) ; 8
((6 4) (10 11)) ; 9
((6 3) (9 8)) ; 10
((7 4) (10 9) (17 20)) ; 11
((13 14)) ; 12
((8 5) (14 15)) ; 13
((9 6) (13 12) (15 16)) ; 14
((9 5) (10 7) (14 13) (16 17)) ; 15
((10 6) (15 14) (17 18)) ; 16
((11 7) (16 15)) ; 17
((17 16)) ; 18
((13 8)) ; 19
((17 11)))) ; 20
跳び先表 jump-table の要素はリストです。そのリストの要素は、跳び越す位置と着地する位置を格納したリストです。たとえば、10 番のペグは 6 番を跳び越して 3 番に着地する跳び方と、9 番を跳び越して 8 番に着地する跳び方があります。
それでは、必要になる大域変数を定義します。次のリストを見てください。
リスト : 大域変数の定義 ;;; 定数 (defconstant size 21) (defconstant max-jump 19) ;;; 盤面 (defvar *board* (make-array size :initial-element t)) ;;; アクセス関数 (defun get-peg (x) (aref *board* x)) (defun put-peg (x) (setf (aref *board* x) t)) (defun del-peg (x) (setf (aref *board* x) nil)) ;;; 解の個数 (defvar *count-answer* 0)
盤面は配列 *board* で表します。ペグの有無は真偽値 (t, nil) で表します。探索はこの配列を直接書き換え、バックトラックする時に元の値に戻します。関数 get-peg, put-peg, del-peg は *board* にアクセスするための関数です。ペグが 19 回移動すると、盤上のペグはひとつになります。その値を max-jump で表します。
次に下限値を求める方法を考えましょう。ペグ・ソリテアの場合、コーナーにあるペグは他のペグから跳び越されることはありません。コーナーのペグは自分でジャンプするしか移動する方法がないのです。したがって、コーナーにペグが残っていれば、最低でもその個数だけ移動手数が必要になります。変形三角盤の場合、コーナーは 0, 1, 12, 18, 19, 20 の 6 つあります。これを下限値として利用することにしましょう。プログラムは次のようになります。
リスト : コーナーペグの個数を数える
(defun count-corner-peg ()
(reduce #'(lambda (a x) (if (get-peg x) (+ a 1) a))
'(0 1 12 18 19 20)
:initial-value 0))
関数 reduce でコーナーペグの個数をカウントするだけです。reduce は畳み込み (縮約) を行う関数です。詳しい説明は拙作のページ「Common Lisp 入門: 列関数」の「縮約」をお読みください。
プログラムのポイントは、ペグを跳び越す時に手数も同時に数えていくことです。直前に動かしたペグと違うペグを動かす時は手数をカウントし、同じペグを動かす時は手数をカウントしません。次のリストを見てください。
リスト : 下限値枝刈り法による探索
;;; 反復深化 (下限値枝刈り法)
(defun id-search (n jc limit move)
(when (<= (+ jc (count-corner-peg)) limit)
(if (= n max-jump)
(if (get-peg 6)
(print-move (reverse move)))
(dotimes (from size)
;; from にペグがある
(when (get-peg from)
(dolist (x (aref jump-table from))
(let ((del (first x)) (to (second x)))
;; del にペグがあり、to が空いている
(when (and (get-peg del) (not (get-peg to)))
;; ペグの移動
(del-peg from)
(del-peg del)
(put-peg to)
(id-search
(+ n 1)
(if (= from (cdar move)) jc (+ jc 1))
limit
(cons (cons from to) move))
;; 元に戻す
(put-peg from)
(put-peg del)
(del-peg to)))))))))
引数 n がペグの移動回数、jc が跳んだ回数、limit が反復深化の上限値を表します。move は移動手順を格納するリストで、その要素はコンスセル (移動元 . 移動先) です。
下限値は関数 count-corner-peg で求めます。跳んだ回数 jc と下限値の和が上限値 limit より多くなったならば、探索を打ち切ります。このとき、n が max-jump に達していたならば、盤上にはひとつのペグしか残っていません。それが最初の空き場所 (6 番目) にあるならば解の条件を満たします。関数 print-move で手順を表示します。
ペグが複数残っている場合は探索を続行します。ペグの移動処理も簡単です。動かすペグの位置を from とします。from の位置にペグがある場合、跳び先表から要素を順番に取り出して、跳び越す位置を del に、着地する位置を to にセットします。del の位置にペグがあり、to の位置が空いているならば、ペグを移動することができます。del-peg で from と del のペグを取り除き、put-peg で to の位置にペグをセットします。
id-search を再帰呼び出しする時は、前回移動したペグ (cdar move) と同じペグならば、跳んだ回数 jc をカウントしないことに注意してください。そして、再帰呼び出しから戻ってきたら、盤面を元の状態に戻します。
最後に id-search を呼び出す関数 solve を作ります。次のリストを見てください。
リスト : 変形三角盤の解法
(defun solve ()
;; 初手 14 -> 6
(del-peg 14)
(del-peg 9)
(do ((limit 6 (1+ limit)))
((> limit max-jump))
(format t "----- ~D -----~%" limit)
(id-search 1 1 limit (list (cons 14 6)))
(if (plusp *count-answer*)
(progn (print *count-answer*) (return)))))
最初に動かすことができるペグは 14 番と 16 番の 2 つがありますが、盤面は左右対称なので、初手は 14 番のペグを 6 番に動かすこととします。盤面 *board* は t に初期化されているので、14 番と 9 番のペグを del-peg で取り除きます。そして、上限値 limit を 1 手ずつ増やしながら id-search を呼び出します。コーナーペグは 6 個あるので、limit は 6 からスタートします。そして、*count-answer* が正であれば解が見つかったので、return で繰り返しから脱出します。
あとは特に難しいところはないので説明は割愛いたします。詳細はプログラムリストをお読みください。
それでは実行結果を示します。
----- 6 ----- ----- 7 ----- ----- 8 ----- ----- 9 ----- ----- 10 ----- ----- 11 ----- ----- 12 ----- [14,6][11,9][3,10][1,3][7,2][0,4][12,14,6][5,2,7,5,13][20,11,9][15,17][19,8,10][18,16,6] ・・・ 省略 ・・・ [14,6][11,9][3,10][12,14,6][20,11,9][15,17][1,3][7,2][0,4][5,7,2,5,13][19,8,10][18,16,6] 96
最短手数は 12 手、全部で 96 通りの解を見つけることができました。実行時間は SBCL 2.1.11, Ubunts 22.04 (WSL2), Intel Core i5-6200U 2.30GHz で 8.54 秒かかりました。ちなみに、下限値枝刈り法を使わないと 10 手の探索でさえ相当に時間がかかります。
ところで、下限値枝刈り法のほかに、ペグをグループに分けることで、さらに枝刈りを行うことができます。ペグは移動できる場所が決まっていて、下図に示すグループに分けることができます。
０───１
＼ ／
３
／ ＼
１───０
／ ＼ ／ ＼
３───２───３
／ ＼ ／ ＼ ／ ＼
１───０───１───０
／ ＼ ／ ＼ ／ ＼ ／ ＼
２───３───２───３───２───３───２
＼ ／ ＼ ／
１ ０
図 : ペグのグループ分け
盤面の座標と見比べてください。たとえば、座標 0 番のペグは 4, 9, 11, 20 番にしか移動することができません。逆にいえば、この場所にあるペグは、これ以外の場所へ移動することはできないのです。これらのペグをひとつのグループとして考えましょう。同じようにペグの移動場所によって、上図のように 4 つのグループに分けることができます。
ペグは移動しても所属するグループは変わりませんし、跳び越すペグは必ずほかのグループのペグになります。ここで、グループ 2 に注目してください。このグループのペグは、最後で 6 番にひとつだけ必要になります。すなわち、このグループのペグの個数が 0 になると、変形三角盤を解くことができないわけです。この枝刈りは簡単に実現できますね。
もうひとつ、グループ 3 とコーナーペグの個数に注目してください。コーナーペグの移動にはグループ 3 のペグが必要になりますが、コーナーペグの数は 6 つ、グループ 3 のペグの数も 6 つですから同じ個数しかありません。したがって、コーナー以外のペグがグループ 3 のペグを跳び越すと、コーナーペグの移動ができなくなります。つまり、3, 4, 8, 11, 14, 16 番のペグは、グループ 3 のペグを跳び越すことはできないのです。グループ 3 のペグを跳び越すことができるのはコーナーペグだけです。この枝刈りは跳び先表を変更することで実現できます。
グループ 2 のペグをチェックするプログラムは次のようになります。
リスト : group-2 のペグがあるか
(defun group2-exist ()
(dolist (x '(6 12 14 16 18))
(if (get-peg x) (return t))))
関数 group2-exist はグループ 2 に属するペグを順番に調べ、ペグがひとつでもある場合は t を、ペグがひとつもない場合は nil を返します。あとは id-search で下限値のチェックとともに group2-exist を呼び出して、グループ 2 のペグがあることを確認します。
実際に実行してみると、実行時間は 2.88 秒と約 1 / 3 までに短縮しました。それなりの効果がありましたが、まだまだ実行速度は遅いですね。そこで、今度は下限値の精度を改善してみることにしましょう。
今までは、コーナーにあるペグだけを注目していました。ところが、実際にコーナーペグを動かす場合、たとえば、0 番と 1 番のペグを動かすのであれば、2 番の位置に跳び越すペグが必要になります。この位置にペグがない場合、そこにペグを移動してからコーナーのペグを動かすことになります。つまり、それだけペグを移動する回数が増えることになるわけです。これを下限値として利用することにしましょう。
ただし、この方法には少々難しいところがあります。コーナーペグの移動に必要な最低手数は、単純に考えると表 1 のように 8 通りのパターンが考えられます。
表 1 : 移動手数 2番 1番 0番 |手数 ------------+---- 0 0 0 | 0 0 0 1 | 2 0 1 0 | 2 0 1 1 | 4 1 0 0 | 0 1 0 1 | 1 1 1 0 | 1 1 1 1 | 3 0 : ペグ無, 1 : ペグ有
たとえば、コーナーペグが 1 つある場合、2 番にペグがあると手数は 1 手ですが、2 番にペグがないと 2 手に増えます。コーナーペグが 2 つある場合、2 番にペグがあると手数は 3 手になり、2 番にペグがないと 4 手まで増えます。このように、2 番のペグを考慮することで、下限値の精度を高くすることができるわけです。
ところが、連続跳びが絡んでくると、この表を単純に適用することができません。次の図を見てください。
０───１
＼ ／
┌───２←──┐
(1)│ ／ ＼ │(3)
│ ３───４ │
↓／ ＼ ／ ＼│
５───６───７
│ ↑
└───────┘
(2)
図 : グループ 3 のペグの連続跳び
たとえば、0, 1 番のコーナーにペグがあり、2 番のペグが 5 番へ跳ぶことを考えましょう (1)。すると、最低手数は 3 手 から 4 手へ増えることになります。この時点で、枝刈りされることもあるはずです。
ここで、ペグの連続跳びは 1 手に数えることを思い出してください。ペグは 5 番から 7 番へ跳び (2)、7 番から 2 番へ跳ぶ (3)、という連続跳びにより、元の位置に戻ることがあります。この場合、最低手数は 3 手に戻りますね。連続跳びは 1 手に数えるので、5 番の位置に移動した時点で枝刈りが行われると、条件を満たす可能性のある手順までもが枝刈りされてしまうのです。
そこで、下限値の精度は少し悪くなりますが、グループ 3 のペグが跳んでいる時は表 1 を適用せずに、コーナーペグの個数だけを下限値とすることにします。今回は簡単な方法を選びましたが、このほかにも deepgreen 氏がより精度の高い方法を考案されています。興味のある方は拙作のページ「ゲストブック (NO.103)」をお読みください。
下限値を求めるプログラムは簡単です。次のリストを見てください。
リスト : 下限値の計算
;;; ペグのグループ分け
(defconstant group
#( 0 1
3
1 0
3 2 3
1 0 1 0
2 3 2 3 2 3 2
1 0))
;;; 下限値の計算
(defun lower-value-sub (a b c)
(aref #(0 2 2 4 0 1 1 3)
(+ (if (get-peg a) 1 0)
(if (get-peg b) 2 0)
(if (get-peg c) 4 0))))
(defun lower-value (prev)
(if (= (aref group prev) 3)
(count-corner-peg)
(+ (lower-value-sub 0 1 2)
(lower-value-sub 12 19 13)
(lower-value-sub 18 20 17))))
ペグのグループ分けは配列 group で表します。下限値の計算は関数 lower-value で行います。引数 prev は直前に跳んだペグの位置を表します。prev がグループ 3 のペグの場合、下限値はコーナーペグの個数になります。そうでなければ、関数 lower-value-sub でコーナーにあるペグから移動手数を求め、それらを足した値が下限値となります。
さっそく実行してみると、実行時間は 2.86 秒から 0.86 秒に短縮しました。下限値枝刈り法の場合、下限値の精度によって実行時間が大きく左右されることがよくわかります。
;;;
;;; peg21.lisp : ペグ・ソリテア (変形三角盤)
;;;
;;; Copyright (C) 2010-2023 Makoto Hiroi
;;;
;;; 跳び先表
(defconstant jump-table
#(((2 4)) ; 0
((2 3)) ; 1
((3 5) (4 7)) ; 2
((6 10)) ; 3 (グループ分けによる枝刈り)
; ((2 1) (5 8) (6 10)) ; 3
((6 9)) ; 4 (グループ分けによる枝刈り)
; ((2 0) (6 9) (7 11)) ; 4
((3 2) (6 7) (8 13) (9 15)) ; 5
((9 14) (10 16)) ; 6
((4 2) (6 5) (10 15) (11 17)) ; 7
((9 10)) ; 8 (グループ分けによる枝刈り)
; ((5 3) (9 10) (13 19)) ; 8
((6 4) (10 11)) ; 9
((6 3) (9 8)) ; 10
((10 9)) ; 11 (グループ分けによる枝刈り)
; ((7 4) (10 9) (17 20)) ; 11
((13 14)) ; 12
((8 5) (14 15)) ; 13
((9 6)) ; 14 (グループ分けによる枝刈り)
; ((9 6) (13 12) (15 16)) ; 14
((9 5) (10 7) (14 13) (16 17)) ; 15
((10 6)) ; 16 (グループ分けによる枝刈り)
; ((10 6) (15 14) (17 18)) ; 16
((11 7) (16 15)) ; 17
((17 16)) ; 18
((13 8)) ; 19
((17 11)))) ; 20
;;; 定数
(defconstant size 21)
(defconstant max-jump 19)
(defconstant group
#( 0 1
3
1 0
3 2 3
1 0 1 0
2 3 2 3 2 3 2
1 0))
;;; 盤面
(defvar *board* (make-array size :initial-element t))
;;; アクセス関数
(defun get-peg (x) (aref *board* x))
(defun put-peg (x) (setf (aref *board* x) t))
(defun del-peg (x) (setf (aref *board* x) nil))
;;; 解の個数
(defvar *count-answer* 0)
;;; コーナーペグの個数を数える
(defun count-corner-peg ()
(reduce #'(lambda (a x) (if (get-peg x) (+ a 1) a))
'(0 1 12 18 19 20)
:initial-value 0))
;;; group-2 のペグがあるか
(defun group2-exist ()
(dolist (x '(6 12 14 16 18))
(if (get-peg x) (return t))))
;;; 下限値の計算
(defun lower-value-sub (a b c)
(aref #(0 2 2 4 0 1 1 3)
(+ (if (get-peg a) 1 0)
(if (get-peg b) 2 0)
(if (get-peg c) 4 0))))
(defun lower-value (prev)
(if (= (aref group prev) 3)
(count-corner-peg)
(+ (lower-value-sub 0 1 2)
(lower-value-sub 12 19 13)
(lower-value-sub 18 20 17))))
;;; 手順の表示
(defun print-move (move)
(incf *count-answer*)
(let ((prev (cdar move)))
;; 初手を表示
(format t "[~D,~D" (caar move) prev)
;; 2 手目以降を表示する
(dolist (x (cdr move))
(cond ((= prev (car x))
;; 同じ駒が続けて跳ぶ
(setq prev (cdr x))
(format t ",~D" prev))
(t
(setq prev (cdr x))
(format t "][~D,~D" (car x) prev))))
(format t "]~%")))
;;; 反復深化 (下限値枝刈り法)
(defun id-search (n jc limit move)
(when
(and (<= (+ jc (lower-value (cdar move))) limit)
(group2-exist))
(if (= n max-jump)
(if (get-peg 6)
(print-move (reverse move)))
(dotimes (from size)
;; from にペグがある
(when (get-peg from)
(dolist (x (aref jump-table from))
(let ((del (first x)) (to (second x)))
;; del にペグがあり、to が空いている
(when (and (get-peg del) (not (get-peg to)))
;; ペグの移動
(del-peg from)
(del-peg del)
(put-peg to)
(id-search
(+ n 1)
(if (= from (cdar move)) jc (+ jc 1))
limit
(cons (cons from to) move))
;; 元に戻す
(put-peg from)
(put-peg del)
(del-peg to)))))))))
(defun solve ()
;; 初手 14 -> 6
(del-peg 14)
(del-peg 9)
(do ((limit (lower-value 6) (1+ limit)))
((> limit max-jump))
(format t "----- ~D -----~%" limit)
(id-search 1 1 limit (list (cons 14 6)))
(if (plusp *count-answer*)
(progn (print *count-answer*) (return)))))