SICP 問題 2.42（エイトクイーンパズル）
もんのすげえ時間食った。。トータル４日間？アホだな俺。
問題
「エイトクイーンズパズル」はチェス盤上に八つのクイーンを、どのクイーンも他のと当たりにならないような（つまりどの二つのクイーンも同じ行、同じ列、同じ斜めの筋にならないような）置き方を問う。
一つの解を図2.8に示す。パズルを解く。パズルを解く一つの方法は、一つのクイーンを各列に置きながら盤上を進む。k-1 個のクイーンを置いたら、k 個めのクイーンを既に盤上に置いたどのクイーンとも当たらない場所に置かなければならない。
このやり方を再帰的に形式化できる。
盤の最初の k-1 列に k-1 個のクイーンを置く全ての方法の列が生成してあるとしよう。この各方法に対し、k 番目の列の各行にクイーンを置き、場所を拡大した集合を生成する。これをフィルタに通し、k 番目のクイーンが、他のクイーンに対して安全な場所だけを残す。これで最初の k 列に k 個のクイーンを置く全ての方法の並びができる。この方法を継続すると、唯一の解ではなく、パズルの全解が得られる。
この解の手続きを queens として実装する。これは n × n のチェス盤上に n クイーンを置く問題の全ての解の並びを返す。
queens の内部手続き queen-cols は盤の最初の 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))
この手続きで、rest-of-queens は最初の k-1 列に k-1 個のクイーンを置く方法であり、new-row は k 列目にクイーンの置ける行の案である。盤上の位置の集合の表現を実装し、位置の集合に新しい場所の座標を連結する手続き adjoin-position、場所の空集合を表現する empty-board と合わせてプログラムを完成せよ。また、他のクイーンに対し、k 番目のクイーンが安全な場所を決める手続き safe? を書かなければならない。（他のクイーンは互いに安全であることが保証されているので、新しいクイーンが安全なことだけ調べればよい。）
解答
思考プロセスを残しておきたいが、めちゃくちゃ長いので先に回答を。。
(define (queens board-size) (define (queen-col 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-col (- k 1)))))) (print (queen-col board-size))) (define empty-board '()) (define (safe? k lis) (if (null? lis) #t (let loop ((head (car lis)) (body (cdr lis)) (count 1)) (cond ((null? body) #t) ((or (= head (car body)) (= head (+ (car body) count)) (= head (- (car body) count))) #f) (else (loop head (cdr body) (+ 1 count))))))) (define (adjoin-position new-row k rest-of-queens) (cons new-row rest-of-queens))
思考プロセス
問題文が何言ってるのか理解できなかったのでまずは完全独自路線で解いてみた。
（最終的に問題文に掲載されているコードの形に近づけて行って理解できればいいやと思って。）
で、初期はずーーーーーっと enumerate-interval を map の母体リストとして考えていたからいつまでたってもできなかった。。
ミソは、filter で絞り込まれた、「クイーンを置ける場所のリスト」を母体にして map 処理をすべきだったのね。
で、その map 処理の中で、今度は母体リストを enumerate-interval にした map 処理を行う感じ。
つまり具体的にどういうことかというと・・・
;生成した「フィルタ済みリスト」に対してmapを作用させるべき。 (map (lambda (x) (map (lambda (y) (cons y x)) (enumerate-interval 1 board-size))) (再帰的に生成したフィルタ済みのリスト))))))
こんなイメージ。
フィルタ済みリストひとつひとつに対して、enumerate-interval で生成した (1 2 3 4 5 6 7 8) のリストの各要素を作用させてやる。
より具体的な手続きとして記述してみよう。
;とりあえず手続き化しながら改良していこう。。 (define (test 何かしらのパラメータ) ;①再帰処理の為の終了条件が必要 (map (lambda (x) (map (lambda (y) (cons y x)) (enumerate-interval 1 board-size))) (test 再帰用に編集したパラメータ))) ;↓↓↓ ;改良１ (define (test col) ;①現在処理中の列番号を使用して終了条件を規定する。 (if (= col board-size) ;②終了時に返すデータを生成 () ;③終了しない場合の処理。 ; これだけだとネストが深いリストが帰ってしまうので、 ; accumulate/append を作用させてやる。 (map (lambda (x) (map (lambda (y) (cons y x)) (enumerate-interval 1 board-size))) (test (+ 1 col))))))) ;↓↓↓ ;改良２ (define (test col) ;① (if (= col board-size) ;② (map (lambda (x) (cons x '())) (enumerate-interval 1 board-size)) ;④③で抽出したリストに対して、safe? 手続きを作用させ、 ; 抽出したいデータのみからなるリストを生成する。 ;③ (accumulate append '() (map (lambda (stack) (map (lambda (y) (cons y stack)) (enumerate-interval 1 board-size))) (test (+ 1 col)))))) ;↓↓↓ ;改良３ (define (test col) ;① (if (= col board-size) ;終了時に返すデータを生成 (map (lambda (x) (cons x '())) (enumerate-interval 1 board-size)) ;④ (filter safe? ;③ (accumulate append '() (map (lambda (stack) (map (lambda (y) (cons y stack)) (enumerate-interval 1 board-size))) (test (+ 1 col)))))))
これでやりたいことができるようになる。
あとは safe? 手続きを定義すれば動くはずだが、まずはこの test 手続きが正しく動作するかどうか確認するため、極々簡単なs safe? 手続きにしてみる。
具体的には要素に重複する数値を持たないリストだけを抽出するようなロジックを記述してみる。
test 手続きのアルゴリズムなら、test が返却するリストは適切に重複なしのものだけが抽出されているはずなので、新しく追加された数値だけを、重複チェックしてやればOK。
こんな感じになる。
;抽出条件の手続き (define (safe? lis) (if (null? lis) #t (let loop ((head (car lis)) (body (cdr lis))) (cond ((null? body) #t) ((= head (car body)) #f) (else (loop head (cdr body)))))))
さて、実験。おっと、board-size はひとまず４にしておくぜ。
gosh> (define board-size 4) board-size gosh> (print (test 1)) ;「#0#=」とか出てきて分かりにくいので print しちゃう。 ((4 3 2 1) (3 4 2 1) (4 2 3 1) (2 4 3 1) (3 2 4 1) (2 3 4 1) (4 3 1 2) (3 4 1 2) (4 1 3 2) (1 4 3 2) (3 1 4 2) (1 3 4 2) (4 2 1 3) (2 4 1 3) (4 1 2 3) (1 4 2 3) (2 1 4 3) (1 2 4 3) (3 2 1 4) (2 3 1 4) (3 1 2 4) (1 3 2 4) (2 1 3 4) (1 2 3 4) ) #<undef> gosh>
重複する数字があるリストはないね。
あとはこの safe? を、エイトクイーンパズルを解くための正しいロジックに変えてあげればOK。
どうやって実現するか。縦と横は既にロジック中に入っているのでいいとして、斜めだよね。
head の列に対して比較する body 部の各数値の列が count 番目という情報をあたえてやれば、
(car body) に対して ±count してやれば、そこが not safe であると考えられる。
これは cond の条件に or で追加してやればいいっしょ。
あとは let loop に新しいパラメータ count を追加してやれば実現できるはず。
;抽出条件の手続き (define (safe? lis) (if (null? lis) #t (let loop ((head (car lis)) (body (cdr lis)) (count 1)) (cond ((null? body) #t) ((or (= head (car body)) (= head (+ (car body) count)) (= head (- (car body) count))) #f) (else (loop head (cdr body) (+ 1 count)))))))
こんな感じか。実験してみよう。
よしよし。じゃ、board-size を 8 で確認してみよう。
gosh> (print (test 1))
((3 1 4 2) (2 4 1 3) )
#
gosh>
何個か抽出して確認したけど大丈夫っぽいね。OKとしよう！
gosh> (define board-size 8)
board-size
gosh> (print (test 1))
((4 2 7 3 6 8 5 1) (5 2 4 7 3 8 6 1) (3 5 2 8 6 4 7 1) (3 6 4 2 8 5 7 1) (5 7 1 3 8 6 4 2) (4 6 8 3 1 7 5 2) (3 6 8 1 4 7 5 2) (5 3 8 4 7 1 6 2) (5 7 4 1 3 8 6 2) (4 1 5 8 6 3 7 2) (3 6 4 1 8 5 7 2) (4 7 5 3 1 6 8 2) (6 4 2 8 5 7 1 3) (6 4 7 1 8 2 5 3) (1 7 4 6 8 2 5 3) (6 8 2 4 1 7 5 3) (6 2 7 1 4 8 5 3) (4 7 1 8 5 2 6 3) (5 8 4 1 7 2 6 3) (4 8 1 5 7 2 6 3) (2 7 5 8 1 4 6 3) (1 7 5 8 2 4 6 3) (2 5 7 4 1 8 6 3) (4 2 7 5 1 8 6 3) (5 7 1 4 2 8 6 3) (6 4 1 5 8 2 7 3) (5 1 4 6 8 2 7 3) (5 2 6 1 7 4 8 3) (6 3 7 2 8 5 1 4) (2 7 3 6 8 5 1 4) (7 3 1 6 8 5 2 4) (5 1 8 6 3 7 2 4) (1 5 8 6 3 7 2 4) (3 6 8 1 5 7 2 4) (6 3 1 7 5 8 2 4) (7 5 3 1 6 8 2 4) (7 3 8 2 5 1 6 4) (5 3 1 7 2 8 6 4) (2 5 7 1 3 8 6 4) (3 6 2 5 8 1 7 4) (6 1 5 2 8 3 7 4) (8 3 1 6 2 5 7 4) (2 8 6 1 3 5 7 4) (5 7 2 6 3 1 8 4) (3 6 2 7 5 1 8 4) (6 2 7 1 3 5 8 4) (3 7 2 8 6 4 1 5) (6 3 7 2 4 8 1 5) (4 2 7 3 6 8 1 5) (7 1 3 8 6 4 2 5) (1 6 8 3 7 4 2 5) (3 8 4 7 1 6 2 5) (6 3 7 4 1 8 2 5) (7 4 2 8 6 1 3 5) (4 6 8 2 7 1 3 5) (2 6 1 7 4 8 3 5) (2 4 6 8 3 1 7 5) (3 6 8 2 4 1 7 5) (6 3 1 8 4 2 7 5) (8 4 1 3 6 2 7 5) (4 8 1 3 6 2 7 5) (2 6 8 3 1 4 7 5) (7 2 6 3 1 4 8 5) (3 6 2 7 1 4 8 5) (4 7 3 8 2 5 1 6) (4 8 5 3 1 7 2 6) (3 5 8 4 1 7 2 6) (4 2 8 5 7 1 3 6) (5 7 2 4 8 1 3 6) (7 4 2 5 8 1 3 6) (8 2 4 1 7 5 3 6) (7 2 4 1 8 5 3 6) (5 1 8 4 2 7 3 6) (4 1 5 8 2 7 3 6) (5 2 8 1 4 7 3 6) (3 7 2 8 5 1 4 6) (3 1 7 5 8 2 4 6) (8 2 5 3 1 7 4 6) (3 5 2 8 1 7 4 6) (3 5 7 1 4 2 8 6) (5 2 4 6 8 3 1 7) (6 3 5 8 1 4 2 7) (5 8 4 1 3 6 2 7) (4 2 5 8 6 1 3 7) (4 6 1 5 2 8 3 7) (6 3 1 8 5 2 4 7) (5 3 1 6 8 2 4 7) (4 2 8 6 1 3 5 7) (6 3 5 7 1 4 2 8) (6 4 7 1 3 5 2 8) (4 7 5 2 6 1 3 8) (5 7 2 6 3 1 4 8) )
#
gosh>
というわけで、全部自力で解いたけど、問題が要請しているのは次の定義を補完すること。
なので、今まで解いてきた test と照らし合わせて最後までやっちゃおう。
empty-board
場所の空集合を表現
safe?
他のクイーンに対し、k 番目のクイーンが安全な場所を決める手続き
adjoin-position
盤上の位置の集合の表現を実装し、位置の集合に新しい場所の座標を連結する手続き。
問題文を見ると、独自定義した test は どうやら queen-cols に相当するみたいだな。
違うところもあるけども。。
つーわけで、test を queen-cols に近づけていってみよう。
(define (test k) (if (= k board-size) (map (lambda (x) (cons x '())) (enumerate-interval 1 board-size)) (filter safe? (flatmap (lambda (rest-of-queens) (map (lambda (new-row) (cons new-row rest-of-queens)) (enumerate-interval 1 board-size))) (test (+ k 1))))))
ここまでやってみたが、k の扱いが違うなぁ。
俺の方は加算していく感じだけど問題文の方は減算だ。
その上 safe? とか adjoin-position にも引き渡してるし。。
こいつらには一応 k を引き渡すことにするけど、内部では使わないようにしちゃおう。。
そうすると、こんな感じに定義できた。
(define (queens board-size) (define (queen-col 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-col (- k 1)))))) (print (queen-col board-size))) (define empty-board '()) (define (safe? k lis) (if (null? lis) #t (let loop ((head (car lis)) (body (cdr lis)) (count 1)) (cond ((null? body) #t) ((or (= head (car body)) (= head (+ (car body) count)) (= head (- (car body) count))) #f) (else (loop head (cdr body) (+ 1 count))))))) (define (adjoin-position new-row k rest-of-queens) (cons new-row rest-of-queens))
実験結果も同じ。
