SICP2.38〜2.43 エイトクィーンパズルに挑む

■問題 2.40
 与えられた整数nに対し、1≦j

 まずunique-pairsを定義しましょう。いきなり取り掛かるのは難しいので、とりあえずi≦nまでの並びを生成する手続き、enumerate-intervalを定義します。enumerate-intervalは例えばn = 5, i = 3だとしたら、(3 4 5)という並びを生成する手続きです。Schemeで関数を定義するには(define (関数名 引数) 処理部)として定義します。二つの変数を引数として取る関数を作るため、enumerate-intervalは(define (enumerate-interval i n) 処理部)という形になります。処理部を埋めていきましょう。iがn以下なら、iに+1したものを再帰します。iがnより大きければそこで再帰ストップです。

(define (enumerate-interval low high)
	(if (> low high) ()
	(cons low (enumerate-interval (+ low 1) high))))

 これでi≦nの数列を生成することが出来ました。
unique-pairsは先ほど1≦j

  1. (unique-pairs 1)なら、条件を満たすものは無いので空のリスト()が返されます。
  2. (unique-pairs 2)なら、(i, j) = (2, 1)が存在しますね。
  3. (unique-pairs 3)なら、(2 1) (3 1) (3 2)が解になります。

enumerate-intervalを用いて、jは(enumerate-interval 1 n)を返し、iは各々のjに対して(enumerate-interval (+ j 1) n)を返せば良さそうです。各々のiに対してというのは、(unique-pairs 3)のとき、iは1〜3を取るので、

  1. j = 1 のとき (define i (enumerate-interval 2 3)) => (2 3)
  2. j = 2 のとき (define i (enumerate-interval 3 3)) => (3)
  3. j = 3 のとき (define i (enumerate-interval 4 3)) => ()

と返すということです。なので、ijを求めたければ、再帰の入れ子が必要です。最終的にijをlistでくっつければ良さそうですね。

(define n 3)
(map (lambda (j)
       (map (lambda (i)
	      (list j i))
	    (enumerate-interval (+ j 1) n)))
     (enumerate-interval 1 n))

=>(((1 2) (1 3)) ((2 3)) ())
;良い感じになりました。が、対になってないので対にしましょう。
(define (accumulate op initial sequence)
	(if (null? sequence) initial
		(op (car sequence)
		(accumulate op initial (cdr sequence)))))

(define (flatmap proc seq)
  (accumulate append () (map proc seq)))

(define (unique-pairs n)
(flatmap 
(lambda (j)
     (map (lambda (i)
       (list j i))
       (enumerate-interval (+ j 1) n)))
   (enumerate-interval 1 n)))

完成!

 さて、指定した対を作れるようになったので、prime-sum-pairsも楽勝です。unique-pairsで生成した対を取ってきて、それのcarとcadrを足し合わせた結果が素数かどうか判定するだけですね。prime-sum-pairsでは対とその合計を返してくれと書いてあるので、判定結果とその合計を一つのlistにまとめる手続き、make-pair-sumも必要になってきます。

(define (square x) (* x x))

(define (filter predicate sequence)
  (cond ((null? sequence) ())
        ((predicate (car sequence))
         (cons (car sequence)
               (filter predicate (cdr sequence))))
        (else (filter predicate (cdr sequence)))))

(define (prime? n)
  (= n (smallest-divisor n)))

(define (smallest-divisor n)
  (find-divisor n 2))

(define (find-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((divides? test-divisor n) test-divisor)
        (else (find-divisor n (+ test-divisor 1)))))

(define (divides? a b)
  (= (remainder b a) 0))

(define (prime-sum? pair)
  (prime? (+ (car pair) (cadr pair))))

(define (make-pair-sum pair)
  (list (car pair) (cadr pair) (+ (car pair) (cadr pair))))

(define (prime-sum-pairs n)
  (map make-pair-sum
       (filter prime-sum?
               (unique-pairs n))))

gosh> (prime-sum-pairs 4)
((1 2 3) (1 4 5) (2 3 5) (3 4 7))

※「1が素数っておかしくね?」というツッコミをしたい方はこちらをご覧ください

■問題 2.41
「与えられた整数nに対し、nより小さいか等しい愛異なる正の整数i, j, kの順序づけられた三つ組みで、
和が与えられたnになるものを全て見つけよ」

これ単に2.40の拡張で、変更点は二つ組→三つ組み、和が素数→和が指定された数の2点。コードで主に書き換える箇所は、make-pair-sumを三つ組みに対応する箇所、素数判定を合計=n判定する箇所、そして一番大きい変更箇所は、二つ組なので二重にネストしていたところを、三つ組みなので三重にするところ。ふむふむ、ではネスト部分をもう一段階追加して…。

