HOME もうひとつの Scheme 入門 download 書き込む

Appendix 1. N Queens パズル


1. 初めに

今までの説明で通常のプログラムは書けるようになったので、 今回は復習をかねて、 N Queen パズルを取り上げます。 このパズルは N x N のチェス盤の上に N 個の Queen を互いの利き筋が重ならない(つまり、一手ではお互いに取られない) ように置くパズルです。Queen はチェスの駒で、縦横、斜めに駒にぶつかるか、盤の端に来るまで好きなだけ動けます。 (日本将棋の飛車と角を合わせた動きをします。)

8 x 8 のチェス盤の場合、解は 92 個あります。チェス盤の対称操作を考慮すると独立の解は 12 個になります。 ここでは、対称操作を考慮した解を求めてみます。 このパズルを解くプログラムには再帰関数がふんだんに出てくるので Scheme 向きの問題といえます。 Scheme である程度大きいプログラムを書くとどんな感じになるか見てください。

2. パズルの解き方

2.1. 縦横の利きの避け方

Queen は縦横に利いているので、それぞれの行と列には Queen は1つずつしか入れません。 従って、0 から (n-1) の整数の順列を作り、数が行、数の位置が列を表すようにすれば、 縦横の利きはぶつかりません。(図1)後は斜めの利きがぶつからないようにしながら Queen を置いていけば 解けます。


'(3 1 6 2 5 7 4 0)

図1:0 から (n-1) の整数の順列を作り、数が行、数の位置が列を表すようにすれば、 縦横の利きは避けることができる。

2.2. 斜めの利き避け方

Queen は盤の右から左に向かって置いていきます。

新しく置かれた Queen の行の位置を p とすると、隣の列での斜めの利きは (p+1), (p-1) となり、列の移動に伴って1つ増えるか、1つ減るかします。従って、新しく置かれた Queen q がすでに盤上にある Queen qs とぶつかるかどうかは次の関数で調べることができます。(2.1. の方針に従って 縦横はぶつからないことが保証されているとします。)

[code 1]

01:     (define (conflict? q qs)
02:       (let loop((inc (1+ q)) (dec (1- q)) (ls0 qs))
03:         (if (null? ls0)
04:             #f
05:           (let ((c (car ls0)))
06:             (or
07:              (= c inc)
08:              (= c dec)
09:              (loop (1+ inc) (1- dec) (cdr ls0)))))))
関数 conflict? は Queen の利きが衝突すれば #t をしなければ #f を返します。 ここで (1+ x), (1- x) は引数 x に1を加える、1 を引く関数です。

2.3. Queen を盤に置いていく

Queen を盤に置いていくには [code 2] に示す q-add を使います。 q-addqueen の内部関数です。

[code 2]

