今回は「生成検定法 (generate and test)」という方法を取り上げます。生成検定法は問題を解くときによく用いられる方法で、正解の可能性があるデータを生成してチェックすることで正解をひとつ、またはすべて見つけ出すことができます。可能性のあるデータをもれなく作るのにバックトラックは最適です。ただし、「生成するデータ数が多くなると時間がとてもかかる」という弱点があるので注意してください。今回は簡単なパズルを生成検定法で解いてみましょう。
1 から 9 までの数字を順番に並べ、間に + と - を補って 100 になる式を作ってください。ただし、1 の前に符号 - は付けないものとします。
例 : 1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 = 100
パズルの世界では、1 から 9 までの数字を 1 個ずつすべて使った数字を「小町数」といいます。たとえば、123456789 とか 321654987 のような数字です。「小町算」というものもあり、たとえば 123 + 456 + 789 とか 321 * 654 + 987 のようなものです。問題は小町算の中でも特に有名なパズルです。
それではプログラムを作りましょう。式は次のようにリストで表すことにします。
1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 => (1 + 2 + 3 - 4 + 5 + 6 + 78 + 9)
あとは、式を生成して値を計算するだけです。式を生成するとき、リストを逆順で管理すると簡単です。次の図を見てください。
(1) => (2 + 1) => (3 + 2 + 1)
=> (3 - 2 + 1)
=> (23 + 1)
=> (2 - 1) => (3 + 2 - 1)
=> (3 - 2 - 1)
=> (23 - 1)
=> (12) => (3 + 12)
=> (3 - 12)
=> (123)
式を生成するとき、リストに数字と演算子を順番に追加していきます。数字と + と - を追加する処理は簡単です。プログラムのポイントは数字を連結する処理、たとえば 1 と 2 を連結して一つの数値 12 にする処理です。この処理はリストの先頭の数字 1 を 12 (= 1 * 10 + 2) に置き換えることで実現できます。リストが (2 + 1) であれば、数字 2 を 23 (= 2 * 10 + 3) に置き換えます。
式を生成するプログラムは次のようになります。
リスト : 式の生成
;;; 式の表示
(defun print-expr (ans expr)
(dolist (x expr)
(format t "~A " x))
(format t "= ~D~%" ans))
;;; 式の生成
(defun make-expr (ans n expr)
(cond
((= n 10)
(if (= (calc-expr (reverse expr)) ans)
(print-expr ans (reverse expr))))
(t
(make-expr ans (1+ n) (list* n '+ expr))
(make-expr ans (1+ n) (list* n '- expr))
(make-expr ans (1+ n) (cons (+ (* (car expr) 10) n) (cdr expr))))))
関数名は make-expr としました。引数 ANS が求める式の値、N が追加する数字、EXPR が生成する式 (リスト) です。最初に呼び出すとき、N には 2 を、EXPR にはリスト (1) を渡します。N が 10 になったら関数 calc-expr で式 EXPR を計算します。その結果が ANS と等しい場合は関数 print-expr で数式を表示します。
そうでなければ、数式を生成します。これは make-expr を再帰呼び出しするだけです。最初は N と + を追加します。次は N と - を追加します。最後は数字を連結する場合です。(+ (* (car expr) 10) n) を計算して、それと先頭の数字を置き換えます。
関数 list* は list と似ていますが、最後のコンスセルがドット対になります。つまり、最後の引数がリストであれば、他の引数をリストに追加することになります。簡単な例を示しましょう。
* (list 1 2 3 4) (1 2 3 4) * (list* 1 2 3 4) (1 2 3 . 4) * (list 1 2 3 '(4 5 6)) (1 2 3 (4 5 6)) * (list* 1 2 3 '(4 5 6)) (1 2 3 4 5 6)
次は式を計算する関数 calc-expr を作ります。今回の問題は演算子に + と - しかないので、リストで表現した式を計算することは簡単です。次のプログラムを見てください。
リスト：式の計算 (+ と - だけ)
;;; 式の計算
(defun calc-expr (xs)
(do ((a (car xs))
(xs (cdr xs) (cddr xs)))
((null xs) a)
(case
(first xs)
(+ (incf a (second xs)))
(- (decf a (second xs))))))
;;; 小町算を解く
(defun komachi (ans)
(make-expr ans 2 '(1)))
先頭の数値を変数 A にセットし、do ループで演算子 (+ または -) と数値を取り出して、A に加算 (または減算) していくだけです。
それでは実行結果を示します。
* (komachi 100) 1 + 2 + 3 - 4 + 5 + 6 + 78 + 9 = 100 1 + 2 + 34 - 5 + 67 - 8 + 9 = 100 1 + 23 - 4 + 5 + 6 + 78 - 9 = 100 1 + 23 - 4 + 56 + 7 + 8 + 9 = 100 12 + 3 + 4 + 5 - 6 - 7 + 89 = 100 12 + 3 - 4 + 5 + 67 + 8 + 9 = 100 12 - 3 - 4 + 5 - 6 + 7 + 89 = 100 123 + 4 - 5 + 67 - 89 = 100 123 + 45 - 67 + 8 - 9 = 100 123 - 4 - 5 - 6 - 7 + 8 - 9 = 100 123 - 45 - 67 + 89 = 100 NIL
全部で 11 通りの解が出力されます。興味のある方は 100 以外の値でも試してみてください。
パズルの世界では小町数に 0 を加えた数を「大町数」といいます。そして、0 から 9 までの 10 個の数字を 1 個ずつ使った計算を「大町算」といいます。ただし、0123456789 のように最上位の桁に 0 を入れることはできません。それでは問題です。
ある連続した３数 (n, n+1, n+2) を掛け合わせたら、大町数になったという。そのような３数をすべて見つけてほしい。もちろん、負の数は考えない。
出典：『Ｃマガ電脳クラブ』 Ｃマガジン 1998 年 2 月号（ソフトバンク）
それではプログラムを作りましょう。最初に整数 n の範囲を絞り込みます。大町数の最大値は 9876543210 で最小値は 1023456789 ですから、n の値は次の範囲内になります。
* (expt 1023456789 1/3) 1007.7586 * (* 1006 1007 1008) 1021146336 ;; 1021146336 < 1023456789 * (expt 9876543210 1/3) 2145.532 * (* 2145 2146 2147) 9883005990 ;; 9883005990 > 9876543210
これらの計算結果から n は 1007 以上 2144 以下であることがわかります。n の範囲がぐっと狭くなりましたね。これならば、あとは単純に計算して大町数になるかチェックすればいいでしょう。プログラムは次のようになります。
リスト : 大町算
;;; 整数 N を一桁ずつ分解
(defun split-digit (n &optional a)
(if (zerop n)
a
(multiple-value-bind
(p q)
(floor n 10)
(split-digit p (cons q a)))))
;;; 重複要素があるか？
(defun duplicatep (xs)
(cond
((null xs) nil)
((member (car xs) (cdr xs)) t)
(t (duplicatep (cdr xs)))))
(defun oomachi ()
(do ((n 1007 (1+ n)))
((> n 2144))
(let* ((n1 (1+ n))
(n2 (+ n 2))
(num (* n n1 n2)))
(if (not (duplicatep (split-digit num)))
(format t "~d * ~d * ~d = ~d~%" n n1 n2 num)))))
関数 split-digit は整数 N を一桁ずつ分解します。(floor n 10) で商と余りを求め、変数 P と Q にセットします。余り Q が最下位の数字になります。split-digit を再帰呼び出しするときは引数に P を渡して、Q を累積変数 A に格納します。N が 0 になったら A を返します。
簡単な実行例を示します。
* (split-digit 123456789) (1 2 3 4 5 6 7 8 9) * (split-digit 100000000) (1 0 0 0 0 0 0 0 0)
関数 duplicatep はリスト XS に重複要素があれば T を返し、そうでなければ NIL を返します。XS が空リストならば重複要素はないので T を返します。次の節で XS を car と cdr で分解して、(car xs) が (cdr xs) に含まれているか member でチェックします。member が真を返す場合は重複要素があるので T を返します。最後の節で duplicatep を再帰呼び出しして、先頭要素を取り除いたリストで重複要素をチェックします。
簡単な実行例を示します。
* (duplicatep '(1 2 3 4)) NIL * (duplicatep '(1 2 3 1)) T * (duplicatep '(1 2 3 3)) T
なお、duplicatep は次のようにプログラムすることもできます。
リスト : 重複要素があるか？ (別バージョン) (defun duplicatep (xs) (/= (length xs) (length (remove-duplicates xs))))
あとは単純な生成検定法です。関数 oomachi で 1007 から 2144 までの数値を生成します。3 つの数字 N, N1, N2 を掛け算した値を変数 NUM にセットします。NUM を split-digit で分解して、重複要素がないか duplicatep でチェックします。10 桁の数で重複要素がなければ、0 から 9 までの数字がちょうど一つずつあります。大町数になるので format で結果を出力します。
これでプログラムは完成です。さっそく実行してみましょう。
* (oomachi) 1267 * 1268 * 1269 = 2038719564 1332 * 1333 * 1334 = 2368591704 NIL
2 通りの解を見つけることができました。
計算式の数字を文字や記号に置き換えて、それを元の数字に戻すパズルを「覆面算」といいます。異なる文字は異なる数字を表し、同じ文字は同じ数字を表します。使用する数字は 0 から 9 までで、最上位の桁に 0 を入れることはできません。
S E N D
+ M O R E
-------------
M O N E Y
図 : 覆面算
問題はデュードニーが 1924 年に発表したもので、覆面算の古典といわれる有名なパズルです。
式 SEND + MORE = MONEY は足し算なので、M が 1 であることはすぐにわかります。ここでは、それ以外の数字を求めるプログラムを作ります。単純な生成検定法でプログラムを作ると、次のようになります。
リスト : 覆面算
;;; 順列の生成 (XS の中から N 個を選ぶ)
(defun permutation (fn xs n &optional a)
(if (zerop n)
(funcall fn (reverse a))
(dolist (x xs)
(permutation fn (remove x xs) (1- n) (cons x a)))))
;;; send + more = money
;;; s e n d o r y
;;; 0 1 2 3 4 5 6
(defun get-number (xs)
(values
(+ (* (nth 0 xs) 1000) (* (nth 1 xs) 100) (* (nth 2 xs) 10) (nth 3 xs)) ; send
(+ 1000 (* (nth 4 xs) 100) (* (nth 5 xs) 10) (nth 1 xs)) ; more
(+ 10000 (* (nth 4 xs) 1000) (* (nth 2 xs) 100) (* (nth 1 xs) 10) (nth 6 xs)))) ; money
(defun hukumen ()
(permutation
(lambda (xs)
(multiple-value-bind
(send more money)
(get-number xs)
(if (= (+ send more) money)
(format t "~d + ~d = ~d~%" send more money))))
'(0 2 3 4 5 6 7 8 9) 7))
関数 permutation はリスト XS の中から N 個の要素を選ぶ順列を生成します。あとは関数 get-number で数値 send, more, money を計算して、send + more = money を満たしているかチェックします。とても簡単なプログラムですね。さっそく実行してみましょう。
* (hukumen) 9567 + 1085 = 10652 NIL
答えは 9567 + 1085 = 10652 の 1 通りしかありません。興味のある方は、ほかの方法でも試してみてください。
次は「Eight Queens Problem, (8 クイーン問題)」を取り上げます。これはコンピュータに解かせるパズルの中でも特に有名な問題です。8 クイーンは、8 行 8 列のチェスの升目に、8 個のクイーンを互いの利き筋が重ならないように配置する問題です。クイーンは将棋の飛車と角をあわせた駒で、縦横斜めに任意に動くことができます。解答の一例を次に示します。
列
0 1 2 3 4 5 6 7
*-----------------*
0 | Q . . . . . . . |
1 | . . . . Q . . . |
2 | . . . . . . . Q |
行 3 | . . . . . Q . . |
4 | . . Q . . . . . |
5 | . . . . . . Q . |
6 | . Q . . . . . . |
7 | . . . Q . . . . |
*-----------------*
図 : 8 クイーンの解答例
8 クイーンを解くには、基本的にはすべての置き方を試してみるしかありません。最初のクイーンは、盤上の好きなところへ置くことができるので、64 通りの置き方があります。次のクイーンは 63 通り、その次は 62 通りあります。したがって、置き方の総数は 64 から 57 までを掛け算した 178,462,987,637,760 通りあることがわかります。これはとても大きな数ですね。
ところが、解答例を見ればおわかりのように、同じ行と列に 2 つ以上のクイーンを置くことはできません。上図の解答例をリストを使って表すと、 次のようになります。
0 1 2 3 4 5 6 7 <--- 列の位置
------------------
(0 6 4 7 1 3 5 2) <--- 要素が行の位置を表す
図 : 8 クイーンの表現方法
列をリストの位置に、行番号を要素に対応させれば、各要素には 0 から 7 までの数字が重複しないで入ることになります。つまり、0 から 7 までの順列の総数である 8! = 40320 通りの置き方を調べればよいことになります。数がぐっと減りましたね。
パズルを解く場合は、そのパズル固有の性質をうまく使って、調べなければならない置き方の総数を減らすように工夫することが大切です。順列を生成するプログラムは簡単です。あとは、その順列が 8 クイーンの条件を満たしているかチェックすればいいわけです。
それではプログラムを作りましょう。最初に、M 個 (0 - M-1) の整数から N 個を選ぶ順列を生成する関数 permutation-int を作ります。次のリストを見てください。
リスト : M 個の整数から N 個を選ぶ順列
(defun permutation-int (fn m n &optional a)
(if (zerop n)
(funcall fn (reverse a))
(dotimes (x m)
(unless (member x a)
(permutation-int fn m (1- n) (cons x a))))))
dotimes で 0 から M - 1 までの整数を順番に変数 X にセットします。X がリスト A に含まれていなければ、X を A に追加して permutation-int を再帰呼び出しします。もちろん、前回作成した順列を生成する関数を使ってもかまいません。その場合はリスト (0 ... M-1) を生成して、それを関数に渡してください。
簡単な実行例を示します。
* (permutation-int #'print 3 3) (0 1 2) (0 2 1) (1 0 2) (1 2 0) (2 0 1) (2 1 0) NIL * (permutation-int #'print 4 2) (0 1) (0 2) (0 3) (1 0) (1 2) (1 3) (2 0) (2 1) (2 3) (3 0) (3 1) (3 2) NIL
次は、斜めの利き筋をチェックするプログラムを作ります。次の図を見てください。
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 + 3 = 8
*-------------
図 : 衝突の検出
図を見てもらえばおわかりのように、Q が行 5 にある場合、ひとつ隣の列は 4 と 6 が利き筋に当たります。2 つ隣の列の場合は 3 と 7 が利き筋に当たります。このように単純な足し算と引き算で、利き筋を計算することができます。この処理を関数 attack で行います。
リスト : 衝突の検出 (defun attack (q xs &optional (n 1)) (cond ((null xs) nil) ((or (= (+ q n) (car xs)) (= (- q n) (car xs))) t) (t (attack q (cdr xs) (1+ n)))))
attack はクイーン Q が XS に格納されているクイーンと衝突すれば T を返し、そうでなければ NIL を返します。オプショナル引数 N は Q との列の差を表します。XS が空リストであれば、すべてのクイーンをチェックしたので NIL を返します。次に、(car xs) が Q + N または Q - N と等しいかチェックします。そうであれば、(car xs) は Q と衝突しているので T を返します。最後に、attck を再帰呼び出しして、次のクイーンをチェックします。このとき、N を +1 することをお忘れなく。
関数 attack を使うと、クイーン同士が衝突していないか簡単にチェックすることができます。プログラムは次のようになります。
リスト : 安全のチェック (defun safe (xs) (cond ((null xs) t) ((attack (car xs) (cdr xs)) nil) (t (safe (cdr xs)))))
関数 safe は、クイーン同士が衝突していたら NIL を返し、そうでなければ T を返します。引数 XS が空リストの場合、衝突するクイーンはないので T を返します。次の節で、attack に (car xs) と (cdr xs) を渡して、(car xs) が衝突するかチェックします。そうであれば NIL を返します。最後に safe を再帰呼び出して、残りのクイーンをチェックします。
ここまで作ればあとは簡単です。8 クイーンを解くプログラムは次のようになります。
リスト : 8 クイーンの解法
(defun nqueens (n)
(let ((c 0))
(permutation-int (lambda (qs) (when (safe qs) (incf c) (print qs))) n n)
c))
関数 nqueen は permutation を呼び出して順列を生成し、ラムダ式の中で引数 QS が安全か safe でチェックします。そうであれば、解の個数をカウントする変数 C を +1 して print で QS を表示します。
それでは実行してみましょう。
* (nqueens 4) (1 3 0 2) (2 0 3 1) 2 * (nqueens 5) (0 2 4 1 3) (0 3 1 4 2) (1 3 0 2 4) (1 4 2 0 3) (2 0 3 1 4) (2 4 1 3 0) (3 0 2 4 1) (3 1 4 2 0) (4 1 3 0 2) (4 2 0 3 1) 10 * (nqueens 8) (0 4 7 5 2 6 1 3) (0 5 7 2 6 3 1 4) (0 6 3 5 7 1 4 2) ・・・省略・・・ (7 1 4 2 0 6 3 5) (7 2 0 5 1 4 6 3) (7 3 0 2 5 1 6 4) 92
8 クイーンの場合、解は全部で 92 通りあります。
ところで、このプログラムは順列を生成してからクイーンの衝突チェックを行っているため、あまり効率的ではありません。最近のパソコンであれば、8 クイーンはこのプログラムでも短時間で解くことができますが、クイーンの個数を増やすと実行時間がかかるようになります。実際に試してみると、実行時間は次のようになりました。
表 : 8 クイーンの実行時間 (秒) 個数 | 8 | 9 | 10 | 11 ------+------+------+-------+------- 解 | 92 | 352 | 724 | 2680 ------+------+------+-------+------- queen | 0.04 | 0.30 | 2.76 | 36.69 実行環境 : Ubunts 18.04 (Windows Subsystem for Linux), Intel Core i5-6200U 2.30GHz
クイーンの個数をひとつ増やしただけでも、実行時間はとても遅くなります。なぜかというと、失敗することがわかっている順列も生成しているからです。
たとえば、最初 (0, 0) の位置にクイーンを置くと、次のクイーンは (1, 1) の位置に置くことはできません。したがって、(0 1 X X X X X X) という配置はすべて失敗することがわかるわけですが、順列を発生させてからチェックする方法では、このような無駄を省くことができません。そこで、クイーンの配置を決めるたびに衝突のチェックを行うことにします。これをプログラムすると次のようになります。
リスト : 8 クイーンの解法 (高速版)
(defun nqueens-fast (fn m n &optional a)
(if (zerop n)
(funcall fn (reverse a))
(dotimes (x m)
(when (and (not (member x a))
(not (attack x a)))
(nqueens-fast fn m (1- n) (cons x a))))))
(defun nqueens1 (n)
(let ((c 0))
(nqueens-fast (lambda (qs) (when (incf c))) n n)
c))
dotimes の中で nqueens-fast を再帰呼び出しするとき、attack で X が他のクイーンと衝突していないかチェックします。dotimes の中にチェックを入れることで、無駄な順列を生成しないようにするわけです。このようにすると関数 safe も必要ありません。
実行時間は次のようになりました。
表 : 8 クイーンの実行時間 (秒) 個数 | 8 | 9 | 10 | 11 ------+------+------+-------+------- 解 | 92 | 352 | 724 | 2680 ------+------+------+-------+------- queen | 0.04 | 0.30 | 2.76 | 36.69 ------+------+------+-------+------- fast | ---- | ---- | 0.019 | 0.11 実行環境 : Ubunts 18.04 (Windows Subsystem for Linux), Intel Core i5-6200U 2.30GHz
実行時間は大幅に短縮されました。このように、できるだけ早い段階でチェックを入れることで、無駄なデータをカットすることを「枝刈り」と呼びます。バックトラック法を使ってパズルを解く場合、この枝刈りのよしあしによって実行時間が大きく左右されます。
ただし、枝刈りのやり方は問題によって大きく変わります。「斜めの利き筋をチェックする」という枝刈りは、8 クイーン固有の性質を使ったやり方であり、これをそのまま他のパズルに使うことはできません。パズル固有の性質をよく調べて、適切な枝刈りを考えることが重要なのです。
パズル自体はコンピュータに解かせるのですが、枝刈りの条件は私達が考えるわけですね。これもコンピュータでパズルを解く面白さの一つといえるでしょう。解を求めるだけではなく、いかに効率の良い条件を見つけて実行時間を短縮するか、ということでも楽しむことができるわけです。
なお、n 行 n 列の盤面でクイーンの配置を求める問題を "N Queens Problem" といいます。クイーンの個数が増えると、もっと高速な方法が必要になります。興味のある方は拙作のページ Puzzle De Programming: N Queens Problem や Common Lisp 入門 番外編: N Queens Problem をお読みください。
パズルではありませんが、簡単な例題として「マスターマインド」を解くプログラムを作りましょう。マスターマインドは拙作のページ「数当てゲーム」で作成した、0 から 9 までの重複しない 4 つの数字からなる隠しコードを当てるゲームでした。数字は合っているが位置が間違っている個数を cows で表し、数字も位置も合っている個数を bulls で表します。bulls が 4 になると正解です。
(6 2 8 1) : 正解
---------------------------------
1. (0 1 2 3) : cows 2 : bulls 0
2. (1 0 4 5) : cows 1 : bulls 0
3. (2 3 5 6) : cows 2 : bulls 0
4. (3 2 7 4) : cows 0 : bulls 1
5. (3 6 0 8) : cows 2 : bulls 0
6. (6 2 8 1) : cows 0 : bulls 4
図 : マスターマインドの動作例
今回は、私達が出した問題をコンピュータに答えてもらうことにします。それはちょっと難しいのではないか、と思った人もいるかもしれませんね。ところが、とても簡単な方法があるのです。
このゲームでは、10 個の数字の中から 4 個選ぶわけですから、全体では 10 * 9 * 8 * 7 = 5040 通りのコードしかありません。コードを生成する処理は順列と同じですから、簡単にプログラムできます。
次に、この中から正解を見つける方法ですが、質問したコードとその結果を覚えておいて、それと矛盾しないコードを作るようにします。具体的には、4 つの数字の順列を生成し、それが今まで質問したコードと矛盾しないことを確かめます。これは生成検定法と同じですね。
矛盾しているかチェックする方法も簡単で、以前に質問したコードと比較して、bulls と cows が等しいときは矛盾していません。たとえば、次の例を考えてみてください。
(6 2 8 1) が正解の場合
(0 1 2 3) => bulls = 0, cows = 2
(0 1 2 3) と比較する
--------------------------------------------------------
(0 X X X) 0 から始まるコードは bulls = 1
になるので矛盾する。
・・・・
(1 0 3 4) cows = 3, bulls = 0 になるので矛盾する
・・・・
(1 0 4 5) cows = 2, bulls = 0 で矛盾しない。
--------------------------------------------------------
(1 0 4 5) => bulls = 0, cows = 1
次は、(0 1 2 3) と (1 0 4 5) に矛盾しない数字を選ぶ
図 : マスターマインドの推測アルゴリズム
(0 1 2 3) で bulls が 0 ですから、その位置にその数字は当てはまりません。したがって、(0 X X X) というコードは (0 1 2 3) と比較すると bulls が 1 となるので、矛盾していることがわかります。
次に (1 0 3 4) というコードを考えてみます。(0 1 2 3) の結果は cows が 2 ですから、その中で合っている数字は 2 つしかないわけです。ところが、(1 0 3 4) と (0 1 2 3) と比較すると cows が 3 になります。当たっている数字が 2 つしかないのに、同じ数字を 3 つ使うのでは矛盾していることになりますね。
次に (1 0 4 5) というコードと比較すると、bulls が 0 で cows が 2 となります。これは矛盾していないので、このコードを質問することにします。その結果が bulls = 0, cows = 1 となり、今度は (0 1 2 3) と (1 0 4 5) に矛盾しないコードを選択するのです。
プログラムは簡単です。次のリストを見てください。
リスト : マスターマインドの解法
(defun mastermind (answer)
(let (query)
(dolist (code (permutation-list 10 4))
(when (every (lambda (qs) (check-code code qs)) query)
(let* ((bulls (count-bulls answer code))
(cows (- (count-same-number answer code) bulls)))
(push (list code bulls cows) query)
(format t "~2d: ~a, bulls = ~d, cows = ~d~%" (length query) code bulls cows)
(when (= bulls 4)
(format t "Good Job!!~%")
(return)))))))
関数 mastermind の引数 answer には正解を渡します。質問コードと結果は変数 QUERY のリストに格納します。要素は (code bulls cows) です。code は質問したコート、bulls と cows がその結果です。質問するコードは関数 permutation-list で生成します。これは permutation-int で生成した順列をリストに格納して返します。
dolist で質問コードを取り出して変数 code にセットします。次に、関数 every に関数 check-code とリスト query を渡して、code が今まで質問した結果と矛盾しないかチェックします。check-code は次のようになります。
リスト : コードのチェック
(defun check-code (code qs)
(let* ((bulls (count-bulls (first qs) code))
(cows (- (count-same-number (first qs) code) bulls)))
(and (= (second qs) bulls) (= (third qs) cows))))
引数 QS にはリスト (質問したコード bulls cows) が渡されます。関数 count-bulls と count-same-number を呼び出して bulls と cows をカウントします。そして、その結果が QS 内の結果 (bulls と cows) に矛盾していれば NIL を返し、そうでなければ T を返します。
code が矛盾していなければ、ANSWER と CODE の bulls と cows を求めます。(code bulls cows) を QUERY に追加して、結果を format で表示します。そして、BULLS が 4 であれば正解なので、メッセージを表示して return で dolist を脱出します。
これでプログラムは完成です。それでは実行例を示しましょう。
* (mastermind '(9 8 7 6)) 1: (0 1 2 3), bulls = 0, cows = 0 2: (4 5 6 7), bulls = 0, cows = 2 3: (5 4 8 9), bulls = 0, cows = 2 4: (6 7 9 8), bulls = 0, cows = 4 5: (8 9 7 6), bulls = 2, cows = 2 6: (9 8 7 6), bulls = 4, cows = 0 Good Job!! NIL * (mastermind '(9 4 3 1)) 1: (0 1 2 3), bulls = 0, cows = 2 2: (1 0 4 5), bulls = 0, cows = 2 3: (2 3 5 4), bulls = 0, cows = 2 4: (3 4 0 6), bulls = 1, cows = 1 5: (3 5 6 1), bulls = 1, cows = 1 6: (6 5 0 2), bulls = 0, cows = 0 7: (7 4 3 1), bulls = 3, cows = 0 8: (8 4 3 1), bulls = 3, cows = 0 9: (9 4 3 1), bulls = 4, cows = 0 Good Job!! NIL
肝心の質問回数ですが、5, 6 回で当たる場合が多いようです。実際に、5040 個のコードをすべて試してみたところ、平均は 5.56 回になりました。これは参考文献『bit 別冊 ゲームプログラミング』の結果と同じです。質問回数の最大値は 9 回で、(9 4 3 1) はその中のひとつです。
なお、参考文献 1 には平均質問回数がこれよりも少なくなる方法が紹介されています。単純な数当てゲームだと思っていましたが、その奥はけっこう深いようです。興味のある方はいろいろ試してみてください。
リスト : 生成検定法によるパズルの解法 (puzzle01.lisp)
;;;
;;; 小町算
;;;
;;; 式の表示
(defun print-expr (ans expr)
(dolist (x expr)
(format t "~A " x))
(format t "= ~D~%" ans))
;;; 式の計算
(defun calc-expr (xs)
(do ((a (car xs))
(xs (cdr xs) (cddr xs)))
((null xs) a)
(case
(first xs)
(+ (incf a (second xs)))
(- (decf a (second xs))))))
;;; 式の生成
(defun make-expr (ans n expr)
(cond
((= n 10)
(if (= (calc-expr (reverse expr)) ans)
(print-expr ans (reverse expr))))
(t
(make-expr ans (1+ n) (list* n '+ expr))
(make-expr ans (1+ n) (list* n '- expr))
(make-expr ans (1+ n) (cons (+ (* (car expr) 10) n) (cdr expr))))))
(defun komachi (ans)
(make-expr ans 2 '(1)))
;;;
;;; 大町算
;;;
;;; 整数 N を一桁ずつに分解
(defun split-digit (n &optional a)
(if (zerop n)
a
(multiple-value-bind
(p q)
(floor n 10)
(split-digit p (cons q a)))))
;;; 重複要素があるか？
(defun duplicatep (xs)
(cond
((null xs) nil)
((member (car xs) (cdr xs)) t)
(t (duplicatep (cdr xs)))))
(defun oomachi ()
(do ((n 1007 (1+ n)))
((> n 2144))
(let* ((n1 (1+ n))
(n2 (+ n 2))
(num (* n n1 n2)))
(if (not (duplicatep (split-digit num)))
(format t "~d * ~d * ~d = ~d~%" n n1 n2 num)))))
;;;
;;; 覆面算
;;;
;;; 順列の生成 (XS の中から N 個を選ぶ)
(defun permutation (fn xs n &optional a)
(if (zerop n)
(funcall fn (reverse a))
(dolist (x xs)
(permutation fn (remove x xs) (1- n) (cons x a)))))
;;; send + more = money
;;; s e n d o r y
;;; 0 1 2 3 4 5 6
(defun get-number (xs)
(values
(+ (* (nth 0 xs) 1000) (* (nth 1 xs) 100) (* (nth 2 xs) 10) (nth 3 xs)) ; send
(+ 1000 (* (nth 4 xs) 100) (* (nth 5 xs) 10) (nth 1 xs)) ; more
(+ 10000 (* (nth 4 xs) 1000) (* (nth 2 xs) 100) (* (nth 1 xs) 10) (nth 6 xs)))) ; money
(defun hukumen ()
(permutation
(lambda (xs)
(multiple-value-bind
(send more money)
(get-number xs)
(if (= (+ send more) money)
(format t "~d + ~d = ~d~%" send more money))))
'(0 2 3 4 5 6 7 8 9) 7))
;;;
;;; 8 Queens Problem
;;;
;;; 0 - M-1 から N 個を選ぶ順列の生成
(defun permutation-int (fn m n &optional a)
(if (zerop n)
(funcall fn (reverse a))
(dotimes (x m)
(unless (member x a)
(permutation-int fn m (1- n) (cons x a))))))
;;; Q と衝突するか？
(defun attack (q xs &optional (n 1))
(cond
((null xs) nil)
((or (= (+ q n) (car xs)) (= (- q n) (car xs))) t)
(t (attack q (cdr xs) (1+ n)))))
;;; 安全か？
(defun safe (xs)
(cond
((null xs) t)
((attack (car xs) (cdr xs)) nil)
(t (safe (cdr xs)))))
(defun nqueens (n)
(let ((c 0))
(permutation-int (lambda (qs) (when (safe qs) (print qs) (incf c))) n n)
c))
;;; 高速化
(defun nqueens-fast (fn m n &optional a)
(if (zerop n)
(funcall fn (reverse a))
(dotimes (x m)
(when (and (not (member x a))
(not (attack x a)))
(nqueens-fast fn m (1- n) (cons x a))))))
(defun nqueens1 (n)
(let ((c 0))
(nqueens-fast (lambda (qs) (when (incf c))) n n)
c))
;;;
;;; マスターマインドの解法
;;;
;;; 順列をリストに格納して返す
(defun permutation-list (m n)
(let (zs)
(permutation-int (lambda (xs) (push xs zs)) m n)
(nreverse zs)))
;;; bulls をカウント
(defun count-bulls (xs ys)
(count t (mapcar #'= xs ys)))
;;; 同じ数字をカウント
(defun count-same-number (xs ys &aux (c 0))
(dolist (x xs c)
(if (member x ys) (incf c))))
;;; コードのチェック
;;; qs = (code bulls cows)
(defun check-code (code qs)
(let* ((bulls (count-bulls (first qs) code))
(cows (- (count-same-number (first qs) code) bulls)))
(and (= (second qs) bulls) (= (third qs) cows))))
(defun mastermind (answer)
(let (query)
(dolist (code (permutation-list 10 4))
(when (every (lambda (qs) (check-code code qs)) query)
(let* ((bulls (count-bulls answer code))
(cows (- (count-same-number answer code) bulls)))
(push (list code bulls cows) query)
(format t "~2d: ~a, bulls = ~d, cows = ~d~%" (length query) code bulls cows)
(when (= bulls 4)
(format t "Good Job!!~%")
(return)))))))