(define (unique-triples n)
  (flatmap (lambda (i)
             (flatmap (lambda (j)
                        (map (lambda (k) (list i j k))
                             (enumerate-interval 1 (- j 1))))
                      (enumerate-interval 1 (- i 1))))
           (enumerate-interval 1 n)))

(define (make-triple-sum triple)
  (list (car triple) (cadr triple) (caddr triple) 
        (+ (car triple) (cadr triple) (caddr triple))))

(define (sum-triple-equal? triple s)
  (= s (+ (car triple) (cadr triple) (caddr triple))))

(define (sum-triples n s)
  (map make-triple-sum (filter (lambda (t) (sum-triple-equal? t s))
                               (unique-triples n))))

で終了。2.40が理解できれば簡単ですね。
そしてこれから2.42に取り掛かるわけですが、この2.40〜2.43までの流れが非常に美しく、教育的です。数列を生成するenumerate-interval、それを入れ子にして2変数の数列を生成するunique-pairs、さらにそれを入れ子にして3変数版にしたunique-triples…。ここまでくれば嫌でも著者の狙いが理解できます。
「更なる一般化、n変数版の数列を生成せよ」
実際、2.42は8クイーンパズルを解けと言う問題だと書いていますが、問題のアルゴリズムを見れば、決して8*8盤だけを解けばいいのではなく、n*n盤を解くアルゴリズムを実装せよとなっています。ハッ!そういえば2章のサブタイトルは「データによる抽象の構築」だ!と言うわけで、私が勝手にSICP二章の四大難問*1だと思っている2.42の8クイーンパズルに挑みます!

問題 2.42

(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))

問題としては、empty-board、adjoin-position、safe?を実装せよという話ですが、その前にこのアルゴリズムをきちんと理解しておきましょう。board-sizeは理解しやすいようとりあえず4にしておきます。(queens 4)とすれば、再帰でqueen-colsをk = 0まで潜り、結果としてempty-boardを返し、それをflatmapのseqとして受け取って今度はk = 1でqueen-colsに潜ります。flatmapのproc部のmap-lambdaの引数new-rowに(enumerate-interval 1 board-size)が渡されます。board-sizeを4とすると、ここでは(1 2 3 4)が引数に渡されます。これはチェス盤の新規行です。
 ということで、adjoin-positionは今までの行と新規行を結合する役目だと判明しました。なので、まぁ、関数の中身はconsかlistだと思うのですが…。「kの使い道がわからねぇ!」えー…低能過ぎてすみません、わかりません…そして、k使わなくても解が出せたっぽいのですが…謎や。
(define (adjoin-position new-row k rest-of-queens)
(cons new-row rest-of-queens))
empty-boardはその名前からもk = 0の時返されるということからも、空リストでしょう、ということで、(define empty-board ())。
このままだとn * nの数列を受け取るだけなので、全くクイーンがぶつからないようにするところとか全く実装されていません。というわけでsafe?はクイーンがぶつからないようなクイーンの配置を返す関数だろうなと想像できます。と、想像は出来たのですが、実装は出来ませんでした(白目)。
 仕方ないので人類の味方、print様のご登場です。というわけでprint様に至る所登場して頂きました。ついでにコメントもつけまくった。

(define board-size 4)
(define (queens board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (print "safe? -> k : " k ", positions : " positions) (safe? k positions));filterで条件に沿ったものだけを返す
         (flatmap
          (lambda (rest-of-queens);flatmapのproc部ここから
            (map (lambda (new-row)
                   (adjoin-position new-row k rest-of-queens));新規行を受け取って今までの行と結合する
                 (enumerate-interval 1 board-size)));flatmapのproc部ここまで。board-size固定なので、ここは毎回同じ数列を新規行として返す
          (queen-cols (- k 1);flatmapのseq。再帰
          )))))
  (queen-cols board-size))

(define (adjoin-position new-row k rest-of-queens)
  (print "adjoin-position -> new-row : " new-row ", rest-of-queens : " rest-of-queens)
  (cons new-row rest-of-queens))

(define (safe? k positions) positions) ;暫定safe?

でとりあえずprint出力を見てみると…

