N Queens Problem
「8 クイーン」はコンピュータに解かせるパズルの中でも特に有名な問題です。8 クイーンは 8 行 8 列のチェスの升目に、8 個のクイーンを互いの利き筋が重ならないように配置する問題です。クイーンは将棋の飛車と角をあわせた駒で、縦横斜めに任意に動くことができます。解答の一例を示します。
図 : 8 クイーンの解答例
N Queens Problem は「8 クイーン」の拡張バージョンで、N 行 N 列の盤面に N 個のクイーンを互いの利き筋が重ならないように配置する問題です。まず最初に、8 クイーンを解くプログラムから作ってみましょう。
●8 クイーンの解法
8 クイーンを解くには、すべての置き方を試してみるしか方法はありません。最初のクイーンは、盤上の好きなところへ置くことができるので、64 通りの置き方があります。次のクイーンは 63 通り、その次は 62 通りあります。したがって、置き方の総数は 64 から 57 までの整数を掛け算した 178462987637760 通りもあります。
ところが、解答例を見ればわかるように、同じ行と列に 2 つ以上のクイーンを置くことはできません。上図の解答例をリストを使って表すと、 次のようになります。
1 2 3 4 5 6 7 8 <--- 列の位置
---------------------------
(1 7 5 8 2 4 6 3) <--- 要素が行の位置を表す
図 : リストでの行と列の表現方法
列をリストの位置に、行番号を要素に対応させれば、各要素には 1 から 8 までの数字が重複しないで入ることになります。すなわち、1 から 8 までの順列の総数である 8! = 40320 通りの置き方を調べるだけでよいのです。パズルを解く場合は、そのパズル固有の性質をうまく使って、調べなければならない場合の数を減らすように工夫することが大切です。
可能性のあるデータをもれなく作るような場合、バックトラック法は最適です。ただし、「生成するデータ数が多くなると時間がとてもかかる」という弱点があるので注意してください。
●プログラムの作成
それでは、プログラムを作りましょう。次のリストを見てください。
リスト : 8 クイーンの解法
;;; 安全確認
(defun safe (ls)
(cond ((null ls) t)
((attack (car ls) (cdr ls))
(safe (cdr ls)))
(t nil)))
;;; 8 クイーンの解法
(defun queen (nums board)
(if (null nums)
(if (safe board) (print board))
(dolist (x nums)
(queen (remove x nums) (cons x board)))))
関数 queen は順列を生成するプログラムと同じです。順列を一つ生成したら、述語 safe で 8 クイーンの条件を満たしているかチェックします。そうであれば、関数 print でリストを出力します。
述語 safe はリストの先頭の要素からチェックしていきます。衝突のチェックは斜めの利き筋を調るだけです。端にあるクイーンから順番に調べるとすると、斜めの利き筋は次のように表せます。
1 2 3 --> 調べる方向
*-------------
| . . . . . .
| . . . -3. . 5 - 3 = 2
| . . -2. . . 5 - 2 = 3
| . -1. . . . 5 - 1 = 4
| Q . . . . . Q の位置は 5
| . +1. . . . 5 + 1 = 6
| . . +2. . . 5 + 2 = 7
| . . . +3. . 5 + 2 = 8
*-------------
図 : 衝突の検出
図を見てもらえばおわかりのように、Q が行 5 にある場合、ひとつ隣の列は 4 と 6 が利き筋に当たります。2 つ隣の列の場合は 3 と 7 が利き筋に当たります。このように単純な足し算と引き算で、利き筋を計算することができます。これをプログラムすると次のようになります。
リスト : 衝突の検出
(defun attack (x xs)
(labels ((attack-sub (x n ys)
(cond ((null ys) t)
((or (= (+ (car ys) n) x)
(= (- (car ys) n) x))
nil)
(t (attack-sub x (1+ n) (cdr ys))))))
(attack-sub x 1 xs)))
attack は、斜めの利き筋に当たった場合に nil を返し、利き筋に当たらない場合は t を返します。実際の処理は局所関数 attack-sub で行います。attack-sub はリストの先頭から斜めの利き筋に当たるか調べます。第 1 引数がクイーンの位置、第 2 引数が位置の差分、第 3 引数がリストになります。
cond の最初の節がクイーンを全て調べた場合です。クイーンは衝突していないので t を返します。次の節で、リストから先頭の要素を取りだし、利き筋に当たるか調べます。これは、(car ys) + n または (car ys) - n が x と等しいかチェックするだけです。衝突している場合は nil を返します。そうでなければ、attack-sub を再帰呼び出しして次のクイーンを調べます。このとき、差分 n の値を +1 することをお忘れなく。
●実行結果
これでプログラムは完成です。それでは実行してみましょう。
* (queen '(1 2 3 4 5 6 7 8) '()) (4 2 7 3 6 8 5 1) ... 省略 ... (5 7 2 6 3 1 4 8)
解は全部で 92 通りあります。ところで、このプログラムはクイーンの個数を増やすと極端に遅くなります。SBCL ver 2.1.11 で実行時間を計測したところ、次のようになりました。
表 : 実行時間 (単位 : 秒) 個数 : 8 : 9 : 10 : 11 ---------+------+------+------+------- queen : 0.01 : 0.09 : 0.94 : 9.26 実行環境 : SBCL 2.1.11, Ubunts 22.04 (WSL2), Intel Core i5-6200U 2.30GHz
実はこのプログラム、とても非効率なことをやっているのです。
●8 クイーンの高速化
実行速度が遅い理由は、失敗することがわかっている順列も生成してしまうからです。たとえば、最初 (1, 1) の位置にクイーンを置くと、次のクイーンは (2, 2) の位置に置くことはできませんね。したがって、(1 2 X X X X X X) という配置はすべて失敗するのですが、順列を発生させてからチェックする今の方法では、このような無駄を省くことができません。
そこで、クイーンの配置を決めるたびに衝突のチェックを行うことにします。これをプログラムすると次のようになります。
リスト：8 クイーン (改良版)
(defun queen-fast (nums board)
(if (null nums)
(print board)
(dolist (x nums)
(if (attack x board)
(queen-fast (remove x nums) (cons x board))))))
dolist の中で、追加したクイーンが board 内のクイーンと衝突していないか関数 attack でチェックします。順列を生成している途中でチェックを入れることで、無駄な順列を生成しないようにするわけです。この場合、関数 safe は必要ありません。このように、できるだけ早い段階でチェックを入れることで、無駄なデータをカットすることを「枝刈り」と呼びます。バックトラックを使って問題を解く場合、この枝刈りのよしあしによって実行時間が大きく左右されます。
●実行結果 (2)
それでは実行結果を示します。
個数 : 8 : 9 : 10 : 11 : 12 ---------+------+------+------+------+------ queen : 0.01 : 0.09 : 0.94 : 9.26 : ---- 高速化 : ---- : ---- : ---- : 0.05 : 0.25 実行環境 : SBCL 2.1.11, Ubunts 22.04 (WSL2), Intel Core i5-6200U 2.30GHz
このように、枝刈りを行うことで実行時間を大幅に短縮することができます。ところで、今回は単純にリストを出力するだけなので、ちょっと面白くありません。興味のある方は、解答例のような図を出力するプログラムを作ってみてください。
●ちょっと便利なビット操作関数
パズルを解くとき、ビット演算を使うと処理を高速化できる場合があります。簡単な例として、0 以上の整数値でその下位ビットから順番にオンビットを取り出す処理を作ってみましょう。単純に考えると、プログラムは次のようになります。
リスト : ビット操作用高階関数
(defun bit-for-each (func n)
(do ((x 1 (ash x 1)))
((not (plusp n)))
(cond ((plusp (logand x n))
(funcall func x)
(setq n (logxor n x))))))
関数 bit-for-each は高階関数で、オンビットを順番に取り出して引数の関数 func に渡します。変数 x を 1 に初期化して、do で 1 ビットずつ左へシフトします。そして、x と n の論理積 (logand) が 0 でなければ、その位置のビットがオンであることがわかります。関数 func を呼び出してから、排他的論理和 (logxor) でそのビットをオフにします。n が 0 になったならば繰り返しを終了します。
このようにとても簡単にプログラムできますが、オフビットをスキップしているだけなので、これでは処理を高速化することはできません。実はビット演算を使うと、下位ビットから順番にオンビットを取り出すことができるのです。簡単な例として 4 ビットの整数値を考えてみます。負の整数を 2 の補数で表した場合、4 ビットで表される整数は -8 から 7 になります。次の図を見てください。
0 : 0000
1 : 0001 -1 : 1111 (logand 1 -1) => 0001
2 : 0010 -2 : 1110 (logand 2 -2) => 0010
3 : 0011 -3 : 1101 (logand 3 -3) => 0001
4 : 0100 -4 : 1100 (logand 4 -4) => 0100
5 : 0101 -5 : 1011 (logand 5 -5) => 0001
6 : 0110 -6 : 1010 (logand 6 -6) => 0010
7 : 0111 -7 : 1001 (logand 7 -7) => 0001
-8 : 1000
図 : 下位のオンビットを取り出す方法
2 の補数はビットを反転した値 (1 の補数) に 1 を加算することで求めることができます。したがって、x と -x の論理積は、最も下位にあるオンビットだけが残り、あとのビットはすべて 0 になります。このビットをオフにすれば、同じ方法で次のオンビットを求めることができます。
それでは、この方法を使ってオンビットを順番に取り出す関数を作りましょう。次のリストを見てください。
リスト : ビット操作用高階関数
(defun bit-for-each (func n)
(do ()
((not (plusp n)))
(let ((m (logand (- n) n)))
(funcall func m)
(setq n (logxor n m)))))
整数値 n の最も下位にあるオンビットは (logand (- n) n) で求めることができます。この値を変数 m にセットして、関数 func を呼び出します。それから、(logxor n m) でビットを反転してオフにします。これでオンビットを順番に取り出すことができます。
オンビットの位置が必要な場合は次のように求めることができます。
(logcount (- m 1)) または (logcount (- m))
Common Lisp の logcount は、引数の整数値が正の場合はビット 1 の個数を返します。負の場合はビット 0 の個数を返します。m の値を -1 する場合、そのビットは 0 になり、それ以下のビットは 1 になります。あとは、1 になったビットの個数を求めればよいわけです。m を - m にする場合は、オンビットを含めて上位ビットは 1 になり、それより下位のビットは 0 になります。あとはビット 0 の個数を求めればよいわけです。
簡単な実行例を示します。
* (bit-for-each (lambda (x) (format t "~D, ~D~%" x (logcount (- x)))) 255) 1, 0 2, 1 4, 2 8, 3 16, 4 32, 5 64, 6 128, 7 NIL
実行速度にこだわる場合、高階関数よりも dotimes や dolist のようなマクロで定義した方がより速くなるかもしれません。プログラムは次のようになります。
リスト : ビット操作用マクロ
(defmacro dobit ((var num &optional result) &body body)
(let ((temp-num (gensym "DOBIT")))
`(do ((,temp-num ,num))
((not (plusp ,temp-num)) ,result)
(let ((,var (logand (- ,temp-num) ,temp-num)))
,@body
(setq ,temp-num (logxor ,temp-num ,var))))))
マクロ dobit の仕様は dotimes に合わせました。dobit は Common Lisp の「分配」という機能を使っています。詳しい説明は拙作のページ Common Lisp 入門 マクロ をお読みください。あとは特に難しいところはないと思います。
簡単な実行例を示します。
* (dobit (x 255) (format t "~D, ~D~%" x (logcount (- x)))) 1, 0 2, 1 4, 2 8, 3 16, 4 32, 5 64, 6 128, 7 NIL
●ビット演算による高速化
それでは実際にどのくらい速くなるのか、順列を生成する関数 permutations を使って試してみましょう。次のリストを見てください。
リスト : 順列の生成
;;; リスト版
(defun permutations0 (func ls &optional a)
(if (null ls)
(funcall func (reverse a))
(dolist (x ls)
(permutations0 func (remove x ls) (cons x a)))))
;;; ビット版
(defun permutations1 (func n &optional a)
(if (zerop n)
(funcall func (reverse a))
(bit-for-each
(lambda (x)
(permutations1 func (logxor x n) (cons x a)))
n)))
;;; マクロ版
(defun permutations2 (func n &optional a)
(if (zerop n)
(funcall func (reverse a))
(dobit (x n)
(permutations2 func (logxor x n) (cons x a)))))
リスト版 (permutations0) はリストから要素を選んで順列を生成します。ビット版とマクロ版は整数値からオンビットの値を選んで順列を生成します。どの関数も高階関数です。引数 func に関数 identity を指定して評価したところ、実行時間は次のようになりました。
表 : 実行時間 (単位 : 秒) 個数 : 9 : 10 : 11 ---------+------+------+------ リスト版 : 0.06 : 0.65 : 7.22 ビット版 : 0.05 : 0.54 : 6.01 マクロ版 : 0.04 : 0.47 : 5.35 実行環境 : SBCL 2.1.11, Ubunts 22.04 (WSL2), Intel Core i5-6200U 2.30GHz
マクロ版が一番速くなりました。ビット演算の効果だけではなく、マクロの効果も十分に発揮されていると思います。
●N Queens Problem の高速化
次はビット演算による N Queens Problem の高速化に挑戦してみましょう。プログラムのポイントは、斜めの利き筋のチェックをビット演算で行うことです。次の図を見てください。
0 1 2 3 4
*-------------
| . . . . . .
| . . . -3. . #x02
| . . -2. . . #x04
| . -1. . . . #x08 (1 bit 右シフト)
| Q . . . . . #x10 (Q の位置は 4)
| . +1. . . . #x20 (1 bit 左シフト)
| . . +2. . . #x40
| . . . +3. . #x80
*-------------
図 : 斜めの利き筋のチェック
クイーンの位置をオンビットで表すことします。上図のように 0 列目の 4 番目にクイーンを置いた場合、クイーンの位置は第 4 ビットをオンにした値 #x10 となります。
次に、斜めの利き筋を考えます。上図の場合、1 列目の右斜め上の利き筋は 3 番目 (#x08)、2 列目の右斜め上の利き筋は 2 番目 (#x04) になります。この値は 0 列目のクイーンの位置 #x10 を 1 ビットずつ右シフトすれば求めることができます。また、左斜め上の利き筋の場合、1 列目では 5 番目 (#x20) で 2 列目では 6 番目 (#x40) になるので、今度は 1 ビットずつ左シフトすれば求めることができます。
つまり、右斜め上の利き筋を right、左斜め上の利き筋を left で表すことにすると、right と left にクイーンの位置をセットしたら、隣の列を調べるときに right と left を 1 ビットシフトするだけで、斜めの利き筋を求めることができるわけです。
プログラムは次のようになります。
リスト : N Queens Problem の解法
;;; ビット版
(defun queen1 (nums left right)
(if (zerop nums)
(incf *answer-count*)
(bit-for-each
(lambda (x)
(if (zerop (logand (logior left right) x))
(queen1 (logxor nums x)
(ash (logior left x) 1)
(ash (logior right x) -1))))
nums)))
;;; マクロ版
(defun queen2 (nums left right)
(if (zerop nums)
(incf *answer-count*)
(dobit (x nums)
(if (zerop (logand (logior left right) x))
(queen2 (logxor nums x)
(ash (logior left x) 1)
(ash (logior right x) -1))))))
引数 nums はクイーンの位置をビットで表した整数値、right が右斜め上の利き筋、left が左斜め上の利き筋を表します。nums が 0 の場合、全てのクイーンを配置できたので *answer-count* を +1 します。
そうでなければ、bit-for-each または dobit で nums のオンビットを順番に取り出します。変数 x が配置するクイーンを表します。rigth と left の論理和を計算し、x との論理積が 0 ならば、x を盤面に配置することができます。nums から x を削除して、斜めの利き筋 left と right に x をセットします。このとき、左右に 1 ビットシフトすることをお忘れなく。
●実行結果 (3)
実行結果は次のようになりました。
表 : 実行結果 (単位 : 秒)
サイズ : 11 : 12 : 13 : 14
---------+------+-------+-------+--------
解の個数 : 2680 : 14200 : 73712 : 365596
リスト版 : 0.05 : 0.25 : 1.44 : 8.96
ビット版 : 0.02 : 0.12 : 0.69 : 4.06
マクロ版 : 0.02 : 0.11 : 0.59 : 3.54
実行環境 : SBCL 2.1.11, Ubunts 22.04 (WSL2), Intel Core i5-6200U 2.30GHz
ビット演算とマクロを使うことで、リスト版よりも 2 倍以上速くなりました。興味のある方はいろいろ試してみてください。
●Appendix : ペグ・ソリテアの高速化
ところで、前回作成したペグ・ソリテアの解法プログラムも、盤面をベクタではなく整数値のビットを使って表すと実行時間を短縮することができます。つまり、ペグがある状態をビットオンで、ペグがない状態をビットオフで表します。ペグの移動は該当する位置のビットを反転するだけなので、排他的論理和 logxor で簡単に実現できます。
実際に SBCL ver 2.1.11 で試してみると、0.86 秒から 0.56 秒まで短縮することができました。興味のある方は プログラムリスト２ をお読みくださいませ。
●参考文献, URL
高橋謙一郎さん が公開された Ｎクイーン問題（解の個数を求める） では、ビット演算による高速化やユニーク解の判定方法が詳しく解説されていて、とても勉強になります。興味のある方は、高橋さんのドキュメントをお読みくださいませ。
●プログラムリスト
;;;
;;; nqueen.lisp : N Queens Problem
;;;
;;; Copyright (C) 2010-2023 Makoto Hiroi
;;;
;;; ビット操作用高階関数
(defun bit-for-each (func n)
(do ()
((not (plusp n)))
(let ((m (logand (- n) n)))
(funcall func m)
(setq n (logxor n m)))))
;;; ビット操作用マクロ
(defmacro dobit ((var num &optional result) &body body)
(let ((temp-num (gensym "dobit")))
`(do ((,temp-num ,num))
((not (plusp ,temp-num)) ,result)
(let ((,var (logand (- ,temp-num) ,temp-num)))
,@body
(setq ,temp-num (logxor ,temp-num ,var))))))
;;; 数列の生成
(defun iota (m &optional (n 1) (step 1))
(if (> n m)
nil
(cons n (iota m (+ n step) step))))
;;;
;;; 順列の生成
;;;
;;; リスト版
(defun permutations0 (func ls &optional a)
(if (null ls)
(funcall func (reverse a))
(dolist (x ls)
(permutations0 func (remove x ls) (cons x a)))))
;;; ビット版
(defun permutations1 (func n &optional a)
(if (zerop n)
(funcall func (reverse a))
(bit-for-each
(lambda (x)
(permutations1 func (logxor x n) (cons x a)))
n)))
;;; マクロ版
(defun permutations2 (func n &optional a)
(if (zerop n)
(funcall func (reverse a))
(dobit (x n)
(permutations2 func (logxor x n) (cons x a)))))
;;;
;;; N Queens Problem
;;;
;;; 解の個数
(defvar *answer-count* 0)
;;; 衝突のチェック
(defun attack (x xs)
(labels ((attack-sub (x n ys)
(cond ((null ys) t)
((or (= (+ (car ys) n) x)
(= (- (car ys) n) x))
nil)
(t (attack-sub x (1+ n) (cdr ys))))))
(attack-sub x 1 xs)))
;;; 安全確認
(defun safe (ls)
(cond ((null ls) t)
((attack (car ls) (cdr ls))
(safe (cdr ls)))
(t nil)))
;;; N Queens Problem の解法 (リスト版)
(defun queen (nums board)
(if (null nums)
(if (safe board) (incf *answer-count*)) ; 解の個数をカウント
(dolist (x nums)
(queen (remove x nums) (cons x board)))))
;;; リスト版の改良
(defun queen-fast (nums board)
(if (null nums)
(incf *answer-count*) ; 解の個数をカウント
(dolist (x nums)
(if (attack x board)
(queen-fast (remove x nums) (cons x board))))))
;;; ビット版
(defun queen1 (nums left right)
(if (zerop nums)
(incf *answer-count*)
(bit-for-each
(lambda (x)
(if (zerop (logand (logior left right) x))
(queen1 (logxor nums x)
(ash (logior left x) 1)
(ash (logior right x) -1))))
nums)))
;;; マクロ版
(defun queen2 (nums left right)
(if (zerop nums)
(incf *answer-count*)
(dobit (x nums)
(if (zerop (logand (logior left right) x))
(queen2 (logxor nums x)
(ash (logior left x) 1)
(ash (logior right x) -1))))))
●プログラムリスト２
;;;
;;; peg21.lisp : ペグ・ソリテア (変形三角盤)
;;; ビット演算による高速化
;;;
;;; Copyright (C) 2010-2023 Makoto Hiroi
;;;
;;; ビット操作用マクロ
(defmacro dobit ((var num &optional result) &body body)
(let ((temp-num (gensym "dobit")))
`(do ((,temp-num ,num))
((not (plusp ,temp-num)) ,result)
(let ((,var (logand (- ,temp-num) ,temp-num)))
,@body
(setq ,temp-num (logxor ,temp-num ,var))))))
;;; 跳び先表
(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))
;;; 跳び先表の変換
(defun transfer-table (ls)
(cond ((null ls) nil)
((numberp ls)
(ash 1 ls))
(t
(cons (transfer-table (car ls))
(transfer-table (cdr ls))))))
;;;
(defconstant jump-table-b
(make-array size
:initial-contents (transfer-table jump-table)))
;;; 移動手順の変換
(defun transfer-move (ls)
(cond ((null ls) nil)
((numberp ls)
(logcount (- ls)))
(t
(cons (transfer-move (car ls))
(transfer-move (cdr ls))))))
;;; 解の個数
(defvar *count-answer* 0)
;;; コーナーペグの個数を数える
(defun count-corner-peg (board)
(logcount (logand board #b111000001000000000011)))
;;; group-2 のペグがあるか
(defun group2-exist (board)
(logtest #b001010101000001000000 board))
;;; 下限値の計算
(defun lower-value-sub (board a b c)
(aref #(0 2 2 4 0 1 1 3)
(+ (if (logbitp a board) 1 0)
(if (logbitp b board) 2 0)
(if (logbitp c board) 4 0))))
(defun lower-value (board prev)
(if (= (aref group (logcount (- prev))) 3)
(count-corner-peg board)
(+ (lower-value-sub board 0 1 2)
(lower-value-sub board 12 19 13)
(lower-value-sub board 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 (board n jc limit move)
(when
(and (<= (+ jc (lower-value board (cdar move))) limit)
(group2-exist board))
(if (= n max-jump)
(if (logbitp 6 board)
(print-move (transfer-move (reverse move))))
(dobit (from board)
(dolist (x (aref jump-table-b (logcount (- from))))
(let ((del (first x)) (to (second x)))
; del にペグがあり、to が空いている
(when (and (logtest del board) (not (logtest to board)))
(id-search
(logxor board (logior from del to))
(+ n 1)
(if (= from (cdar move)) jc (+ jc 1))
limit
(cons (cons from to) move)))))))))
(defun solve ()
; 初手 14 -> 6
(let ((board #b111111011110111111111))
(do ((limit (lower-value board (ash 1 6)) (1+ limit)))
((> limit max-jump))
(format t "----- ~D -----~%" limit)
(id-search board 1 1 limit (list (cons (ash 1 14) (ash 1 6))))
(if (plusp *count-answer*)
(progn (print *count-answer*) (return))))))
改訂 2023 年 7 月 16 日