01:         (letrec ((q-sethash (lambda (qs)                 ;; registrate on the hash table
02:                               (let ((qi (q2int n qs)))
03:                                 (if (eq? (hash-table/get qsol qi 'not-yet) 'not-yet)
04:                                     (begin
05:                                      (for-each
06:                                       (lambda (op)
07:                                         (hash-table/put! qsol (q2int n (op qs)) #f))
08:                                       (list t90 t180 t270 reverse usd d1 d2))
09:                                      (hash-table/put! qsol qi #t))))))
10:                               
11:                   
12:                  (q-add (lambda (qs i pool)             ;; adding new queen
13:                           (if (= i n)
14:                               (q-sethash qs)
15:                             (for-each (lambda (x)
16:                                         (or (conflict? x qs)
17:                                             (q-add (cons x qs) (1+ i) (remove x pool))))
18:                                       pool)))))
19:                           
20:                 (q-add () 0 (range n)))
q-add はすでに盤上にある Queen のリスト qs と置かれている Queen の数 i とまだ使われていない行のリスト pool の3つの引数をとります。置かれている Queen の数が n に等しいときは、q-sethash 補助関数を使って解をハッシュ表に登録します。そうでなければ、pool に残っている行について、すでに置かれている Queen と衝突するか調べ、衝突しなければ、それを盤上に加え、pool からそれを取り除いて、 q-add を繰り返します。 (remove x ls) は ls から x を取り除いたリストを返す関数です。付録の nqueen.scm にその定義があります。

2.4. 解をハッシュ表に登録する

[code 2] の補助関数 q-sethash を使って解をハッシュ表に登録します。

q-sethash では、まず、解を q2int で整数に変えてハッシュ表のキーにします。 次に、解がすでにハッシュ表に登録されているか調べます。 もし、登録されていなければ、対称操作で生ずる盤面を値 #f で登録し、その後、もとの盤面を 値 #t で登録します。こうすると、対称操作で互いの変換できない独立した解のみが値 #t でハッシュ表に登録されます。

N Queens を解く関数 (queen n) は [code 3] のようになります。 24 行目の (q-add () 0 (range n))) でを探し始め、25--27 行目で独立解を選び出し、 28 行目でプロットします。 値が何も返らないと落ち着かないので、解の数を返すようにします。

[code 3]

01:     (define (queen n)
02:       (let ((qsol (make-eqv-hash-table))
03:             (qlist '()))
04:         (letrec ((q-sethash (lambda (qs)                 ;; registrate on the hash table
05:                               (let ((qi (q2int n qs)))
06:                                 (if (eq? (hash-table/get qsol qi 'not-yet) 'not-yet)
07:                                     (begin
08:                                      (for-each
09:                                       (lambda (op)
10:                                         (hash-table/put! qsol (q2int n (op qs)) #f))
11:                                       (list t90 t180 t270 reverse usd d1 d2))
12:                                      (hash-table/put! qsol qi #t))))))
13:                               
14:                   
15:                  (q-add (lambda (qs i pool)             ;; adding new queen
16:                           (if (= i n)
17:                               (q-sethash qs)
18:                             (for-each (lambda (x)
19:                                         (or (conflict? x qs)
20:                                             (q-add (cons x qs) (1+ i) (remove x pool))))
21:                                       pool)))))
22:                           
23:                 (q-add () 0 (range n)))
24:         (hash-table/for-each qsol                       ;; pick up distinct solutions
25:                              (lambda (k v)
26:                                (if v (set! qlist (cons (int2q n k) qlist)))))
27:         (qplot n qlist)   ;; plotting the distinct solutions
28:         (length qlist)))

2.5. 対称操作

対称操作には、動かさないという操作のほかに、90, 180, 270 度回転、上下、左右、対角線(2つ)反転 の7つがあります。回転は、N Queens パズルの性質から、0 -- (n-1) の数の列の位置を返すと 90 度回転になります。 対称操作関数を [code 4] に挙げます。

[code 4]

01:     ;;; symmetry operations
02:     ;; turn 90 degree
03:     (define (t90 qs)
04:       (let ((n (length qs)))
05:         (let loop ((ls1 ()) (i 0))
06:           (if (= i n)
07:               ls1
08:             (loop (cons (position i qs) ls1) (1+ i))))))
09:     
10:     ;; turn 180 degree
11:     (define (t180 qs)
12:       (usd (reverse qs)))
13:     
14:     ;; turn 270 degree
15:     (define (t270 qs)
16:       (t90 (t180 qs)))
17:     
18:     ;; up side down
19:     (define (usd qs)
20:       (let ((n (1- (length qs))))
21:         (map (lambda (x) (- n x)) qs)))
22:     
23:     ;; reflection on diagonal 1
24:     (define (d1 qs)
25:       (reverse (t90 qs)))
26:     
27:     ;; reflection on diagonal 2
28:     (define (d2 qs)
29:       (usd (t90 qs)))

2.6. 結果の表示

結果の表示には
gnuplot を使います。

MIT-Scheme には graphic が付いていますが、gnuplot で書かせたほうが簡単です。 表示の部分のコードを [code 5] に示します。i 番目の解に対して qi.dat という データファイルをつくり、それを queen.plt というコマンドファイルでプロットします。 gnuplot のコンソールに
load 'queen.plot'
と与えると、図に示すプロットが表示され、ダイアログで 'OK' をクリックすると次の解が表示されます。


図2: N Queen パズルの解の表示
[code 5]
01:     ;;; plotting using gnuplot
02:     ;; drawing grid
03:     (define (draw-grid n)
04:       (let ((p (number->string (1+ n))))
05:         (let loop((i 0))
06:           (if (<= i n)
07:               (let ((s (number->string (1+ i))))
08:                 (print-lines
09:                  (string-append "set arrow from " s ", 1 to " s ", " p " nohead lt 5")
10:                  (string-append "set arrow from 1, " s " to " p ", " s " nohead lt 5"))
11:                 (loop (1+ i)))))))
12:         
13:     
14:     ;; plotting data file of the solution
15:     (define (plot-queen len)
16:       (let loop((i 0))
17:         (if (< i len)
18:             (begin
19:              (print-lines
20:               (string-append "set title \"solution: " (number->string (1+ i)) "\"")
21:               (string-append "plot \"q" (number->string i) ".dat\" title \"queen\" with point pointsize 3")
22:               "pause -1 \"Hit return to continue\"")
23:              (loop (1+ i))))))
24:     
25:     ;; writing data files
26:     (define (q-write-dat qls)
27:       (let loop((i 0) (ls qls))
28:         (if (pair? ls)
29:             (begin
30:              (with-output-to-file (string-append "q" (number->string i) ".dat")
31:                 (lambda ()
32:                   (let rec((j 0) (ls1 (car ls)))
33:                     (if (pair? ls1)
34:                         (begin
35:                          (print-lines (string-append (number->string (+ j 1.5)) " " (number->string (+ (car ls1) 1.5))))
36:                          (rec (1+ j) (cdr ls1)))))))
37:              (loop (1+ i) (cdr ls))))))
38:                        
39:     ;; making a command file for gnuplot                
40:     (define (qplot n qls)
41:       (q-write-dat qls)
42:       (with-output-to-file "queen.plt"
43:         (lambda ()
44:           (let ((s (number->string (+ n 2))))
45:             (print-lines
46:              "reset"
47:              "set size square"
48:              (string-append "set xrange [0:" s "]")
49:              (string-append "set yrange [0:" s "]"))
50:             (draw-grid n)
51:             (plot-queen (length qls))))))
52:           

3. 付録の使い方

付録には nqueen.scm が入っているので、 次のようにして遊んでください。
  1. 付録をどこかのディレクトリに解凍する。
  2. MIT-Scheme のコンパイラを立ち上げて、そのディレクトリに行く
  3. nqueen.scm をコンパイルする (compile-file "nqueen.scm")
  4. nqueen をロードする (load "nqueen")
  5. (queen n) としてパズルを解く。n は盤の大きさ、8x8 の時は n = 8 にする。
  6. gnuplot を立ち上げて、nqueen.scm のあるディレクトリに行く
  7. gnuplot のコンソールから load 'queen.plt' と入力する。 すると 図2 に示したプロットが表示される。
コンパイルすると実行時間が早くなります。 queen の場合コンパイルによって 40 倍以上早くなりました。

処理時間を比較するには with-timing を使います。 例えば、(queen 10) の速度を計測するには以下のようにします。 計算に要した時間、ごみ集めに要した時間、合計の時間が表示されます。

(with-timings
 (lambda () (queen 10))
 (lambda (run-time gc-time real-time)
   (write (internal-time/ticks->seconds run-time))
   (write-char #\space)
   (write (internal-time/ticks->seconds gc-time))
   (write-char #\space)
   (write (internal-time/ticks->seconds real-time))
   (newline)))

練習問題 1

[code 3] の関数 queen を改造して、 N Queens パズルの解のうち、対称性を持つ解を求める関数 queen_sym を書いてください。
また、N Queens の性質から、どういう対象性が許されるか考えてください。

4. 終わりに

今回は今までの復習として少し大きめのプログラムを書いてみました。 大き目といっても、200 行弱で、そのうち、汎用ユーティリティが 40 行、 出力が 50 行占めています。単にリストを返すだけなら 150 行弱で書けることになります。

ソースコードを見ていただくとわかるように、queen を除く全ての関数が 20 行以下で書かれています。 Scheme ではこのように小さい関数を積み上げてプログラムを作っていきます。

練習問題の解答

練習問題 1

q-sethsh を少し変えて、対称操作によって、自分自身に重なるものだけをハッシュ表に登録します。
反転対称性をもつ解は Queen の利き筋から存在しません。90 度回転の対称性を持つ解は珍しく、 13x13 以下では 4x4, 5x5, 12x12, 13x13 の場合にしかありません。(図3)ほとんどは 180 度回転の対象性を持ちます。

図3:90 度回転対称性を持つ解
01:     ;;; the main function
02:     (define (queen_sym n)
03:       (let ((qsol (make-eqv-hash-table))
04:             (qlist '()))
05:         (letrec ((q-sethash (lambda (qs)                 ;; registrate on the hash table
06:                               (let ((qi (q2int n qs)))
07:                                 (if (eq? (hash-table/get qsol qi 'not-found) 'not-found)
08:                                     (let ((sym (map (lambda (op) (q2int n (op qs)))
09:                                                     (list t90 t180 t270 reverse usd d1 d2))))
10:                                       (if (memv qi sym)
11:                                           (begin
12:                                            (for-each
13:                                             (lambda (v)
14:                                               (hash-table/put! qsol v #f))
15:                                             sym)
16:                                            (hash-table/put! qsol qi #t))))))))
17:                               
18:                  (q-add (lambda (qs i pool)             ;; adding new queen
19:                           (if (= i n)
20:                               (q-sethash qs)
21:                             (for-each (lambda (x)
22:                                         (or (conflict? x qs)
23:                                             (q-add (cons x qs) (1+ i) (remove x pool))))
24:                                       pool)))))
25:                           
26:                 (q-add () 0 (range n)))
27:         (hash-table/for-each qsol                       ;; pick up distinct solutions
28:                              (lambda (k v)
29:                                (if v (set! qlist (cons (int2q n k) qlist)))))
30:         (qplot n qlist)   ;; plotting the distinct solutions
31:         (length qlist)))