gosh> (queens 2)
adjoin-position -> new-row : 1, rest-of-queens : ()
adjoin-position -> new-row : 2, rest-of-queens : ()
safe? -> k : 1, positions : (1)
safe? -> k : 1, positions : (2)
adjoin-position -> new-row : 1, rest-of-queens : (1)
adjoin-position -> new-row : 2, rest-of-queens : (1)
adjoin-position -> new-row : 1, rest-of-queens : (2)
adjoin-position -> new-row : 2, rest-of-queens : (2)
safe? -> k : 2, positions : (1 1)
safe? -> k : 2, positions : (2 1)
safe? -> k : 2, positions : (1 2)
safe? -> k : 2, positions : (2 2)

 safe?にpositionsが渡されるのはまぁわかります。で、kの使い道は?ここで詰まること20時間(馬鹿)。ここらへんでそもそもの8クイーンアルゴリズムをカンニングしました。8クイーン問題は全探索するアルゴリズムもありますが、無駄が多すぎるので、バックトラック法というのを使うそうです。簡単に言うと、一気に8列分のクイーンの生死を判定するのではなく、k=1から開始して、k列目の任意の行位置にクイーンを置いた場合の生死だけを判定していく、これやるとk列目だけ判定すればOK。なぜならば、k-1列目は既に生存確認済みだから。計算量削減できていいですね。…ん、k列目だけ判定?k…k…そういうことか!!??safe?に渡されるpositionsの中身は、cdrに最新列が、cdrには生存確認済みのものが入っている。
 ちょっと先ほどの出力を(queens 4)にして再度見てみる。

safe? -> k : 4, positions : (1 2 4 1)
safe? -> k : 4, positions : (2 2 4 1)
safe? -> k : 4, positions : (3 2 4 1)
safe? -> k : 4, positions : (4 2 4 1)

 (cdr positions)は生存OKな既存列で、最新列であるcarを判定すれば良いというわけですね。carがcdrの各アトムとぶつかるかどうか再帰回していって判定する。kの使い方がわかった!(多分)

(define (safe? k positions)
  (define (safe-rec check-new-col n)
    (or (= n k);or := 最初に真になった値を返す
        (let ((old-col (list-ref positions n)));既存列のn列目をold-colに束縛
          (and (not (= check-new-col old-col));同じ行位置は死
               (not (= (abs (- check-new-col old-col)) n));斜めチェック。両方クリアすれば#tを返す
               (safe-rec check-new-col (+ n 1))))));既存列数分繰り返す
  (safe-rec (car positions) 1))

 新規列には一つしかqueenを置かないので、縦のチェックは必要無し。既存列の行位置と同じか、さもなければ対象となる新規列と既存列の差の絶対値を取って斜めにぶつからないかを判定。というわけで全ての答えが出ました。

(queens 4)
>(3 1 4 2) (2 4 1 3)

ついでにlengthを定義して解答数を得ます。

(define (length seq)
	(accumulate (lambda (x y) (+ y 1)) 0 seq))
(length (queens 8))
>92

 Wikipediaの8クイーン問題のページを見ると回答は92パターンらしい。というわけで完了!お疲れ様でした…。


■問題2.43
 あー、疲れた、もうしんどい。

・ルイスへ
 おいルイス、あきらかにmapに放り込む回数違うだろ、お前目ん玉のかわりにソラマメでも詰めてるんじゃないのか?。
元々のアルゴリズム:queen-cols、flatmapに対して1回しか呼んでない
へぼルイスのコード:queen-cols、flatmapに対して board-size * board-size呼んでる、人間が死ぬ

※おまけ
■問題 2.38

(define (fold-right op initial sequence)
	(if (null? sequence) initial
		(op (car sequence)
		(fold-right op initial (cdr sequence)))))

(define (fold-left op initial sequence)
  (define (iter result rest)
    (if (null? rest) result
	(iter (op result (car rest))
	      (cdr rest))))
  (iter initial sequence))

(fold-right / 1 (list 1 2 3))
3/2
(fold-left / 1 (list 1 2 3))
1/6
(fold-right list '() (list 1 2 3))
(1 (2 (3 ())))
(fold-left list '() (list 1 2 3))
(((() 1) 2) 3)

 実行結果からわかるように、rightは((1/3)/2)/1してleftは((1/1)/2)/3している。ので、opには引数の順序を変更しても問題ないような性質を持たないといけない。つまり、結合法則を満たす必要がある。(結合法則と言う名前が出てこなくて焦ったし、この問題若干トートロジーなのでは感ある)


■問題 2.39

(define (reverse sequence)
  (fold-right (lambda (x y) (append y (list x))) '() sequence))

(define (reverse-2 sequence)
  (fold-left (lambda (x y) (cons y x)) '() sequence)

■感想
 2.42で燃え尽きたところにルイスのコードが押し寄せてきてf**kとか叫ぶ羽目になった、SICP著者は全世界のルイスさんに謝るべき。

*1:1つ目は2.6のチャーチ数、後二つはこのあとに