Scheme で解く 8 queens puzzle
[Background]
現在友人三人と以下にある "Structure and Interpretation of Computer Programs" という本 (SICP と呼んでいます。いわゆる「魔術師本」) の日本語訳でゼミをしています。簡単に言うとプログラミング言語のひとつである LISP の方言である Scheme について書きながらアルゴリズムの設計の仕方やデータ構造についても説明がなされている本です。
練習問題の答えをメモ代わりに貼っているブログもあります。
sicp-zemi.hatenablog.jp
ここにある練習問題 2.42 がなかなか面白かったのでいろいろ遊んでみました。
まず問題は、 "8 queens puzzle" と呼ばれるもので、 8×8 マスのチェス盤の上に 8 個のクイーンを置くのですが、その 8 つのクイーンが互いに「利き筋に入らない」 (クイーンは行・列・対角線上を移動できるので、その道筋上に他のクイーンがいない) ような配置の仕方を考える、というものです。チェス盤の行・列の数とクイーンの数を n と一般化した問題を考えます。
では実際に、SICP の誘導どおりに解き方を考えます。
簡単に一言で説明しちゃうと、帰納法で解きます。つまり、まず k-1 列目まで、条件を満たすように k-1 個のクイーンが配置されていると仮定します。この条件の下で、 k 列目のどこにクイーンを置けばよいか考えます。 k 列目の 1 行目から n 行目、座標で表すと (1, k)~(n, k) のそれぞれについてクイーンを置いてみて、利き筋に入らないという条件を満たすか調べてみて、条件を満たすものだけを取り出す、こうすると k 列目までに k 個のクイーンが条件を満たして置かれた配置ができます。これを k = 1~n まで行えば完了というわけです。
SICP ではこれを解いて Scheme のデータ構造であるリスト表現を出力すれば終わりとなっているのですが、少し結果がわかりづらいので出力を可視化するコードも書いてみました。
[Code]
Scheme から派生した racket という言語で書いていますが、ほとんど Scheme と同じです。環境によっては "null" が定義されていないと怒られるかもしれないのでその場合は "(define null '())" を書き加えてください。
コードの細かい説明は全部コメントで書いておきました。
#lang racket ;accumulate: 初期値 initial から始めて、配列 sequence の要素を右から取って来て 2-ary operation の op に食わせていく感覚 (define (accumulate op initial sequence) (if (null? sequence) initial (op (car sequence) (accumulate op initial (cdr sequence))))) ;filter: 配列 sequence の中で、条件式 predicate を満たす要素だけを取り出してきて配列を再構成する (define (filter predicate sequence) (cond ((null? sequence) null) ((predicate (car sequence)) (cons (car sequence) (filter predicate (cdr sequence)))) (else (filter predicate (cdr sequence))))) ;flatmap: 元配列 seq の各要素に対して処理 proc を行ったものを append して返す (map だと append じゃなくて cons なので段差ができてしまう) (define (flatmap proc seq) (accumulate append null (map proc seq))) ;enumerate-interval: low から high までの公差 1 の数列を生成する (define (enumerate-interval low high) (if (> low high) null (cons low (enumerate-interval (+ low 1) high)))) ;初期状態 (ただの空リスト) (define empty-board null) ;adjoin-position: すでに配置されたクイーンの座標のリスト rest に座標 (row, col) をリストの頭に加える (define (adjoin-position row col rest) (cons (cons row col) rest)) ;safe?: 新しく加えられたクイーンが利き筋に入っていないか判定する ;列は k 番目の列なので問題ない、行と対角線を判定 ;safe?-sub は新しいクイーンの座標 p とすでに配置されていたクイーンの座標リスト rest とを引数にとり、 rest の頭から再帰的に判定 (define (safe?-sub p rest) (if (null? rest) #t (cond ((= (caar rest) (car p)) #f) ((= (abs (- (car (car rest)) (car p))) (- (cdr p) (cdr (car rest)))) #f) (else (safe?-sub p (cdr rest)))))) ;safe? の引数は今何列目にいるかをあらわす k と、新しいクイーンの座標が頭についたクイーンの座標リスト positions (define (safe? k positions) (let ((col (car positions))) (safe?-sub col (cdr positions)))) ;以下がメインになる部分 ;lambda (new-row) は、1 から n までの数列 (enumerate-interval) の各要素に対して adjoin を行う、つまり (1, k)~(n, k) の座標をすでにあるクイーンの座標リストに加える ;(queen-cols (- k 1)) がすでにある k-1 列目までのクイーンの座標リスト (ひとつの盤面に対応) のリスト (つまり盤面のリスト) 、それの各要素 (つまりひとつの盤面) に対して lambda (rest-of-queens) のラムダ閉包 (関数みたいなもの) を作用させることで、新しいクイーンの座標候補 (まだ条件を満たすかの判定をしていないので候補どまり) が加わった、新しい盤面のリストができる ;filter で条件を満たす盤面だけを取り出して k 列目までが完成 (define (queens board-size) (define (queen-cols k) (if (= k 0) (list empty-board) (filter (lambda (positions) (safe? k positions)) (flatmap (lambda (rest-of-queens) (map (lambda (new-row) (adjoin-position new-row k rest-of-queens)) (enumerate-interval 1 board-size))) (queen-cols (- k 1)))))) (queen-cols board-size)) ;これによって、(queens n) でサイズ n の時の盤面 (座標のリスト) のリストがえられるが、非常に見づらいので可視化する ;plot の引数 ls が盤面のリスト、再帰的に ls の頭からプロットして行き、 ls が空になったら終了 ;クイーンのいる位置を "o", いない位置を "x" であらわす ;ここで、 queens の探索順のおかげで、座標リストである盤面 (car ls) に並んでいる座標の順番は、列について降順であるはずである ;盤面を 90 度回転させたものをプロットしても同じなので、 reverse して行の昇順に並んだ座標リストとみなせばプロットが楽！ ;subplot: 行をプロット ;pointplot: 座標一点をプロット ;this が今何列目をプロットしているかをあらわし、 x がクイーンは何列目にいるのかをあらわしている (define (plot ls) (if (null? ls) (display "That's all!!") (let* ((board (reverse (car ls))) (n (length board))) (define (subplot positions) (newline) (if (null? positions) (newline) (let ((position-of-queen (car positions))) (define (pointplot x this) (cond ((> this n) (subplot (cdr positions))) ((= x this) (display "o") (pointplot x (+ this 1))) (else (display "x") (pointplot x (+ this 1))))) (pointplot (car position-of-queen) 1)))) (subplot board) (plot (cdr ls)))))
[Result]
実行結果！
> (queens 4) '(((3 . 4) (1 . 3) (4 . 2) (2 . 1)) ((2 . 4) (4 . 3) (1 . 2) (3 . 1))) > (plot (queens 4)) xoxx xxxo oxxx xxox xxox oxxx xxxo xoxx That's all!!
最後に実際のチェス盤のサイズである n=8 でやってみました。92 パターンあってクッソ長かったので画像にしておきます。スクショしてつなげただけなのでそろってなくて汚いですがご了承を。対称なものは除くとかすれば面白いかもしれませんね。
