今回は皆さんお馴染みのパズル「数独 (ナンバープレース)」の解法プログラムを作りましょう。本稿では「ナンプレ」と呼ぶことにします。
ナンプレは 9×9 の盤を用いて、縦 9 列、横 9 列のそれぞれに 1 から 9 までの数字を一つずつ入れます。また、太線で囲まれた 3×3 の枠内にも 1 から 9 までの数字を一つずつ入れます。縦、横、枠の中で、同じ数字が重複して入ることはありません。
パズルの解き方 [*1] ですが、基本的には次の条件を満たすマスを探して数字を確定していきます。
(1) は簡単ですね。(2) は次の例をみてください。
置くことができる数字
--------------------------
８
Ａ [4,5,7,9]
Ｂ [4,5,7]
６
２
Ｃ [3,5,7]
１
Ｄ [4,5,9]
Ｅ [4,9]
これは縦 1 列を抜き出したものです。マス C に注目してください。C には 3, 5, 7 を置くことができるので、条件 (1) で確定することはできません。ここで縦全体を見てください。この中で、数字 3 を置くことができるのは、このマスしかありませんね。したがって、C は 3 に確定することができるのです。同じように、横の関係、枠の関係で数字を確定することができます。
条件を満たすマスを探して数字を確定していくと、そのことで新たに (1) か (2) を満たすマスが出てくるので、それを探して数字を確定します。これを繰り返すことで、ナンプレを解くことができます。本稿ではこれを「確定サーチ」と呼ぶことにします。ナンプレの多くは、この確定サーチで解くことができるのですが、実はこれでは解けない難しい問題があるのです。
このような難しい問題をどうやって解くのか M.Hiroi には見当もつきませんが、コンピュータを使えば「試行錯誤」という力技で解を見つけることができます。つまり、適当な数字を選んでマスを埋めていき、矛盾するようであれば元に戻って違う数字を選び直せばいいわけです。今回は確定サーチを使わずに「バックトラック」だけでプログラムを作ることにします。
それでは、プログラムを作りましょう。最初に盤面を定義します。次の図を見てください。
列 0 1 2 3 4 5 6 7 8 行 +-------+-------+-------+ (number-get board y x) 0 | | | | y : 行 (横) 1 | 枠 0 | 1 | 2 | x : 列 (縦) 2 | | | | +-------+-------+-------+ 3 | | | | 4 | 3 | 4 | 5 | 5 | | | | +-------+-------+-------+ 6 | | | | 7 | 6 | 7 | 8 | 8 | | | | +-------+-------+-------+ 図 : 数独 (9 * 9) の盤面
今回は盤面を二次元配列で表します。R7RS-small の場合、多次元配列は仕様に規定されていないので、ベクタのベクタで二次元配列を表すことにします。要素は 0 から 9 までの数字です。0 が空き場所を表します。
次は盤面を操作する関数を作ります。
リスト : 盤面の操作関数 (define SIZE 9) ;;; 盤面の生成 (list -> vector) (define (make-board xss) (apply vector (map (lambda (xs) (list->vector xs)) xss))) ;;; 盤面のアクセス (define (number-get board y x) (vector-ref (vector-ref board y) x)) (define (number-set! board y x n) (vector-set! (vector-ref board y) x n))
関数 make-board は盤面 (ベクタのベクタ) を生成します。引数 xss は問題を表すリスト (リストのリスト) です。map で xss の要素 (リスト) をベクタに変換して、それを vector でベクタに格納します。関数 number-get は盤面 board の y 行 x 列の位置にある数字を取り出します。関数 number-set! は board の y 行 x 列の位置に数字 n を書き込みます。
枠の左上の位置 (y1, x1) は、次の式で求めることができます。
y1 = (y / 3) * 3, x1 = (x / 3) * 3
整数の割り算 quotient を使えば、0, 1, 2 は 0 に、3 ,4, 5 は 1 に、6, 7, 8 は 2 になります。それに 3 を掛け算すれば、枠の左上の位置を求めることができます。
縦、横、枠で同じ数字がないかチェックするプログラムは次のようになります。
リスト : 縦、横、枠のチェック
(define (safe? board y x n)
(call/cc
(lambda (ret)
(do ((i 0 (+ i 1)))
((>= i SIZE))
(when
(or (= (number-get board y i) n)
(= (number-get board i x) n))
(ret #f)))
(let ((x1 (* (quotient x 3) 3))
(y1 (* (quotient y 3) 3)))
(do ((i 0 (+ i 1)))
((>= i 3))
(do ((j 0 (+ j 1)))
((>= j 3))
(when
(= (number-get board (+ y1 i) (+ x1 j)) n)
(ret #f))))))))
関数 safe? は縦横枠をチェックして、引数 n と同じ数字が無ければ真 (#t) を返します。最初の do ループで縦と横をチェックします。同じ数字があれば、継続 ret を評価して #f を返します。次に、変数 x1, y1 に枠の左上隅の座標を求め、二重の do ループで枠内に n と同じ数字があるかチェックします。
最後に、深さ優先探索で解を求める関数 solver を作ります。
リスト : ナンプレの解法 (1)
(define (solver board y x)
(cond
((= y SIZE)
(print-board board))
((= x SIZE)
(solver board (+ y 1) 0))
((zero? (number-get board y x))
(do ((n 1 (+ n 1)))
((> n SIZE))
(when
(safe? board y x n)
(number-set! board y x n)
(solver board y (+ x 1))
(number-set! board y x 0))))
(else
(solver board y (+ x 1)))))
引数 y が SIZE と等しい場合、すべてのマスに数字を置くことができました。関数 print-board で解を表示します。引数 x が SIZE と等しい場合、y 行のマスに数字を置くことができたので次の行に進みます。マス (y, x) が空き場所の場合、1 から 9 までの数字を述語 safe? に渡して、その数字を (y, x) に置くことができるかチェックします。返り値が真の場合、(y, x) に数字 n をセットして、solver を再帰呼び出しします。戻ってきたら (y, x) を空き場所 (0) に戻すことをお忘れなく。
あとのプログラムは簡単なので説明は割愛します。詳細はプログラムリスト１をお読みください。
それでは、実際に数独を解いてみましょう。
リスト : 問題 (出典: 数独 - Wikipedia の問題例)
(define q00
'((5 3 0 0 7 0 0 0 0)
(6 0 0 1 9 5 0 0 0)
(0 9 8 0 0 0 0 6 0)
(8 0 0 0 6 0 0 0 3)
(4 0 0 8 0 3 0 0 1)
(7 0 0 0 2 0 0 0 6)
(0 6 0 0 0 0 2 8 0)
(0 0 0 4 1 9 0 0 5)
(0 0 0 0 8 0 0 7 9)))
gosh[r7rs.user]> (let ((board (make-board q00))) (print-board board) (display "-------------------\n") (solver board 0 0)) 5 3 0 0 7 0 0 0 0 6 0 0 1 9 5 0 0 0 0 9 8 0 0 0 0 6 0 8 0 0 0 6 0 0 0 3 4 0 0 8 0 3 0 0 1 7 0 0 0 2 0 0 0 6 0 6 0 0 0 0 2 8 0 0 0 0 4 1 9 0 0 5 0 0 0 0 8 0 0 7 9 ------------------- 5 3 4 6 7 8 9 1 2 6 7 2 1 9 5 3 4 8 1 9 8 3 4 2 5 6 7 8 5 9 7 6 1 4 2 3 4 2 6 8 5 3 7 9 1 7 1 3 9 2 4 8 5 6 9 6 1 5 3 7 2 8 4 2 8 7 4 1 9 6 3 5 3 4 5 2 8 6 1 7 9 #t
ヒント (初期配置の数字) が多い問題であれば、単純な深さ優先探索でも一瞬で解を求めることができます。そこで、もう少し難しい問題を解いてみましょう。deepgreen さんが作成された「ナンプレ問題集」より問題 9909-c1, 9909-d1, 9909-e1, 9909-h1, 9909-h2 を試してみたところ、実行時間は次のようになりました。
表 : 実行結果 問題 : Hint : 秒 ------+------+------- c1 : 22 : 3.50 d1 : 21 : 17.25 e1 : 24 : 3.07 h1 : 23 : 0.38 h2 : 24 : 1.20 実行環境 : Gauche ver 0.9.9, Ubunts 18.04 (WSL), Intel Core i5-6200U 2.30GHz
このように、9 行 9 列盤の数独は単純なバックトラックで簡単に解くことができますが、問題によっては時間がかかります。今回の処理で時間がかかっているのは、数字を選択する処理です。空き場所に置くことができる数字を簡単に求めることができれば、もっと速くなるかもしれません。
そこで、空き場所に置くことができる数字をデータとして持たせることにします。置くことができる数字は、各マスごとに持たせるのが自然な考え方です。必要なときに数字を直に求めることができますし、マスに数字を置いたならば、そのマスが属している縦、横、枠のマスに対して数字を削除すればいいわけです。ところが、バックトラックするとなると、これでは問題があるのです。
バックトラックする場合、マスに埋めた数字を空白に戻す処理が必要になります。当然ですが、置くことができる数字も元の状態に戻さなくてはいけません。このとき、各マスごとに数字を持たせていると、数字を空白に戻すときに、縦、横、枠に対して単純に数字を追加するだけでは、元の状態に戻すことができません。次の例を見てください。
数字リスト 数字リスト 数字リスト
------------------ ------------------ ------------------
８ ８ ８
Ａ [4,5,7,9] ７ Ａ [4,5,7,9]
Ｂ [4,5,7] Ｂ [4,5] Ｂ [4,5,7]
６ ６ ６
２ ２ ２
３ ３ ３
１ １ １
Ｃ [4,5,9] Ｃ [4,5,9] Ｃ [4,5,7,9]
Ｄ [4,9] Ｄ [4,9] Ｄ [4,7,9]
(1)最初の状態 (2)Ａに 7 を置く (3)Ａを元に戻す
A から D の 4 箇所のマスが空いています。ここで、A を 7 としてみましょう。B, C, D から 7 を削除すると (2) の状態になります。次に、A を元に戻してみましょう。ここで、単純に数字 7 を追加すると (3) の状態になります。C と D は元の状態には戻っていませんね。 縦、横、枠の関係から、C と D には 7 を置くことができない状態だったので、無条件に 7 を追加することはできないのです。
結局、置くことができる数字を元の状態に戻すには、値を書き換えるときに元の値を保存しておいて、後戻りするときに値を元に戻す処理が必要になります。バックトラックでは、後戻りする処理が頻繁に発生するので、これでは時間がかかってしまいます。そこで、参考文献『実践アルゴリズム戦略 解法のテクニック <第11回> バックトラックによる｢数独｣の解法』に書かれていた方法を採用します。それは、「縦、横、枠のそれぞれについて、置くことができる数字をビットで管理する」という方法です。
ビットと数字の関係は次のように定義しましょう。
bit 9 8 7 6 5 4 3 2 1 0 => 数字に対応させる
---------------------
1 1 1 1 1 1 1 1 1 0 => #x3fe : すべての数字を置くことができる
第 0 ビットはダミーとします。置くことができる数字は対応するビットをセットし、そうでなければビットをクリアします。
縦、横、枠の状態は、ベクタ *xflag*, *yflag*, *gflag* で管理します。次の図を見てください。
9876543210
----------
(vector-ref *xflag* 0) => 0110111010
↓
┏━┯━┯━┳━┯━┯━┳━┯━┯━┓
(vector-ref *yflag* 0)→┃◎│３│ ┃９│１│７┃ │ │８┃
┠─┼─┼─╂─┼─┼─╂─┼─┼─┨
9876543210┃ │８│２┃ │ │６┃ │３│ ┃
----------┠─┼─┼─╂─┼─┼─╂─┼─┼─┨
0001110100┃９│ │ ┃ │２│ ┃ │ │ ┃
┣━┿━┿━╋━┿━┿━╋━┿━┿━┫
┃ │ │７┃
┠─┼─┼─╂ 9876543210
┃ │ │９┃ ----------
┠─┼─┼─╂ (vector-ref *gflag* 0) => 0011110010
┃ │２│ ┃
┣━┿━┿━╋
┃６│９│ ┃
┠─┼─┼─╂
┃２│ │８┃
┠─┼─┼─╂
┃ │ │５┃
┗━┷━┷━┻
左上隅のマス◎に注目してください。縦で使われている数字は 2, 6, 9 なので、*xflag* の 0 番目の要素は 2 進数で表すと 0110111010 になります。横は 1, 3, 7, 8, 9 が使われているので、*yflag* の 0 番目の要素は 0001110100 となります。枠 *gflag* の 0 番目の要素は、2, 3, 8, 9 が使われているので 0011110010 となります。
マス◎に置くことができる数字は、この 3 つの状態でビットが立っている数字、つまり、ビットの論理積で求めることができます。
9876543210
----------
(vector-ref *xflag* 0) => 0110111010
(vector-ref *yflag* 0) => 0001110100
(vector-ref *gflag* 0) => 0011110010
AND ----------
0000110000
マス◎に置くことができる数字は 4, 5 であることがわかります。なお、枠の番号 g は次の式で求めることができます。
g = (y / 3) * 3 + x / 3
演算子 / は整数の除算 (quotient) を表します。x = 0 の場合、y の値で 0, 3, 6 になればいいので、(y / 3) * 3 で求めることができます。y = 0 の場合、x / 3 で 0, 1, 2 になります。あとは、これを足し算すればいいわけです。
このように、縦、横、枠に分けて数字を管理するため、マスに置くことができる数字はいちいち AND 演算しなければ求めることができません。ところが、マスに数字を置くときは縦、横、枠の該当するビットをクリアするだけでいいのです。また、元に戻すときも、縦、横、枠の該当するビットをセットするだけで済むので、簡単にバックトラックすることができます。
それではプログラムを作りましょう。今回は盤面の数字もビットの位置で表すことにします。空き場所は今までと同じく 0 で表します。*xlag*, *yflag*, *gflag* の初期化は関数 init-board で行います。
フラグの操作関数は次のようになります。
リスト : フラグのアクセス関数
;;; 枠の番号
(define (group-number y x)
(+ (quotient x 3) (* (quotient y 3) 3)))
;;; フラグを反転する
(define (rev-flag y x m)
(let ((z (group-number y x)))
(vector-set! *xflag* x (bitwise-xor (vector-ref *xflag* x) m))
(vector-set! *yflag* y (bitwise-xor (vector-ref *yflag* y) m))
(vector-set! *gflag* z (bitwise-xor (vector-ref *gflag* z) m))))
;;; 使用可能な数字をビットで求める
(define (available-number y x)
(bitwise-and (vector-ref *xflag* x)
(vector-ref *yflag* y)
(vector-ref *gflag* (group-number y x))))
関数 rev-flag は (y, x) のセルに数字 m を書き込んだとき、該当するフラグをクリアします。枠の番号は関数 group-number で求めます。関数 available-number は (y, x) のセルに置くことができる数字を求めます。*xflag*, *yflag*, *gflag* の論理積を bitwise-and で求めるだけです。
次は盤面とフラグを初期化する関数 init-board を作ります。
リスト : 盤面とフラグの初期化
(define (make-board xss)
(define (num->bit xs)
(map (lambda (x) (if (positive? x) (arithmetic-shift 1 x) 0)) xs))
;;
(apply vector (map (lambda (xs) (list->vector (num->bit xs))) xss)))
(define (init-board xss)
(let ((board (make-board xss)))
(set! *xflag* (make-vector SIZE #b1111111110))
(set! *yflag* (make-vector SIZE #b1111111110))
(set! *gflag* (make-vector SIZE #b1111111110))
(do ((y 0 (+ y 1)))
((>= y SIZE) board)
(do ((x 0 (+ x 1)))
((>= x SIZE))
(let ((num (number-get board y x)))
(unless
(zero? num)
(rev-flag y x num)))))))
最初に make-board で盤面を生成します。このとき、ヒントの数字をビットに変換しています。それから、要素が #b1111111110 (#x3fe) のベクタを生成して *xflag*, *yflag*, *gflag* にセットします。次に、二重の do ループで board の要素をチェックします。number-get で board から数字を取り出して変数 num にセットします。num が 0 でなければ、対応するフラグを rev-flag でクリアします。
最後にバックトラックで解を求める関数 solver を作ります。
リスト : ナンプレの解法
;;; 数字を置く
(define (number-set! board y x num)
(vector-set! (vector-ref board y) x num)
(rev-flag y x num))
;;; 数字を消す
(define (number-del! board y x num)
(vector-set! (vector-ref board y) x 0)
(rev-flag y x num))
;;; ビット用高階関数
(define (bit-for-each proc n)
(when
(positive? n)
(let ((m (bitwise-and n (- n))))
(proc m)
(bit-for-each proc (bitwise-xor n m)))))
;;; 単純な深さ優先探索
(define (solver board y x)
(cond
((= y SIZE)
(print-board board))
((= x SIZE)
(solver board (+ y 1) 0))
((zero? (number-get board y x))
(bit-for-each
(lambda (num)
(number-set! board y x num)
(solver board y (+ x 1))
(number-del! board y x num))
(available-number y x)))
(else
(solver board y (+ x 1)))))
available-number でマス (y, x) に置くことができる数字を求め、それを高階関数 bit-for-each に渡します。bit-for-each は、ビットを順番に取り出してラムダ式を呼び出します。ラムダ式の引数 num が数字を表すビットです。number-set! は num を board に書き込み、rev-flag でフラグを反転します。再帰呼び出しから戻ってきたら、number-del! で書き込んだ数字を 0 に戻し、rev-flag でフラグを反転して元に戻します。
それでは、実行してみましょう。deepgreen さんが作成された「ナンプレ問題集」より問題 9909-c1, 9909-d1, 9909-e1, 9909-h1, 9909-h2 を試してみたところ、実行時間は次のようになりました。
表 : 実行結果 (単位 : 秒) 問題 : Hint : (1) : (2) ------+------+-------+------- c1 : 22 : 3.50 : 0.40 d1 : 21 : 17.25 : 1.79 e1 : 24 : 3.07 : 0.32 h1 : 23 : 0.38 : 0.04 h2 : 24 : 1.20 : 0.17 実行環境 : Gauche ver 0.9.9, Ubunts 18.04 (WSL), Intel Core i5-6200U 2.30GHz
どの問題でも実行時間は (1) よりも約 7 倍から 9 倍ほど速くなりました。ビット操作による高速化の効果は十分に出ていると思います。ここでバックトラックする前に「確定サーチ」を行うと、実行時間はもっと速くなります。次回は確定サーチを実装して、更なる高速化に挑戦してみましょう。
;;;
;;; numplace.scm : ナンバープレース
;;;
;;; Copyright (C) 2010-2020 Makoto Hiroi
;;;
(import (scheme base) (scheme write) (scheme time))
(define SIZE 9)
;;; 盤面の生成 (list -> vector)
(define (make-board xss)
(apply vector (map (lambda (xs) (list->vector xs)) xss)))
;;; 盤面のアクセス
(define (number-get board y x)
(vector-ref (vector-ref board y) x))
(define (number-set! board y x n)
(vector-set! (vector-ref board y) x n))
;;; 盤面の表示
(define (print-board board)
(vector-for-each
(lambda (xs)
(vector-for-each
(lambda (x) (display x) (display " "))
xs)
(newline))
board))
;;; 安全確認
(define (safe? board y x n)
(call/cc
(lambda (ret)
(do ((i 0 (+ i 1)))
((>= i SIZE))
(when
(or (= (number-get board y i) n)
(= (number-get board i x) n))
(ret #f)))
(let ((x1 (* (quotient x 3) 3))
(y1 (* (quotient y 3) 3)))
(do ((i 0 (+ i 1)))
((>= i 3))
(do ((j 0 (+ j 1)))
((>= j 3))
(when
(= (number-get board (+ y1 i) (+ x1 j)) n)
(ret #f))))))))
;;; 単純な深さ優先探索
(define (solver board y x)
(cond
((= y SIZE)
(print-board board))
((= x SIZE)
(solver board (+ y 1) 0))
((zero? (number-get board y x))
(do ((n 1 (+ n 1)))
((> n SIZE))
(when
(safe? board y x n)
(number-set! board y x n)
(solver board y (+ x 1))
(number-set! board y x 0))))
(else
(solver board y (+ x 1)))))
;;;
;;; numplace2.scm : ナンバープレース (ビット版)
;;;
;;; Copyright (C) 2010-2020 Makoto Hiroi
;;;
(import (scheme base) (scheme write) (scheme time)
(scheme bitwise))
;;; 大域変数
(define SIZE 9)
(define *xflag* #f)
(define *yflag* #f)
(define *gflag* #f)
;;; 枠の番号
(define (group-number y x)
(+ (quotient x 3) (* (quotient y 3) 3)))
;;; フラグを反転する
(define (rev-flag y x m)
(let ((z (group-number y x)))
(vector-set! *xflag* x (bitwise-xor (vector-ref *xflag* x) m))
(vector-set! *yflag* y (bitwise-xor (vector-ref *yflag* y) m))
(vector-set! *gflag* z (bitwise-xor (vector-ref *gflag* z) m))))
;;; 使用可能な数字をビットで求める
(define (available-number y x)
(bitwise-and (vector-ref *xflag* x)
(vector-ref *yflag* y)
(vector-ref *gflag* (group-number y x))))
;;; 数字を得る
(define (number-get board y x)
(vector-ref (vector-ref board y) x))
;;; 数字を置く
(define (number-set! board y x num)
(vector-set! (vector-ref board y) x num)
(rev-flag y x num))
;;; 数字を消す
(define (number-del! board y x num)
(vector-set! (vector-ref board y) x 0)
(rev-flag y x num))
;;; 初期化
(define (make-board xss)
(define (num->bit xs)
(map (lambda (x) (if (positive? x) (arithmetic-shift 1 x) 0)) xs))
;;
(apply vector (map (lambda (xs) (list->vector (num->bit xs))) xss)))
(define (init-board xss)
(let ((board (make-board xss)))
(set! *xflag* (make-vector SIZE #b1111111110))
(set! *yflag* (make-vector SIZE #b1111111110))
(set! *gflag* (make-vector SIZE #b1111111110))
(do ((y 0 (+ y 1)))
((>= y SIZE) board)
(do ((x 0 (+ x 1)))
((>= x SIZE))
(let ((num (number-get board y x)))
(unless
(zero? num)
(rev-flag y x num)))))))
;;; 盤面の表示
(define (print-board board)
(vector-for-each
(lambda (xs)
(vector-for-each
(lambda (x) (display (bit-count (- x 1))) (display " "))
xs)
(newline))
board))
;;; ビット用高階関数
(define (bit-for-each proc n)
(when
(positive? n)
(let ((m (bitwise-and n (- n))))
(proc m)
(bit-for-each proc (bitwise-xor n m)))))
;;; 単純な深さ優先探索
(define (solver board y x)
(cond
((= y SIZE)
(print-board board))
((= x SIZE)
(solver board (+ y 1) 0))
((zero? (number-get board y x))
(bit-for-each
(lambda (num)
(number-set! board y x num)
(solver board y (+ x 1))
(number-del! board y x num))
(available-number y x)))
(else
(solver board y (+ x 1)))))