今回は「生成検定法 (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) に置き換えます。
式を生成するプログラムは次のようになります。
リスト : 式の生成
;; 式の表示
(defn print-expr [ans expr]
(doseq [x expr] (printf "%s " x))
(printf "= %d\n" ans))
;; 式の生成
(defn make-expr [ans n expr]
(if (= n 10)
(when (== (calc-expr (reverse expr)) ans)
(print-expr ans (reverse expr)))
(do
(make-expr ans (inc n) (conj expr '+ n))
(make-expr ans (inc n) (conj expr '- n))
(make-expr ans (inc n) (cons (+ (* (first expr) 10) n) (rest expr))))))
関数名は make-expr としました。引数 ans が求める式の値、n が追加する数字、expr が生成する式 (リスト) です。最初に呼び出すとき、n には 2 を、expr にはリスト (1) を渡します。n が 10 になったら関数 calc-expr で式 expr を計算します。その結果が ans と等しい場合は関数 print-expr で数式を表示します。
そうでなければ、数式を生成します。これは make-expr を再帰呼び出しするだけです。最初は n と + を追加します。次は n と - を追加します。最後は数字を連結する場合です。(+ (* (first expr) 10) n) を計算して、それと先頭の数字を置き換えます。
次は式を計算する関数 calc-expr を作ります。今回の問題は演算子に + と - しかないので、リストで表現した式を計算することは簡単です。次のプログラムを見てください。
リスト : 式の計算 (+ と - だけ)
;; 式の計算
(defn calc-expr [xs]
(loop [a (first xs)
[op n & ys :as zs] (rest xs)]
(cond
(not (seq zs)) a
(= op '+) (recur (+ a n) ys)
:else (recur (- a n) ys))))
;; 小町算を解く
(defn komachi [ans] (make-expr ans 2 '(1)))
先頭の数値を変数 a にセットし、loop / recur で演算子 op (+ または -) と数値 n を取り出して、a に加算 (または減算) していくだけです。
それでは実行結果を示します。
user=> (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 の値は次の範囲内になります。
user=> (Math/pow 1023456789 1/3) 1007.758578449832 user=> (* 1006 1007 1008) 1021146336 ; 1021146336 < 1023456789 user=> (Math/pow 9876543210 1/3) 2145.5319657992272 user=> (* 2145 2146 2147) 9883005990 ; 9883005990 > 9876543210
これらの計算結果から n は 1007 以上 2144 以下であることがわかります。n の範囲がぐっと狭くなりましたね。これならば、あとは単純に計算して大町数になるかチェックすればいいでしょう。プログラムは次のようになります。
リスト : 大町算
;; 整数 n を一桁ずつに分解
(defn split-digit
([n] (split-digit n '()))
([n a]
(if (zero? n)
a
(let [p (quot n 10) q (mod n 10)]
(split-digit p (cons q a))))))
(defn oomachi []
(loop [n 1007]
(when (<= n 2144)
(let [n1 (inc n)
n2 (+ n 2)
num (* n n1 n2)]
(when (apply distinct? (split-digit num))
(printf "%d * %d * %d = %d\n" n n1 n2 num)))
(recur (inc n)))))
関数 split-digit は整数 n を一桁ずつ分解します。(quot n 10) と (mod n 10) で商と余りを求め、変数 p と q にセットします。余り q が最下位の数字になります。split-digit を再帰呼び出しするときは引数に p を渡して、q を累積変数 a に格納します。n が 0 になったら a を返します。
簡単な実行例を示します。
user=> (split-digit 123456789) (1 2 3 4 5 6 7 8 9) user=> (split-digit 100000000) (1 0 0 0 0 0 0 0 0)
あとは単純な生成検定法です。関数 oomachi で 1007 から 2144 までの数値を生成します。3 つの数字 n, n1, n2 を掛け算した値を変数 num にセットします。num を split-digit で分解して、重複要素がないか distinct? でチェックします。10 桁の数で重複要素がなければ、0 から 9 までの数字がちょうど一つずつあります。大町数になるので printf で結果を出力します。printf は Java のメソッド printf と同様の動作を行います。
これでプログラムは完成です。さっそく実行してみましょう。
user=> (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 個を選ぶ)
(defn permutation
([func n xs] (permutation func n xs '()))
([func n xs a]
(if (zero? n)
(func (reverse a))
(doseq [x xs]
(permutation func (dec n) (remove #(= x %) xs) (cons x a))))))
;; send + more = money
;; s e n d o r y
(defn hukumen []
(permutation
(fn [[s e n d o r y]]
(let [send (+ (* s 1000) (* e 100) (* n 10) d)
more (+ 1000 (* o 100) (* r 10) e)
money (+ 10000 (* o 1000) (* n 100) (* e 10) y)]
(if (== (+ send more) money)
(printf "%d + %d = %d\n" send more money))))
7 '(0 2 3 4 5 6 7 8 9)))
関数 permutation はリスト xs の中から n 個の要素を選ぶ順列を生成します。あとは関数 hukumen で数値 send, more, money を計算して、send + more = money を満たしているかチェックします。とても簡単なプログラムですね。さっそく実行してみましょう。
user=> (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 個を選ぶ順列
;; 0 - m-1 から n 個を選ぶ順列の生成
(defn permutation-int
([f m n] (permutation-int f m n (hash-set) '()))
([f m n u a]
(if (zero? n)
(f (reverse a))
(dotimes [x m]
(when-not (contains? u x)
(permutation-int f m (dec n) (conj u x) (cons x a)))))))
引数 u は使用した数字を格納するセットで、引数 a は順列を格納する累積変数です。dotimes で 0 から m - 1 までの整数を順番に変数 x にセットします。x がセット u に含まれていなければ、x を a に追加して permutation-int を再帰呼び出しします。もちろん、前回作成した順列を生成する関数を使ってもかまいません。その場合はリスト (0 ... m-1) を生成して、それを関数に渡してください。
簡単な実行例を示します。
user=> (permutation-int println 3 3) (0 1 2) (0 2 1) (1 0 2) (1 2 0) (2 0 1) (2 1 0) nil user=> (permutation-int println 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 で行います。
リスト : 衝突の検出
(defn attack
([q xs] (attack q xs 1))
([q [y & ys :as xs] n]
(cond
(not (seq xs)) false
(or (= (+ q n) y) (= (- q n) y)) true
:else (attack q ys (inc n)))))
attack はクイーン q が xs に格納されているクイーンと衝突すれば true を返し、そうでなければ false を返します。引数 n は q との列の差を表します。xs が空リストであれば、すべてのクイーンをチェックしたので false を返します。次に、先頭要素 y が q + n または q - n と等しいかチェックします。そうであれば、y は q と衝突しているので true を返します。最後に、attck を再帰呼び出しして、次のクイーンをチェックします。このとき、n を +1 することをお忘れなく。
関数 attack を使うと、クイーン同士が衝突していないか簡単にチェックすることができます。プログラムは次のようになります。
リスト : 安全のチェック (defn safe [[q & qs :as xs]] (cond (not (seq xs)) true (attack q qs) false :else (safe qs)))
関数 safe は、クイーン同士が衝突していたら false を返し、そうでなければ true を返します。引数 xs が空リストの場合、衝突するクイーンはないので true を返します。次の節で、attack に xs の先頭要素 q と残りのリスト qs を渡して、q が衝突するかチェックします。そうであれば false を返します。最後に safe を再帰呼び出して、残りのクイーンをチェックします。
ここまで作ればあとは簡単です。8 クイーンを解くプログラムは次のようになります。
リスト : 8 クイーンの解法
(defn nqueens [n]
(permutation-int (fn [qs] (when (safe qs) (println qs))) n n))
(defn nqueens' [n]
(let [c (atom 0)]
(permutation-int (fn [qs] (when (safe qs) (swap! c inc))) n n)
@c))
関数 nqueen は permutation を呼び出して順列を生成し、匿名関数の中で引数 qs が安全か safe でチェックします。そうであれば、println で qs を表示します。関数 nqueens' は解の個数をカウントして返します。
Clojure の場合、変数は基本的に immutable なので、値を書き換えることはできません。ML 系の言語 (SML/NJ, OCaml など) では、変数の破壊的な操作を実現するため、参照型のデータが用意されています。もちろん、Clojure にも参照型データが用意されています。ここで簡単に説明しておきましょう。
関数型言語の「参照 (reference)」はデータを間接的に参照する機能です。一般に、変数束縛は変数とデータを直接結び付けます。これに対し、参照は変数とデータを直接結び付けるのではなく、その間にデータを指し示す特別なデータ型を経由します。このデータ型を「参照型」といいます。次の図を見てください。
データ
┌───┐ ┌───┐
│変数 a│──→│ 11 │
└───┘ 束縛 └───┘
(A) 通常の束縛
参照型 データ
┌───┐ ┌──┬─┐ ┌───┐
│変数 b│──→│Atom│・┼──→│ 11 │
└───┘ 束縛 └──┴─┘ └───┘
(B) 参照型データを束縛
図 : 参照 (1)
上図 (A) は通常の変数束縛です。(def a 11) とすると、変数 a に数値 11 が束縛されます。(B) が参照を図示したものです。変数 b には参照型データが束縛され、参照型データが数値 11 を指し示しています。変数 b は参照型データを経由して数値 11 を参照することができます。
Clojure の場合、参照型のデータは数種類ありますが、ここでは Atom を使って説明します。次の例を見てください。
user=> (def b (atom 11))
#'user/b
user=> b
#object[clojure.lang.Atom 0x4a67318f {:status :ready, :val 11}]
user=> (def c (atom "foo"))
#'user/c
user=> c
#object[clojure.lang.Atom 0x450794b4 {:status :ready, :val "foo"}]
Atom の生成には関数 atom を使います。(atom 11) は数値 11 を指し示す参照型データ (Atom) を生成し、それが変数 b に束縛されます。(atom "foo") は文字列 "foo" を指し示す Atom を生成し、それが変数 c に束縛されます。
参照先のデータを求めるには関数 deref を使うか、参照型変数の前に @ を付けます。
user=> (deref b) 11 user=> @b 11 user=> (deref c) "foo" user=> @c "foo"
参照型データは参照するデータを変更することができます。次の図を見てください。
参照型 データ
┌───┐ ┌──┬─┐ ┌───┐
│変数 b│──→│Atom│・┼ Ｘ →│ 11 │
└───┘ 束縛 └──┴┼┘ └───┘
│ ┌───┐
└───→│ 22 │
└───┘
(C) データの書き換え
図 : 参照 (2)
上図 (C) は参照するデータを数値 11 から数値 22 に変更しています。すると、変数 b が参照する値は 22 になります。ようするに、変数 b の値を書き換えることと同じ効果が得られるのです。変数 (Atom) の書き換えは以下の関数で行います。
swap! は atom の値を (f @atom x y ...) の評価結果に書き換えます。reset! は atom の値を newval に書き換えます。簡単な例を示しましょう。
user=> @b 11 user=> (swap! b inc) 12 user=> @b 12 user=> (swap! b + 100) 112 user=> @b 112 user=> (reset! c "bar") "bar" @c "bar"
(swap! b inc) とすると、変数 b の値は 11 から 12 に書き換えられます。続いて、(swap! b + 100) とすると、変数 b の値は 12 から 112 に書き換えられます。同様に、(reset! c "bar") とすると、変数 c の値は "foo" から "bar" になります。
それでは nqueens の実行結果を示します。
user=> (nqueens 4) (1 3 0 2) (2 0 3 1) nil user=> 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) nil user=> (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) nil user=> (nqueens' 8) 92
8 クイーンの場合、解は全部で 92 通りあります。
ところで、このプログラムは順列を生成してからクイーンの衝突チェックを行っているため、あまり効率的ではありません。最近のパソコンであれば、8 クイーンはこのプログラムでも短時間で解くことができますが、クイーンの個数を増やすと実行時間がかかるようになります。実際に試してみると、実行時間は次のようになりました。
表 : 8 クイーンの実行時間 (秒) 個数 | 8 | 9 | 10 ------+------+------+------- 解 | 92 | 352 | 724 ------+------+------+------- queen | 0.11 | 1.06 | 10.48 実行環境 : Ubunts 22.04 (WSL2), Intel Core i5-6200U 2.30GHz
クイーンの個数をひとつ増やしただけでも、実行時間はとても遅くなります。なぜかというと、失敗することがわかっている順列も生成しているからです。
たとえば、最初 (0, 0) の位置にクイーンを置くと、次のクイーンは (1, 1) の位置に置くことはできません。したがって、(0 1 X X X X X X) という配置はすべて失敗することがわかるわけですが、順列を発生させてからチェックする方法では、このような無駄を省くことができません。そこで、クイーンの配置を決めるたびに衝突のチェックを行うことにします。これをプログラムすると次のようになります。
リスト : 8 クイーンの解法 (高速版)
;; 高速化
(defn nqueens-fast
([f m n] (nqueens-fast f m n (hash-set) '()))
([f m n u a]
(if (zero? n)
(f (reverse a))
(dotimes [x m]
(when (and (not (contains? u x))
(not (attack x a)))
(nqueens-fast f m (dec n) (conj u x) (cons x a)))))))
(defn nqueens-fast' [n]
(let [c (atom 0)]
(nqueens-fast (fn [qs] (swap! c inc)) n n)
@c))
dotimes の中で nqueens-fast を再帰呼び出しするとき、attack で X が他のクイーンと衝突していないかチェックします。dotimes の中にチェックを入れることで、無駄な順列を生成しないようにするわけです。このようにすると関数 safe も必要ありません。
実行時間は次のようになりました。
表 : 8 クイーンの実行時間 (秒) 個数 | 8 | 9 | 10 | 11 ------+------+-------+-------+------- 解 | 92 | 352 | 724 | 2680 ------+------+-------+--------------- queen | 0.11 | 1.06 | 10.48 | ---- ------+------+-------+-------+------- fast | ---- | 0.012 | 0.064 | 0.307
実行時間は大幅に短縮されました。このように、できるだけ早い段階でチェックを入れることで、無駄なデータをカットすることを「枝刈り」と呼びます。バックトラック法を使ってパズルを解く場合、この枝刈りのよしあしによって実行時間が大きく左右されます。
ただし、枝刈りのやり方は問題によって大きく変わります。「斜めの利き筋をチェックする」という枝刈りは、8 クイーン固有の性質を使ったやり方であり、これをそのまま他のパズルに使うことはできません。パズル固有の性質をよく調べて、適切な枝刈りを考えることが重要なのです。
パズル自体はコンピュータに解かせるのですが、枝刈りの条件は私達が考えるわけですね。これもコンピュータでパズルを解く面白さの一つといえるでしょう。解を求めるだけではなく、いかに効率の良い条件を見つけて実行時間を短縮するか、ということでも楽しむことができるわけです。
なお、n 行 n 列の盤面でクイーンの配置を求める問題を "N Queens Problem" といいます。クイーンの個数が増えると、もっと高速な方法が必要になります。興味のある方は拙作のページ Puzzle De Programming: N Queens Problem や Common Lisp 入門 番外編: N Queens Problem をお読みください。
パズルではありませんが、簡単な例題として「マスターマインド」を解くプログラムを作りましょう。マスターマインドは拙作のページ Common Lisp 入門「数当てゲーム」で作成した、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) に矛盾しないコードを選択するのです。
プログラムは簡単です。次のリストを見てください。
リスト : マスターマインドの解法
(defn mastermind [answer]
(loop [[code & cs :as xs] (permutations 4 (range 0 10))
query '()]
(if-not (seq xs)
(println "Oops!!")
(if (every? (fn [qs] (check-code code qs)) query)
(let [bulls (count-bulls answer code)
cows (- (count-same-number answer code) bulls)]
(printf "%2d: %s, bulls = %d, cows = %d\n" (inc (count query)) code bulls cows)
(if (== bulls 4)
(println "Good Job!!")
(recur cs (conj query (list code bulls cows)))))
(recur cs query)))))
関数 mastermind の引数 answer には正解を渡します。質問コードと結果は変数 query のリストに格納します。要素は (code bulls cows) です。code は質問したコート、bulls と cows がその結果です。質問するコードは関数 permutations で生成します。これは前回の「順列と組み合わせ」で出題した問題 1 と同じです。
loop / recur で質問コードを取り出して変数 code にセットします。次に、関数 every? に関数 check-code とリスト query を渡して、code が今まで質問した結果と矛盾しないかチェックします。check-code は次のようになります。
リスト : コードのチェック
(defn check-code [code [qcode qbulls qcows]]
(let [bulls (count-bulls qcode code)
cows (- (count-same-number qcode code) bulls)]
(and (== qbulls bulls) (== qcows cows))))
引数 qcode は質問したコード、qbulls は bulls の個数、qcows には cows の個数が渡されます。関数 count-bulls と count-same-number を呼び出して bulls と cows をカウントします。そして、その結果が qs 内の結果 (bulls と cows) に矛盾していれば false を返し、そうでなければ true を返します。
code が矛盾していなければ、answer と code の bulls と cows を求め、printf で結果を表示します。そして、bulls が 4 であれば正解なので、メッセージを表示して loop / recur を脱出します。そうでなければ、(code bulls cows) を query に追加して処理を繰り返します。
あとの関数は簡単なので説明は割愛させていただきます。詳細はプログラムリストをお読みください。
これでプログラムは完成です。それでは実行例を示しましょう。
user=> (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 user=> (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.clj)
;;;
;;; 小町算
;;;
;; 式の表示
(defn print-expr [ans expr]
(doseq [x expr] (printf "%s " x))
(printf "= %d\n" ans))
;; 式の計算
(defn calc-expr [xs]
(loop [a (first xs)
[op n & ys :as zs] (rest xs)]
(cond
(not (seq zs)) a
(= op '+) (recur (+ a n) ys)
:else (recur (- a n) ys))))
;; 式の生成
(defn make-expr [ans n expr]
(if (= n 10)
(when (== (calc-expr (reverse expr)) ans)
(print-expr ans (reverse expr)))
(do
(make-expr ans (inc n) (conj expr '+ n))
(make-expr ans (inc n) (conj expr '- n))
(make-expr ans (inc n) (cons (+ (* (first expr) 10) n) (rest expr))))))
(defn komachi [ans] (make-expr ans 2 '(1)))
;;;
;;; 大町算
;;;
;; 整数 n を一桁ずつに分解
(defn split-digit
([n] (split-digit n '()))
([n a]
(if (zero? n)
a
(let [p (quot n 10) q (mod n 10)]
(split-digit p (cons q a))))))
(defn oomachi []
(loop [n 1007]
(when (<= n 2144)
(let [n1 (inc n)
n2 (+ n 2)
num (* n n1 n2)]
(when (apply distinct? (split-digit num))
(printf "%d * %d * %d = %d\n" n n1 n2 num)))
(recur (inc n)))))
;;;
;;; 覆面算
;;;
;; 順列の生成 (xs の中から n 個を選ぶ)
(defn permutation
([func n xs] (permutation func n xs '()))
([func n xs a]
(if (zero? n)
(func (reverse a))
(doseq [x xs]
(permutation func (dec n) (remove #(= x %) xs) (cons x a))))))
;; send + more = money
;; s e n d o r y
(defn hukumen []
(permutation
(fn [[s e n d o r y]]
(let [send (+ (* s 1000) (* e 100) (* n 10) d)
more (+ 1000 (* o 100) (* r 10) e)
money (+ 10000 (* o 1000) (* n 100) (* e 10) y)]
(if (== (+ send more) money)
(printf "%d + %d = %d\n" send more money))))
7 '(0 2 3 4 5 6 7 8 9)))
;;;
;;; 8 Queens Problem
;;;
;; 0 - M-1 から N 個を選ぶ順列の生成
(defn permutation-int
([f m n] (permutation-int f m n (hash-set) '()))
([f m n u a]
(if (zero? n)
(f (reverse a))
(dotimes [x m]
(when-not (contains? u x)
(permutation-int f m (dec n) (conj u x) (cons x a)))))))
;; Q と衝突するか？
(defn attack
([q xs] (attack q xs 1))
([q [y & ys :as xs] n]
(cond
(not (seq xs)) false
(or (= (+ q n) y) (= (- q n) y)) true
:else (attack q ys (inc n)))))
;; 安全か？
(defn safe [[q & qs :as xs]]
(cond
(not (seq xs)) true
(attack q qs) false
:else (safe qs)))
(defn nqueens [n]
(permutation-int (fn [qs] (when (safe qs) (println qs))) n n))
(defn nqueens' [n]
(let [c (atom 0)]
(permutation-int (fn [qs] (when (safe qs) (swap! c inc))) n n)
@c))
;; 高速化
(defn nqueens-fast
([f m n] (nqueens-fast f m n (hash-set) '()))
([f m n u a]
(if (zero? n)
(f (reverse a))
(dotimes [x m]
(when (and (not (contains? u x))
(not (attack x a)))
(nqueens-fast f m (dec n) (conj u x) (cons x a)))))))
(defn nqueens-fast' [n]
(let [c (atom 0)]
(nqueens-fast (fn [qs] (swap! c inc)) n n)
@c))
;;;
;;; マスターマインドの解法
;;;
;; 順列をリストに格納して返す
(defn permutations [n xs]
(if (zero? n)
'(())
(mapcat (fn [x]
(map (fn [ys] (cons x ys))
(permutations (dec n) (remove #(= x %) xs))))
xs)))
;; pred が真を返す要素をカウントする
(defn count-if [pred xs]
(loop [[y & ys :as xs] xs
c 0]
(if-not (seq xs)
c
(recur ys (if (pred y) (inc c) c)))))
;; bulls をカウント
(defn count-bulls [xs ys]
(count-if identity (map == xs ys)))
;; 同じ数字をカウント
(defn count-same-number [xs ys]
(reduce (fn [c x] (if (neg? (.indexOf ys x)) c (inc c))) 0 xs))
;; コードのチェック
(defn check-code [code [qcode qbulls qcows]]
(let [bulls (count-bulls qcode code)
cows (- (count-same-number qcode code) bulls)]
(and (== qbulls bulls) (== qcows cows))))
(defn mastermind [answer]
(loop [[code & cs :as xs] (permutations 4 (range 0 10))
query '()]
(if-not (seq xs)
(println "Oops!!")
(if (every? (fn [qs] (check-code code qs)) query)
(let [bulls (count-bulls answer code)
cows (- (count-same-number answer code) bulls)]
(printf "%2d: %s, bulls = %d, cows = %d\n" (inc (count query)) code bulls cows)
(if (== bulls 4)
(println "Good Job!!")
(recur cs (conj query (list code bulls cows)))))
(recur cs query)))))