今回はパズル「フリップ・イット」の解法プログラムを Common Lisp で作ってみましょう。
「フリップ・イット (Flip It)」は芦ヶ原伸之氏が考案されたパズルで、すべての駒を裏返しにするのが目的です。今回はリバーシの駒を使うことにしましょう。次の図を見てください。
０ １ ２ ３ ４ ５ ０ １ ２ ３ ４ ５
┌─┬─┬─┬─┬─┬─┐ ┌─┬─┬─┬─┬─┬─┐
│ │●│●│●│●│●│ │●│○│○│○│○│ │
└─┴─┴─┴─┴─┴─┘ └─┴─┴─┴─┴─┴─┘
│ │
┌─────────┘ └─────┐
↓ ↓
┌─┬─┬─┬─┬─┬─┐ ┌─┬─┬─┬─┬─┬─┐
│●│○│○│○│○│ │ │●│○│ │●│●│○│
└─┴─┴─┴─┴─┴─┘ └─┴─┴─┴─┴─┴─┘
５の駒が０へ跳んだ場合 ２の駒が５へ跳んだ場合
図 : フリップ・イットのルール
フリップ・イットのルールは簡単です。ある駒は他の駒を跳び越して空き場所へ移動することができます。空き場所の隣にある駒は、跳び越す駒がないので移動できません。このとき、跳び越された駒は裏返しにされますが、跳んだ駒はそのままです。図では 5 の位置にある駒が 0 へ跳び、それから 2 の駒が 5 へ跳んだ場合を示しています。このあと 0 -> 2, 5 -> 0 と跳ぶと、すべての駒を白にすることができます。それでは問題です。
┌─┬─┬─┬─┬─┬─┐
(A) │●│●│ │●│●│●│
└─┴─┴─┴─┴─┴─┘
┌─┬─┬─┬─┬─┬─┬─┐
(B) │●│ │○│●│●│●│●│
└─┴─┴─┴─┴─┴─┴─┘
┌─┬─┬─┬─┬─┬─┬─┬─┐
(C) │●│ │○│○│○│●│●│●│
└─┴─┴─┴─┴─┴─┴─┴─┘
問題 : フリップ・イット
参考文献 [1] の問題は 4 つの駒を使っているので、ここでは駒の個数を増やしてみました。すべての駒を白にする最短手順を求めてください。
それではプログラムを作りましょう。アルゴリズムは単純な反復深化を使います。盤面は Lisp らしくリストで表しましょう。要素はシンボルで、nil が黒、t が白、space が空き場所を表します。
最初に、駒を動かして新しい盤面を生成する関数 move-piece を作ります。次のリストを見てください。
リスト : 駒の移動
(defun move-piece (n board piece start end)
(cond ((null board) nil)
((or (= n start) (= n end))
(cons (if (eq (car board) 'space) piece 'space)
(move-piece (1+ n) (cdr board) piece start end)))
((< start n end)
(cons (not (car board))
(move-piece (1+ n) (cdr board) piece start end)))
(t (cons (car board)
(move-piece (1+ n) (cdr board) piece start end)))))
引数 n が盤面の位置、board が盤面、piece が移動する駒の種類、start と end (start < end) が移動する駒の位置と空き場所の位置です。move-piece は board をコピーするとともに、start と end の間の駒を裏返しにして、start と end の位置にある piece と space を入れ替えます。駒の裏返しは not を使えば簡単です。
次は、反復深化で最短手順を探索する関数 solve-id を作ります。
リスト : 反復深化による探索
(defun solve-id (n limit board space history)
(if (= limit n)
(when (zerop (count nil board))
(print-answer board history)
(throw 'find-answer t))
(dotimes (x (length board))
(when (and (not (eql (cdar history) x))
(or (< x (1- space)) (< (1+ space) x)))
;; 移動可能
(solve-id (1+ n)
limit
(move-piece 0 board (nth x board) (min x space) (max x space))
x
(cons (cons x space) history))))))
引数 n が手数、limit が反復深化の上限値、board が盤面、space が空き場所の位置、history が移動手順を表すリストです。history の要素はドット対 (動かす駒の位置 . 空き場所の位置) です。
手数 n が上限値 limit になったならば、駒がすべて白になったかチェックします。関数 count で nil の個数を数え、その値が 0 であれば黒の駒はありません。関数 print-answer で手順を表示してから、throw で大域脱出して探索を終了します。
フリップ・イットは、同じ駒を続けて動かすと元の状態に戻ってしまいます。そこで、動かす駒の位置 x が 1 手前の空き場所の位置 (cdar history) と同じ場合は、その駒を動かさないようにします。history の初期値は nil なので、比較には eql を使っています。このチェックがないと実行時間がとても遅くなります。ご注意くださいませ。
それから、フリップ・イットのルールでは、空き場所の隣の駒は動かすことができません。この条件を (or (< x (1- space)) (< (1+ space) x)) でチェックしています。ルールを「空き場所の隣の駒を動かしてもよい」ことに変更する場合は、(or ... ) の部分を (/= x space) に修正してください。
最後に、solve-id を呼び出す関数 flip-it-solver と手順を表示する関数 print-answer を作ります。
リスト : 「フリップ・イット」解法プログラム
;;; 盤面を表示
(defun print-board (board)
(let ((code '((nil . "●") (t . "○") (space . "＿"))))
(dolist (piece board (terpri))
(format t "~A " (cdr (assoc piece code))))))
;;; 手順を表示
(defun print-answer (board history)
(let ((s (caar history))
(p (cdar history)))
(if history
(print-answer (move-piece 0 board (nth p board) (min p s) (max p s))
(cdr history)))
(print-board board)))
;;; フリップ・イットを解く
(defun flip-it-solver (start)
(catch 'find-answer
(dotimes (limit 20)
(format t "***** ~D 手を探索 *****~%" (1+ limit))
(solve-id 0 (1+ limit) start (position 'space start) nil))))
flip-it-solver は、反復深化の上限値 limit を 1 手ずつ増やして solve-id を呼び出すだけです。print-answer は history から盤面を再現して手順を表示します。引数 board が現在の盤面で history が移動手順です。再帰呼び出しで最初の状態に戻してから print-board で盤面を表示します。盤面 board を 1 手前に戻すとき、history の先頭要素を (s . p) とすると、board の p の位置に駒があり、s の位置が空き場所であることに注意してください。
これでプログラムは完成です。詳細はプログラムリスト１をお読みください。
それでは、「フリップ・イット」の解答を示します。図では空き場所を ＿ で表しています。
（Ａ） （Ｂ） （Ｃ）
0: ● ● ＿ ● ● ● ● ＿ ○ ● ● ● ● ● ＿ ○ ○ ○ ● ● ●
1: ＿ ○ ● ● ● ● ● ● ● ＿ ● ● ● ● ○ ● ＿ ○ ● ● ●
2: ● ● ○ ＿ ● ● ＿ ○ ○ ● ● ● ● ＿ ● ○ ● ○ ● ● ●
3: ● ● ○ ● ○ ＿ ○ ● ＿ ● ● ● ● ○ ○ ＿ ● ○ ● ● ●
4: ● ● ＿ ○ ● ○ ○ ● ● ○ ＿ ● ● ○ ○ ○ ○ ＿ ● ● ●
5: ＿ ○ ● ○ ● ○ ○ ● ● ○ ● ○ ＿ ○ ○ ○ ○ ● ○ ○ ＿
6: ○ ● ○ ＿ ● ○ ○ ● ● ＿ ○ ● ○ ＿ ● ● ● ○ ● ● ○
7: ○ ＿ ● ● ● ○ ○ ● ● ● ● ＿ ○ ○ ○ ○ ○ ＿ ● ● ○
8: ○ ○ ○ ○ ○ ＿ ＿ ○ ○ ○ ○ ○ ○ ○ ○ ○ ○ ○ ○ ○ ＿
図 : フリップ・イットの解答
(A), (B), (C) ともに最短手数は 8 手になりました。実は、これが最長手数の局面となります。ちなみに、駒の個数が 4 つの場合だと、最長手数は 10 手と長くなります。また、最後の白石の位置を限定すると、手数が長くなる場合もあります。たとえば、(A) の問題でゴールを "＿ ○ ○ ○ ○ ○" とすると、最短手数は 9 手になります。興味のある方は、いろいろと試してみてください。
次は、最長手数の局面を幅優先探索で求めてみましょう。最初に、キューの大きさを決めるため石の置き方が何通りあるか数えます。これは空き場所の配置から考えた方が簡単です。盤面の大きさを N とすると、空き場所の配置は N 通りあります。残りは黒石か白石のどちらかなので、石の配置は 2 N - 1 通りあります。したがって、全体では N * 2 N - 1 通りになります。
実際に計算してみると、N = 6 で 192 通り、N = 7 で 448 通り、N = 8 で 1024 通りになります。大きな数ではないので、同一局面のチェックは線形探索でいいでしょう。プログラムは次のようになります。
リスト : 「フリップ・イット」最長手数の探索
;;; 解の表示
(defun print-answer-max (n move-table state-table)
(let ((max (aref move-table n)))
(format t "最長手数 ~D 手~%" max)
(loop
(print (aref state-table n))
(decf n)
(if (/= max (aref move-table n)) (return)))))
;;; 最長手数の探索
(defun solve-max (board-size)
(let* ((max-state (* (expt 2 (1- board-size)) board-size))
(state-table (make-array max-state)) ; 盤面
(space-table (make-array max-state)) ; 空き場所の位置
(move-table (make-array max-state)) ; 手数
(rear 0)
(front 0)
board new-board space)
;; キューの初期化
(dotimes (x board-size)
(setf board (make-list board-size :initial-element t)
(nth x board) 'space
(aref state-table rear) board
(aref space-table rear) x
(aref move-table rear) 0)
(incf rear))
;; 探索
(do ()
((>= front rear))
(setq board (aref state-table front)
space (aref space-table front))
(dotimes (x board-size)
(when (or (< x (1- space)) (< (1+ space) x))
;; 移動可能
(setq new-board (move-piece 0 board (nth x board) (min x space) (max x space)))
(unless (find new-board state-table :test #'equal)
;; キューに登録
(setf (aref state-table rear) new-board
(aref space-table rear) x
(aref move-table rear) (1+ (aref move-table front)))
(incf rear))))
(incf front))
;; 解の表示
(format t "状態数 ~D 個~%" rear)
(print-answer-max (1- rear) move-table state-table)))
関数 solve-max には盤面のサイズを渡します。最初に、キューの大きさを計算して変数 max-state にセットします。キューはベクタを使って定義します。state-table が盤面、space-table が空き場所の位置、move-table が移動手数を格納します。それぞれ make-array でベクタを生成して変数にセットします。
次に、キューを初期化します。ゴールの条件である「すべての石が白の盤面」を生成してキューにセットすれば OK です。make-list で要素が t のリストを生成して変数 board にセットし、空き場所の位置 x の要素を space に書き換えます。そして、盤面 board を state-table に、空き場所の位置 x を space-table に、手数 0 を move-table にセットします。キューを管理する変数 rear をインクリメントすることもお忘れなく。
あとは単純な幅優先探索です。同一局面のチェックには関数 find を使っています。比較するデータはリストなので、キーワード :test には #'equal を指定します。あとは特に難しいところはないでしょう。詳細はプログラムリスト２をお読みくださいませ。
実行結果は次のようになりました。
(solve-max 5) (solve-max 6)
状態数 80 個 状態数 192 個
最長手数 10 手 最長手数 8 手
● ● ○ ＿ ● ● ＿ ○ ● ● ●
● ● ＿ ● ● ● ● ＿ ● ● ●
● ＿ ○ ● ● ● ● ● ○ ＿ ●
nil ● ● ● ＿ ● ●
nil
(solve-max 7) (solve-max 8)
状態数 448 個 状態数 1024 個
最長手数 8 手 最長手数 8 手
● ● ● ● ○ ＿ ● ● ● ＿ ● ● ● ● ●
● ● ● ● ＿ ● ● ● ＿ ○ ● ● ● ● ●
● ● ＿ ● ● ● ● ● ＿ ○ ○ ○ ● ● ●
● ＿ ○ ● ● ● ● ● ● ● ● ● ○ ＿ ●
nil ● ● ● ● ● ＿ ● ●
● ● ● ○ ○ ○ ＿ ●
nil
図 : フリップ・イットの最長手数
フリップ・イットの場合、盤面を大きくしたからといって、最長手数が長くなるとは限らないようです。興味のある方は、より大きな盤面で試してみてください。
ところで、フリップ・イットのルールでは空き場所の隣の駒を動かすことはできません。ルールを「空き場所の隣の駒を動かしてもよい」ことに変更して最長手数の局面を求めてみたところ、結果は次のようになりました。
(solve-max 5) (solve-max 6) (solve-max 7)
状態数 80 個 状態数 192 個 状態数 448 個
最長手数 6 手 最長手数 6 手 最長手数 7 手
● ● ＿ ● ● ● ● ＿ ● ● ● ● ● ● ＿ ● ● ●
nil ● ● ○ ＿ ● ● ● ● ● ○ ＿ ● ●
● ＿ ○ ● ● ● ● ● ＿ ○ ● ● ●
● ● ● ＿ ● ● nil
● ● ● ○ ＿ ●
● ● ＿ ○ ● ●
nil
図 : フリップ・イットの最長手数（別ルール）
(solve-max 8) の結果は、局面が多数あるため省略しましたが、最長手数は 7 手になりました。どうやら、このルールの方が簡単に解くことができるようです。
;;;
;;; flipit.lisp : フリップ・イット 反復深化による解法
;;;
;;; Copyright (C) 2003-2023 Makoto Hiroi
;;;
;;;
;;; 盤面を表示
;;;
(defun print-board (board)
(let ((code '((nil . "●") (t . "○") (space . "＿"))))
(dolist (piece board (terpri))
(format t "~A " (cdr (assoc piece code))))))
;;;
;;; 駒を動かす
;;;
(defun move-piece (n board piece start end)
(cond ((null board) nil)
((or (= n start) (= n end))
(cons (if (eq (car board) 'space) piece 'space)
(move-piece (1+ n) (cdr board) piece start end)))
((< start n end)
(cons (not (car board))
(move-piece (1+ n) (cdr board) piece start end)))
(t (cons (car board)
(move-piece (1+ n) (cdr board) piece start end)))))
;;;
;;; 手順を表示
;;;
(defun print-answer (board history)
(let ((s (caar history))
(p (cdar history)))
(if history
(print-answer (move-piece 0 board (nth p board) (min p s) (max p s))
(cdr history)))
(print-board board)))
;;;
;;; 反復深化による探索
;;;
(defun solve-id (n limit board space history)
(if (= limit n)
(when (zerop (count nil board))
(print-answer board history)
(throw 'find-answer t))
(dotimes (x (length board))
(when (and (not (eql (cdar history) x))
(or (< x (1- space)) (< (1+ space) x)))
;; 移動可能
(solve-id (1+ n)
limit
(move-piece 0 board (nth x board) (min x space) (max x space))
x
(cons (cons x space) history))))))
;;;
;;; フリップ・イットを解く
;;;
(defun flip-it-solver (start)
(catch 'find-answer
(dotimes (limit 20)
(format t "***** ~D 手を探索 *****~%" (1+ limit))
(solve-id 0 (1+ limit) start (position 'space start) nil))))
;;;
;;; flipmax.lisp : フリップ・イット 最長手数の探索
;;;
;;; Copyright (C) 2003-2023 Makoto Hiroi
;;;
;;;
;;; 駒を動かす
;;;
(defun move-piece (n board piece start end)
(cond ((null board) nil)
((or (= n start) (= n end))
(cons (if (eq (car board) 'space) piece 'space)
(move-piece (1+ n) (cdr board) piece start end)))
((< start n end)
(cons (not (car board))
(move-piece (1+ n) (cdr board) piece start end)))
(t (cons (car board)
(move-piece (1+ n) (cdr board) piece start end)))))
;;;
;;; 盤面を表示
;;;
(defun print-board (board)
(let ((code '((nil . "●") (t . "○") (space . "＿"))))
(dolist (piece board (terpri))
(format t "~A " (cdr (assoc piece code))))))
;;;
;;; 解の表示
;;;
(defun print-answer-max (n move-table state-table)
(let ((max (aref move-table n)))
(format t "最長手数 ~D 手~%" max)
(loop
(print-board (aref state-table n))
(decf n)
(if (/= max (aref move-table n)) (return)))))
;;;
;;; 最長手数の探索
;;;
(defun solve-max (board-size)
(let* ((max-state (* (expt 2 (1- board-size)) board-size))
(state-table (make-array max-state)) ; 盤面
(space-table (make-array max-state)) ; 空き場所の位置
(move-table (make-array max-state)) ; 手数
(rear 0)
(front 0)
board new-board space)
;; キューの初期化
(dotimes (x board-size)
(setf board (make-list board-size :initial-element t)
(nth x board) 'space
(aref state-table rear) board
(aref space-table rear) x
(aref move-table rear) 0)
(incf rear))
;; 探索
(do ()
((>= front rear))
(setq board (aref state-table front)
space (aref space-table front))
(dotimes (x board-size)
(when (or (< x (1- space)) (< (1+ space) x))
;; 移動可能
(setq new-board (move-piece 0 board (nth x board) (min x space) (max x space)))
(unless (find new-board state-table :test #'equal)
;; キューに登録
(setf (aref state-table rear) new-board
(aref space-table rear) x
(aref move-table rear) (1+ (aref move-table front)))
(incf rear))))
(incf front))
;; 解の表示
(format t "状態数 ~D 個~%" rear)
(print-answer-max (1- rear) move-table state-table)))
今回はパズル「変形魔方陣」の解法プログラムを Common Lisp で作ってみましょう。
それでは問題です。
┌─┬─┬─┐ 式
│Ａ│Ｂ│Ｃ│ A + B + E + D = N
├─┼─┼─┤ B + C + F + E = N
│Ｄ│Ｅ│Ｆ│ D + E + H + G = N
├─┼─┼─┤ E + F + I + H = N
│Ｇ│Ｈ│Ｉ│ A + C + I + G = N
└─┴─┴─┘
図 : 変形魔方陣
上図の A から I の場所に 1 から 9 までの数字をひとつずつ配置します。図では、A - B - E - D のように 2 * 2 マスの正方形が 4 つ、大きな正方形 (A - C - I - G) がひとつあります。魔方陣は縦横斜めの合計が等しくなるように数字を配置しますが、今回は上図の式で表すように、正方形の頂点の合計が等しくなるような配置を見つけてください。
出典は 『Ｃマガ電脳クラブ第 92 回 変形魔方陣』, C MAGAZINE 1998 年 8 月号, ソフトバンク です。Ｃマガ電脳クラブの問題は、2 * 2 マスの数字の合計が等しくなることが条件でしたが、今回は大きな正方形も条件に加えてみました。
プログラムを作る場合、対称解のチェックは面倒だと思われる方もいるでしょう。ところが、下図のように四隅の大小関係を利用すると簡単です。
┌─┬─┬─┐ │Ａ│Ｂ│Ｃ│ ├─┼─┼─┤ A < C < G │Ｄ│Ｅ│Ｆ│ ├─┼─┼─┤ A < I │Ｇ│Ｈ│Ｉ│ └─┴─┴─┘ 図 : 対称解のチェック
魔方陣の場合、回転解が 4 種類あって、鏡像解が 2 種類あります。四隅の大小関係をチェックすることで、これらの対称解を排除することができます。また、早い段階で枝刈りを行うため、盤面の番号と試行順序を工夫します。
┌─┬─┬─┐
│０│４│１│ (1) B[0] + B[1] + B[2] + B[3] = N
├─┼─┼─┤ (2) B[0] + B[4] + B[5] + B[6] = N
│５│６│７│ (3) B[1] + B[4] + B[6] + B[7] = N
├─┼─┼─┤ (4) B[2] + B[5] + B[6] + B[8] = N
│２│８│３│ (4) B[3] + B[6] + B[7] + B[8] = N
└─┴─┴─┘
図 : 盤面の番号と試行順序
盤面を 1 次元配列 B で表すことにします。試行順序を上図のように定義し、配列の添字と対応させます。そうすると、最初に四隅 (0, 1, 2, 3) の数字が選択されますね。ここで対称解のチェックが行われるので、枝刈りの効率は良くなります。また、数字の合計値 N も決めることができるので、あとは 2 * 2 マスの正方形が完成したら、合計値が N と等しいかチェックしていくだけです。
プログラムは次のようになります。配列を使っているので Lisp らしくありませんが、ほかのプログラミング言語に移植するのは簡単でしょう。興味のある方は挑戦してみてください。
リスト : 解法プログラム
;;; 盤面
(defvar *board* (make-array 9))
;;; 解の表示
(defun print-answer ()
(format t "~D ~D ~D~%~D ~D ~D~%~D ~D ~D~%~%"
(aref *board* 0) (aref *board* 4) (aref *board* 1)
(aref *board* 5) (aref *board* 6) (aref *board* 7)
(aref *board* 2) (aref *board* 8) (aref *board* 3)))
;;; 4 つの数字を足し算する
(defun add-number (a b c d)
(+ (aref *board* a) (aref *board* b) (aref *board* c) (aref *board* d)))
;;; 枝刈り
(defun checkp (n value)
(or (and (= n 1) (> (aref *board* 0) (aref *board* 1)))
(and (= n 2) (> (aref *board* 1) (aref *board* 2)))
(and (= n 3) (> (aref *board* 0) (aref *board* 3)))
(and (= n 6) (/= value (add-number 0 4 5 6)))
(and (= n 7) (/= value (add-number 1 4 6 7)))))
;;; 解法
(defun solve (&optional (n 0) (numbers '(1 2 3 4 5 6 7 8 9)) value)
(dolist (x numbers)
(setf (aref *board* n) x)
;; 枝刈り
(unless (checkp n value)
;; value のセット
(if (= n 3)
(setq value (add-number 0 1 2 3)))
;; 解けたか
(cond ((= n 8)
(if (= value (add-number 2 5 6 8) (add-number 3 6 7 8))
(print-answer)))
(t (solve (1+ n) (remove x numbers) value))))))
次は 8 個の数字を使う魔方陣です。それでは問題です。
┌─┬─┬─┐
│Ａ│Ｂ│Ｃ│ 式
├─┼─┼─┤ A + B + C = N
│Ｄ│ │Ｅ│ A + D + F = N
├─┼─┼─┤ C + E + H = N
│Ｆ│Ｇ│Ｈ│ F + G + H = N
└─┴─┴─┘
図 : 変形魔方陣
上図の A から H の場所に 1 から 8 までの数字をひとつずつ配置します。4 辺の合計が等しくなるような配置を見つけてください。なお、合計の値 (N) は 12, 13, 14, 15 の 4 通りの場合があります。
プログラムの作成は簡単です。問題１のプログラムを改造するだけです。特に難しいところはないので、説明は省略いたします。詳細はプログラムリストをお読みくださいませ。
ところで、問題２は数字 { 1, 2, 3, 4, 5, 6, 7, 8 } を使いましたが、数字を奇数 { 1, 3, 5, 7, 9, 11, 13, 15 } にする、または、数字を偶数 { 2, 4, 6, 8, 10, 12, 14, 16 } にするとどうなるでしょうか。実は、問題２の答えがわかると簡単に解くことができます。答えを見る前に、ちょっと考えてみてくださいね。
最後は素数を使った変形魔方陣です。
┌─┬─┬─┐
│Ａ│Ｂ│Ｃ│ 式
├─┼─┼─┤ A + B + C = N
│Ｄ│ │Ｅ│ A + D + F = N
├─┼─┼─┤ C + E + H = N
│Ｆ│Ｇ│Ｈ│ F + G + H = N
└─┴─┴─┘
図 : 素数の変形魔方陣
上図の A から H の場所に素数 { 3, 5, 7, 11, 13, 17, 19, 23 } をひとつずつ配置します。4 辺の合計が等しくなるような配置を見つけてください。なお、合計の値 (N) も素数になります。
;;;
;;; magic2.lisp : 変形魔方陣の解法プログラム
;;;
;;; Copyright (C) 2005-2023 Makoto Hiroi
;;;
;;; 盤面
;;;
;;; ０４１
;;; ５ ６ 0 < 1 < 2, 0 < 3
;;; ２７３
;;;
(defvar *board* (make-array 8))
;;; 数字を足し算する
(defun add-number (n1 n2 n3)
(+ (aref *board* n1) (aref *board* n2) (aref *board* n3)))
;;; 解の表示
(defun print-answer (rest-num)
(format t "Rest ~A, Sum ~D~%" rest-num (add-number 0 4 1))
(format t "~2D ~2D ~2D~%~2D ~2D~%~2D ~2D ~2D~%~%"
(aref *board* 0) (aref *board* 4) (aref *board* 1)
(aref *board* 5) (aref *board* 6)
(aref *board* 2) (aref *board* 7) (aref *board* 3)))
;;; 枝刈り
(defun checkp (n value)
(or (and (= n 1) (> (aref *board* 0) (aref *board* 1)))
(and (= n 2) (> (aref *board* 1) (aref *board* 2)))
(and (= n 3) (> (aref *board* 0) (aref *board* 3)))
(and (= n 5) (/= value (add-number 0 5 2)))
(and (= n 6) (/= value (add-number 1 6 3)))))
;;; 解法
(defun solve (&optional (n 0) (numbers '(1 2 3 4 5 6 7 8)) value)
(dolist (x numbers)
(setf (aref *board* n) x)
;; 枝刈り
(unless (checkp n value)
;; value のセット
(if (= n 4)
(setq value (add-number 0 1 4)))
;; 解けたか
(cond ((= n 7)
(if (= value (add-number 2 7 3))
(print-answer (remove x numbers))))
(t (solve (1+ n) (remove x numbers) value))))))
対称解（回転解と鏡像解）を除くと、解は下図の 1 通りしかありません。
┌─┬─┬─┐ │１│８│３│ ├─┼─┼─┤ │６│５│４│ ├─┼─┼─┤ │７│２│９│ └─┴─┴─┘
解の個数は対称解（回転解と鏡像解）を除いた場合です。
┌─┬─┬─┐ │１│８│３│ ├─┼─┼─┤ │５│ │７│ ├─┼─┼─┤ │６│４│２│ └─┴─┴─┘
┌─┬─┬─┐ ┌─┬─┬─┐ │１│７│５│ │１│８│４│ ├─┼─┼─┤ ├─┼─┼─┤ │４│ │６│ │７│ │３│ ├─┼─┼─┤ ├─┼─┼─┤ │８│３│２│ │５│２│６│ └─┴─┴─┘ └─┴─┴─┘
┌─┬─┬─┐ ┌─┬─┬─┐ │１│６│７│ │３│７│４│ ├─┼─┼─┤ ├─┼─┼─┤ │５│ │３│ │６│ │２│ ├─┼─┼─┤ ├─┼─┼─┤ │８│２│４│ │５│１│８│ └─┴─┴─┘ └─┴─┴─┘
┌─┬─┬─┐ │３│５│７│ ├─┼─┼─┤ │４│ │２│ ├─┼─┼─┤ │８│１│６│ └─┴─┴─┘
偶数 { 2, 4, 6, 8, 10, 12, 14, 16 } の場合は、問題２の数字を 2 倍することで求めることができます。奇数 { 1, 3, 5, 7, 9, 11, 13, 15 } の場合は、数字を 2 倍して -1 することで求めることができます。下図に一例を示します。
┌─┬─┬─┐ ┌─┬─┬─┐ ┌─┬─┬─┐ │１│８│３│ │２│16│６│ │１│15│５│ ├─┼─┼─┤ ├─┼─┼─┤ ├─┼─┼─┤ │５│ │７│ │10│ │14│ │９│ │13│ ├─┼─┼─┤ ├─┼─┼─┤ ├─┼─┼─┤ │６│４│２│ │12│８│４│ │11│７│３│ └─┴─┴─┘ └─┴─┴─┘ └─┴─┴─┘ 問題２の解 （Ａ）偶数の場合 （Ｂ）奇数の場合
┌─┬─┬─┐ 合計値 N = 31（素数） │３│23│５│ ├─┼─┼─┤ │17│ │19│ ├─┼─┼─┤ │11│13│７│ └─┴─┴─┘