プログラミング再入門

プログラミングをもう一度ちゃんと勉強する読書ノート

SICP 2.2.3 Sequences as Conventional Interfaces

前節ではデータ構造を抽象化する事でデータ構造の詳細に触れる事なくプログラムが作れる事、逆にプログラムに影響を与える事なくデータ構造を変更出来る事を習ったんですね。
タイトルのconventionalの解釈が難しいですが、従来からあるとか慣例的とかだと今ひとつピンと来ない。どうも様式化されたとか標準化されたの方が意味が通じる気がします。
sequenceはこれまでも出て来ましたが、これまでのところ数しか扱っていないので数列でも良いが、本来必ずしも数ではないので単なる列。でも列では意味が良く分からないのでそうするとリストと言ってしまうのが最も理解しやすい気がする。
そんな訳で『標準インターフェースとしてのリスト』か『共通インターフェースとしてのリスト』かな。

ノート

sum-odd-squaresとeven-fibsは

  1. 入力を並べる
  2. そのうちの一部を取り出す
  3. それぞれを加工する
  4. 全体を纏める

と言う工程で共通している。信号処理の様に上手くブロックを組み合わせる様にプログラムが書ければ。

Sequene Operations

リスト操作。
filterの定義を実際に動かしてみる。

> (define (myfilter predicate sequence)
    (cond ((null? sequence) null)
          ((predicate (car sequence))
           (cons (car sequence)
                 (myfilter predicate (cdr sequence))))
          (else (myfilter predicate (cdr sequence)))))
> (myfilter odd? (list 1 2 3 4 5))
(1 3 5)
> 

accumulateは標準にはないのでそのままの名前で

> (define (accumulate op initial sequence)
    (if (null? sequence)
        initial
        (op (car sequence)
            (accumulate op initial (cdr sequence)))))
> (accumulate + 0 (list 1 2 3 4 5))
15
> (accumulate * 1 (list 1 2 3 4 5))
120
> (accumulate cons null (list 1 2 3 4 5))
(1 2 3 4 5)
> 

指定された範囲の数列を作るenumerate-interval。実行してみる。

> (define (enumerate-interval low high)
    (if (> low high)
        null
        (cons low (enumerate-interval (+ low 1) high))))
> (enumerate-interval 2 7)
(2 3 4 5 6 7)
> 

木の葉を列に変換するenumerate-tree。実行してみる。

> (define (enumerate-tree tree)
    (cond ((null? tree) null)
          ((not (pair? tree)) (list tree))
          (else (append (enumerate-tree (car tree))
                        (enumerate-tree (cdr tree))))))
> (enumerate-tree (list 1 (list 2 (list 3 4)) 5))
(1 2 3 4 5)
> 

新しいsum-odd-squaresを実行してみる。

> (define (square x) (* x x))
> (define (accumulate op initial sequence)
    (if (null? sequence)
        initial
        (op (car sequence)
            (accumulate op initial (cdr sequence)))))
> (define (enumerate-tree tree)
    (cond ((null? tree) null)
          ((not (pair? tree)) (list tree))
          (else (append (enumerate-tree (car tree))
                        (enumerate-tree (cdr tree))))))
> (define (sum-odd-squares tree)
    (accumulate +
                0
                (map square
                     (filter odd?
                             (enumerate-tree tree)))))
> (sum-odd-squares (list 1 (list 2 (list 3 4)) 5))
35
> 

1章よりfibの定義を借りて来て:

> (define (fib n)
    (fib-iter 1 0 n))
> (define (fib-iter a b count)
    (if (= count 0)
        b
        (fib-iter (+ a b) a (- count 1))))
> (define (accumulate op initial sequence)
    (if (null? sequence)
        initial
        (op (car sequence)
            (accumulate op initial (cdr sequence)))))
> (define (enumerate-interval low high)
    (if (> low high)
        null
        (cons low (enumerate-interval (+ low 1) high))))
> (define (even-fibs n)
    (accumulate cons
                null
                (filter even?
                        (map fib
                             (enumerate-interval 0 n)))))
> (even-fibs 20)
(0 2 8 34 144 610 2584)
> 

sum-odd-squaresがfilterしてからmapしているのに対し、even-fibsはmapしてからfilterしているので単純には纏められない。
最初の段の出力から最終段の入力までをリストで繋ぐ事で、リストを受け取りリストを返す比較的小さな関数(部品)を組み合わせて複合的な関数を作れる。この部品に分解するあるいは部品を組み合わせてプログラムする事をmodular designと言っている模様。

> (define (list-fib-squares n)
    (accumulate cons
                null
                (map square
                     (map fib
                          (enumerate-interval 0 n)))))
> (list-fib-squares 10)
(0 1 1 4 9 25 64 169 441 1156 3025)
> (define (product-of-squares-of-odd-elements sequence)
    (accumulate *
                1
                (map square
                     (filter odd? sequence))))
> (product-of-squares-of-odd-elements (list 1 2 3 4 5))
225
> 

ここではリストで表現した列を共通のインターフェースとして使用して部品を組み合わせるプログラミングをした。列を別の表現にした場合にその列を直接扱ういくつかの関数を変更する事で、残りの部品やそれらを組み合わせたプログラムは変更せずにそのまま動作する。

Exercise 2.33

accumulateをおさらいすると、sequenceの最後の要素から順に取り出し、(op 要素 以右の結果)を順に計算して行く。最初の以右の結果は初期値initialとして引数で与えられる。
mapの場合、初期値initialは空リスト、opはsequenceから取り出した要素xに手続きpを適用した結果を以右の結果yの先頭にconsで足す関数。

> (define (mymap p sequence)
    (accumulate (lambda (x y) (cons (p x) y)) null sequence))
> (mymap (lambda (x) (* x x)) (list 1 2 3 4 5 6))
(1 4 9 16 25 36)
> 

appendは2番目の引数seq2はそのまま、つまりこれをを初期値initialとして、seq1をsequenceとして、opを単にconsとして、最後の要素から順番にseq2側の先頭に足して行く。

> (define (myappend seq1 seq2)
    (accumulate cons seq2 seq1))
> (myappend (list 1 2 3) (list 4 5 6))
(1 2 3 4 5 6)
> 

lengthは初期値initialは0。opは以右の結果に1を足す関数。

> (define (mylength sequence)
    (accumulate (lambda (element acc) (+ acc 1)) 0 sequence))
> (mylength (list 1 2 3 4 5 6))
6
> 
Exercise 2.34

Wikipediaに「ホーナー法」と紹介されている方法。多項式の値を求めるのにxを括り出す事で掛け算の回数を減らしている。次数の高い方のa_n\times x + a_{n-1}から始めて、(それまでの計算結果)\times x+a_mを順次計算して行く。

(define (horner-eval x coefficient-sequence)
  (accumulate (lambda (this-coeff higher-terms) (+ (* higher-terms x) this-coeff))
              0
              coefficient-sequence))

実行結果

> (horner-eval 2 (list 1 3 0 5 0 1))
79
> 

合っていそう。

Exercise 2.35

最上位のリストに対してmapで、葉であれば1に、そうでなければそこの部にcount-leavesを適用してその部分の葉の数に変換。最後に全てを合計する。

(define (count-leaves t)
  (accumulate (lambda (elem count)
                (+ elem count))
              0
              (map (lambda (elem)
                     (if (pair? elem)
                         (count-leaves elem)
                         1))
                   t)))

動作確認。

> (count-leaves '(1 (1 (1 2) (2 (2 3))) 4 (5 6)))
10
> 
Exercise 2.36

sのそれぞれの列の最初の要素だけのリストにaccumulateを適用、2番目の要素だけのリストにacculumateを適用、とそれぞれ適用して、それぞれの結果をまたリストにする。
「それぞれのリストの最初の要素のリスト」はsに対してmapでcarを適用する。これに対してaccumulateを手供すれば良い。(A)
sに対してmapでcdrを適用すると残りのリストのリストになるので、これに対してaccumulate-nを適用する。(B)
リストは後ろ(右側)からしか構築出来ないので(B)に対して(A)をconsで足して行く。

(define (accumulate-n op init seqs)
  (if (null? (car seqs))
      null
      (cons (accumulate op init (map car seqs))
            (accumulate-n op init (map cdr seqs)))))

動作確認。

> (accumulate-n + 0 (list (list 1 2 3) (list 4 5 6) (list 7 8 9) (list 10 11 12)))
(22 26 30)
> 
Exercise 2.37

行列演算。
dot-productでさり気なくmapの新しい用法が紹介されていると思ったら、既に脚注12として紹介されてた。ここではvとwそれぞれから要素をひとつずつ取り出してopを適用する。
行列とベクトルの掛け算matrix-*-vectorはmの角行に対してvを掛けるので、dot-productを使って

(define (matrix-*-vector m v)
  (map (lambda (row) (dot-product row v)) m))

動作確認

> (define v (list 1 2 3 4))
> (define m (list (list 1 2 3 4) (list 5 6 7 8) (list 9 10 11 12) (list 13 14 15 16)))
> (matrix-*-vector m v)
(30 70 110 150)
> 

行列の転置transposeは各行の先頭の要素、2番目の要素、3番目の要素を順にリストにして行く事になるので、accumulate-nで各要素を取り出してconsで繋ぐだけ。初期値は空リスト。

(define (transpose mat)
  (accumulate-n cons null mat))

動作確認

> (define m (list (list 1 2 3 4) (list 5 6 7 8) (list 9 10 11 12) (list 13 14 15 16)))
> (transpose m)
((1 5 9 13) (2 6 10 14) (3 7 11 15) (4 8 12 16))
> 

行列同士の掛け算matrix-*-matrixは、mのある行とnの積のベクトルをmの各行に対して演算したもの。mのある行とnの積は、mのある行とnの各列の積の集合(ベクトル)であるが、nを転置するとnの各行との積の集合に置き換えられ、そうすると前後を入れ替えて行列nとmのある行の積に置き換える事が出来る。これはmatrix-*-vecotrで計算出来る。そうするとnを転置したものをcolsとすると、colsとmの各行のmatrix-*-vectorをリストに纏めたものがm×nとなる。

(define (matrix-*-matrix m n)
  (let ((cols (transpose n)))
    (map (lambda (row) (matrix-*-vector cols row)) m)))

実行結果

> (define m (list (list 1 2 3 4) (list 5 6 7 8) (list 9 10 11 12) (list 13 14 15 16)))
> (matrix-*-matrix m m)
((90 100 110 120) (202 228 254 280) (314 356 398 440) (426 484 542 600))
> 

Rで検算

> m <- matrix(1:16, nrow=4, byrow=TRUE)
> m
     [,1] [,2] [,3] [,4]
[1,]    1    2    3    4
[2,]    5    6    7    8
[3,]    9   10   11   12
[4,]   13   14   15   16
> m %*% m
     [,1] [,2] [,3] [,4]
[1,]   90  100  110  120
[2,]  202  228  254  280
[3,]  314  356  398  440
[4,]  426  484  542  600
> 

合っていそう。

Exercise 2.38

実行結果

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

このフォーマットでは表現出来ないが最初の結果は1\frac{1}{2}

2項演算子のopの、二つの引数の順番が入れ替わっても同じ結果になる関数であれば、fold-leftもfold-rightも同じ結果を返す。/もlistも引数の順番が変われば結果は異なる。+や*はleftもrightも結果は同じ。

> (fold-right * 1 (list 1 2 3))
6
> (fold-left * 1 (list 1 2 3))
6
> (fold-right + 0 (list 1 2 3))
6
> (fold-left + 0 (list 1 2 3))
6
> 
Exercise 2.39

reverseをfold-right、fold-leftを使って定義する。
fold-leftの場合は簡単で、取り出した要素を順にconsでリストの先頭に足して行けば良い。

(define (reverse-l sequence)
  (fold-left (lambda (x y) (cons y x)) null sequence))

動作確認

> (reverse-l (list 1 2 3 4))
(4 3 2 1)
> 

fold-rightを使う場合、sequenceの最後の要素から取り出す事になり、これをリストの先頭にconsで足してしまうと順番は入れ替わらないので、appendで後ろに足す必要がある。appendを使う為には取り出した要素をリストにする必要がある。

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

動作確認

> (reverse-r (list 1 2 3 4))
(4 3 2 1)
> 
Nested Mappings

入れ子のループの様にmapを入れ子にして使う。
ペアを作る部分はこんな感じ。

> (define n 6)
> (accumulate append
            null
            (map (lambda (i)
                   (map (lambda (j) (list i j))
                        (enumerate-interval 1 (- i 1))))
                 (enumerate-interval 1 n)))
((2 1) (3 1) (3 2) (4 1) (4 2) (4 3) (5 1) (5 2) (5 3) (5 4) (6 1) (6 2) (6 3) (6 4) (6 5))
> 

入れ子のmapは入れ子のリストを生成してしまうので、全てを一列に並べる為にaccumulateでappendを適用する必要がある。accumulateでappendしないとこの通り。

> (map (lambda (i)
         (map (lambda (j) (list i j))
              (enumerate-interval 1 (- i 1))))
       (enumerate-interval 1 n))
(() ((2 1)) ((3 1) (3 2)) ((4 1) (4 2) (4 3)) ((5 1) (5 2) (5 3) (5 4)) ((6 1) (6 2) (6 3) (6 4) (6 5)))
> 

外側のenumerate-intervalの最初の要素が1なので最初に空リストが出来ている。これもappendのおかげで消えているが、そもそも2から始めるべきなきがする。

> (map (lambda (i)
         (map (lambda (j) (list i j))
              (enumerate-interval 1 (- i 1))))
       (enumerate-interval 2 n))
(((2 1)) ((3 1) (3 2)) ((4 1) (4 2) (4 3)) ((5 1) (5 2) (5 3) (5 4)) ((6 1) (6 2) (6 3) (6 4) (6 5)))
> 

prime-sum-pairsを実行してみる。

> (prime-sum-pairs 10)
((2 1 3)
 (3 2 5)
 (4 1 5)
 (4 3 7)
 (5 2 7)
 (6 1 7)
 (6 5 11)
 (7 4 11)
 (7 6 13)
 (8 3 11)
 (8 5 13)
 (9 2 11)
 (9 4 13)
 (9 8 17)
 (10 1 11)
 (10 3 13)
 (10 7 17)
 (10 9 19))
> 

入れ子のmapは順列・組み合わせの生成とかに便利。

> (define (permutations s)
    (if (null? s)                    ; empty set?
        (list null)                   ; sequence containing empty set
        (flatmap (lambda (x)
                   (map (lambda (p) (cons x p))
                        (permutations (remove x s))))
                 s)))
> (permutations (list 1 2 3 ))
((1 2 3) (1 3 2) (2 1 3) (2 3 1) (3 1 2) (3 2 1))
> 
Exercise 2.40

prime-sum-pairsの一部、1からnまでの数の組で、二つの数の順序を問わず重複のない集合を生成するunique-pairsを定義する。prime-sum-pairsの和が素数であるペアだけに絞り込む手前の部分を抜き出す。

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

動作確認。

> (unique-pairs 10)
((2 1)
 (3 1)
 (3 2)
 (4 1)
 (4 2)
 (4 3)
 (5 1)
 (5 2)
 (5 3)
 (5 4)
 (6 1)
 (6 2)
 (6 3)
 (6 4)
 (6 5)
 (7 1)
 (7 2)
 (7 3)
 (7 4)
 (7 5)
 (7 6)
 (8 1)
 (8 2)
 (8 3)
 (8 4)
 (8 5)
 (8 6)
 (8 7)
 (9 1)
 (9 2)
 (9 3)
 (9 4)
 (9 5)
 (9 6)
 (9 7)
 (9 8)
 (10 1)
 (10 2)
 (10 3)
 (10 4)
 (10 5)
 (10 6)
 (10 7)
 (10 8)
 (10 9))
> 

これを使ってprime-sum-pairsを再定義

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

動作確認

> (prime-sum-pairs 10)
((2 1 3)
 (3 2 5)
 (4 1 5)
 (4 3 7)
 (5 2 7)
 (6 1 7)
 (6 5 11)
 (7 4 11)
 (7 6 13)
 (8 3 11)
 (8 5 13)
 (9 2 11)
 (9 4 13)
 (9 8 17)
 (10 1 11)
 (10 3 13)
 (10 7 17)
 (10 9 19))
> 
Exercise 2.41

まず、unique-pairsの応用でunique-triplesを定義する。入れ子を1段増やすだけなので簡単。

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

動作確認

> (unique-triples 6)
((3 2 1)
 (4 2 1)
 (4 3 1)
 (4 3 2)
 (5 2 1)
 (5 3 1)
 (5 3 2)
 (5 4 1)
 (5 4 2)
 (5 4 3)
 (6 2 1)
 (6 3 1)
 (6 3 2)
 (6 4 1)
 (6 4 2)
 (6 4 3)
 (6 5 1)
 (6 5 2)
 (6 5 3)
 (6 5 4))
> 
(define (sum l)
  (accumulate + 0 l))

動作確認

> (map sum (unique-triples 6))
(6 7 8 9 8 9 10 10 11 12 9 10 11 11 12 13 12 13 14 15)
> 

これを使ってunituq-triple-sums-toを定義する。

(define (unique-triple-sums-to s n)
  (filter (lambda (p) (= s (sum p))) (unique-triples n)))

動作確認

> (unique-triple-sums-to 20 10)
((8 7 5) (9 6 5) (9 7 4) (9 8 3) (10 6 4) (10 7 3) (10 8 2) (10 9 1))
> 
Exercise 2.42

有名な8クイーン問題。クイーンは縦横斜めに進んで相手の駒を取る。
8行8列に8人のクイーンなので、各行、各列に必ず一人ずついて、かつそれぞれが斜め方向にぶつかっていない。1列目のクイーンの位置は8通りあり、それぞれについて2列目のクイーンの配置可能な位置があり、3列目と可能な配置を順に組み立てて行く。
k-1列目までにk-1人のクイーンを置いたと仮定して、k列目のクイーンの位置を決める事を考える。k列目の

  1. k-1列目までのクイーンの配置に対してk列目の全ての位置(行)にクイーンを置いてみて
  2. 既に置いてあるk-1人のクイーンの筋に乗っていない事を確認して、乗っていないものだけを残す

k列目までの解を返すqueen-colsが内部関数として定義されている。この関数はkが0であれば空のリストを解として返すが、そうでない場合にはまずfilter引数としてのflatmapの引数として自分自身を再帰呼び出しをしてk-1列目までの解を得る。なので1列目の解から構築されて行く事になる。

(enumerate-interval 1 board-size)はk列目のクイーンの取り得る位置を列挙する。普通は1から8の数字。
これをlamdaの引数new-rowで受け取り、(adjoin-position new-row k rest-of-queens)に渡す。
rest-of-queensは(queen-cols (- k 1))が返したk-1列目までのクイーンの配置のリストから取り出したひとつの配置。

と言う事は(adjoin-position new-row k rest-of-queens)は(queen-cols (- k 1))が返すそれぞれの配置に対して、k列目のクイーンの位置(board-size通り)を足したboard-size通りの配置の組み合わせを生成する。引数にkを渡しているのはクイーンの位置の表現方法によっては冗長な気もするが、恐らくここではいわゆる棋譜を数字のペア*1として表現して、そのペアを以てクイーンの位置としていると思われる。なのでadjoin-positionでは(k new-row)と言うペアをk-1列までの配置との組み合わせる事にする。

まずクイーンの配置を表すデータを扱う関数達を定義する。初期値を作るempty-board、ある列のクイーンの位置を加えるadd-position、k列目のクイーンの位置を返すpositio-ref:

(define empty-board null)
(define (add-position position positions)
  (cons position positions))
(define (position-ref k positions)
  (cond ((null? positions) null)
        ((= (car (car positions)) k) (car positions))
        (else (position-ref k (cdr positions)))))

これを使ってadjoin-positionを定義すると:

(define (adjoin-position new-row k rest-of-queens)
  (add-position (list k new-row) rest-of-queens))

ここではk-1列目までの可能な配置それぞれについてk列目のクイーンの位置を組み合わせたリストが生成されてしまうので、flatmapで全てを一列に並べ直している。
flatmapで一列になったリストにはk列目までのクイーンの配置(各列のクイーンの位置を示したペアがk個入ったリスト)のリスト。filterでそれぞれが互いに筋に入っていないものだけを残す。そのチェックに使うのがsafe?。
filterに与える関数の引数はpositionsなので、ここにクイーンの配置が入って来る。これのうちk番目のクイーンが他のクイーンの筋に乗っていないかを確認する。
実装上positionsが空な事はあり得ないが、kが1の時はひとつの位置しか入っていないのでcdrは空。その時はsafeと判断。
内部関数safe-pos?では二つのクイーンa、bの筋が重なっていないチェックする。k列目のクイーンの位置を取っておいて、1〜k-1までの数字を生成してposition-refでそれぞれ1〜k-1列目までのクイーンとk列目のクイーンの筋が重なっていないかチェックして、最後にその結果を全てandを取る。
重なりの確認は

  • 互いの行(row)が同じなら駄目
  • 片方の行±互いの行の差がもう一方の行と一致すると駄目(斜めの筋に乗っている)

とする。

(define (safe? k positions)
  (define (safe-pos? a b)
    (letrec ((a-col (car a))
             (a-row (car (cdr a)))
             (b-col (car b))
             (b-row (car (cdr b)))
             (col-diff (- a-col b-col)))
             (if (or (= b-row a-row) (= b-row (+ a-row col-diff)) (= b-row (- a-row col-diff)))
                 #f
                 #t)))
  (let ((kth-pos (position-ref k positions)))
    (accumulate (lambda (item acc) (and item acc))
                #t
                (map (lambda (pos) (safe-pos? kth-pos (position-ref pos positions)))
                     (enumerate-interval 1 (- k 1))))))

本当は途中でひとつでもfalseになればその先のチェックは不要なので少し冗長な処理を含んでいる。
実行結果。

> (queens 8)
(((8 4) (7 2) (6 7) (5 3) (4 6) (3 8) (2 5) (1 1))
 ((8 5) (7 2) (6 4) (5 7) (4 3) (3 8) (2 6) (1 1))
 ((8 3) (7 5) (6 2) (5 8) (4 6) (3 4) (2 7) (1 1))
 ((8 3) (7 6) (6 4) (5 2) (4 8) (3 5) (2 7) (1 1))
 ((8 5) (7 7) (6 1) (5 3) (4 8) (3 6) (2 4) (1 2))
 ((8 4) (7 6) (6 8) (5 3) (4 1) (3 7) (2 5) (1 2))
 ((8 3) (7 6) (6 8) (5 1) (4 4) (3 7) (2 5) (1 2))
 ((8 5) (7 3) (6 8) (5 4) (4 7) (3 1) (2 6) (1 2))
 ((8 5) (7 7) (6 4) (5 1) (4 3) (3 8) (2 6) (1 2))
 ((8 4) (7 1) (6 5) (5 8) (4 6) (3 3) (2 7) (1 2))
 ((8 3) (7 6) (6 4) (5 1) (4 8) (3 5) (2 7) (1 2))
 ((8 4) (7 7) (6 5) (5 3) (4 1) (3 6) (2 8) (1 2))
 ((8 6) (7 4) (6 2) (5 8) (4 5) (3 7) (2 1) (1 3))
 ((8 6) (7 4) (6 7) (5 1) (4 8) (3 2) (2 5) (1 3))
 ((8 1) (7 7) (6 4) (5 6) (4 8) (3 2) (2 5) (1 3))
 ((8 6) (7 8) (6 2) (5 4) (4 1) (3 7) (2 5) (1 3))
 ((8 6) (7 2) (6 7) (5 1) (4 4) (3 8) (2 5) (1 3))
 ((8 4) (7 7) (6 1) (5 8) (4 5) (3 2) (2 6) (1 3))
 ((8 5) (7 8) (6 4) (5 1) (4 7) (3 2) (2 6) (1 3))
 ((8 4) (7 8) (6 1) (5 5) (4 7) (3 2) (2 6) (1 3))
 ((8 2) (7 7) (6 5) (5 8) (4 1) (3 4) (2 6) (1 3))
 ((8 1) (7 7) (6 5) (5 8) (4 2) (3 4) (2 6) (1 3))
 ((8 2) (7 5) (6 7) (5 4) (4 1) (3 8) (2 6) (1 3))
 ((8 4) (7 2) (6 7) (5 5) (4 1) (3 8) (2 6) (1 3))
 ((8 5) (7 7) (6 1) (5 4) (4 2) (3 8) (2 6) (1 3))
 ((8 6) (7 4) (6 1) (5 5) (4 8) (3 2) (2 7) (1 3))
 ((8 5) (7 1) (6 4) (5 6) (4 8) (3 2) (2 7) (1 3))
 ((8 5) (7 2) (6 6) (5 1) (4 7) (3 4) (2 8) (1 3))
 ((8 6) (7 3) (6 7) (5 2) (4 8) (3 5) (2 1) (1 4))
 ((8 2) (7 7) (6 3) (5 6) (4 8) (3 5) (2 1) (1 4))
 ((8 7) (7 3) (6 1) (5 6) (4 8) (3 5) (2 2) (1 4))
 ((8 5) (7 1) (6 8) (5 6) (4 3) (3 7) (2 2) (1 4))
 ((8 1) (7 5) (6 8) (5 6) (4 3) (3 7) (2 2) (1 4))
 ((8 3) (7 6) (6 8) (5 1) (4 5) (3 7) (2 2) (1 4))
 ((8 6) (7 3) (6 1) (5 7) (4 5) (3 8) (2 2) (1 4))
 ((8 7) (7 5) (6 3) (5 1) (4 6) (3 8) (2 2) (1 4))
 ((8 7) (7 3) (6 8) (5 2) (4 5) (3 1) (2 6) (1 4))
 ((8 5) (7 3) (6 1) (5 7) (4 2) (3 8) (2 6) (1 4))
 ((8 2) (7 5) (6 7) (5 1) (4 3) (3 8) (2 6) (1 4))
 ((8 3) (7 6) (6 2) (5 5) (4 8) (3 1) (2 7) (1 4))
 ((8 6) (7 1) (6 5) (5 2) (4 8) (3 3) (2 7) (1 4))
 ((8 8) (7 3) (6 1) (5 6) (4 2) (3 5) (2 7) (1 4))
 ((8 2) (7 8) (6 6) (5 1) (4 3) (3 5) (2 7) (1 4))
 ((8 5) (7 7) (6 2) (5 6) (4 3) (3 1) (2 8) (1 4))
 ((8 3) (7 6) (6 2) (5 7) (4 5) (3 1) (2 8) (1 4))
 ((8 6) (7 2) (6 7) (5 1) (4 3) (3 5) (2 8) (1 4))
 ((8 3) (7 7) (6 2) (5 8) (4 6) (3 4) (2 1) (1 5))
 ((8 6) (7 3) (6 7) (5 2) (4 4) (3 8) (2 1) (1 5))
 ((8 4) (7 2) (6 7) (5 3) (4 6) (3 8) (2 1) (1 5))
 ((8 7) (7 1) (6 3) (5 8) (4 6) (3 4) (2 2) (1 5))
 ((8 1) (7 6) (6 8) (5 3) (4 7) (3 4) (2 2) (1 5))
 ((8 3) (7 8) (6 4) (5 7) (4 1) (3 6) (2 2) (1 5))
 ((8 6) (7 3) (6 7) (5 4) (4 1) (3 8) (2 2) (1 5))
 ((8 7) (7 4) (6 2) (5 8) (4 6) (3 1) (2 3) (1 5))
 ((8 4) (7 6) (6 8) (5 2) (4 7) (3 1) (2 3) (1 5))
 ((8 2) (7 6) (6 1) (5 7) (4 4) (3 8) (2 3) (1 5))
 ((8 2) (7 4) (6 6) (5 8) (4 3) (3 1) (2 7) (1 5))
 ((8 3) (7 6) (6 8) (5 2) (4 4) (3 1) (2 7) (1 5))
 ((8 6) (7 3) (6 1) (5 8) (4 4) (3 2) (2 7) (1 5))
 ((8 8) (7 4) (6 1) (5 3) (4 6) (3 2) (2 7) (1 5))
 ((8 4) (7 8) (6 1) (5 3) (4 6) (3 2) (2 7) (1 5))
 ((8 2) (7 6) (6 8) (5 3) (4 1) (3 4) (2 7) (1 5))
 ((8 7) (7 2) (6 6) (5 3) (4 1) (3 4) (2 8) (1 5))
 ((8 3) (7 6) (6 2) (5 7) (4 1) (3 4) (2 8) (1 5))
 ((8 4) (7 7) (6 3) (5 8) (4 2) (3 5) (2 1) (1 6))
 ((8 4) (7 8) (6 5) (5 3) (4 1) (3 7) (2 2) (1 6))
 ((8 3) (7 5) (6 8) (5 4) (4 1) (3 7) (2 2) (1 6))
 ((8 4) (7 2) (6 8) (5 5) (4 7) (3 1) (2 3) (1 6))
 ((8 5) (7 7) (6 2) (5 4) (4 8) (3 1) (2 3) (1 6))
 ((8 7) (7 4) (6 2) (5 5) (4 8) (3 1) (2 3) (1 6))
 ((8 8) (7 2) (6 4) (5 1) (4 7) (3 5) (2 3) (1 6))
 ((8 7) (7 2) (6 4) (5 1) (4 8) (3 5) (2 3) (1 6))
 ((8 5) (7 1) (6 8) (5 4) (4 2) (3 7) (2 3) (1 6))
 ((8 4) (7 1) (6 5) (5 8) (4 2) (3 7) (2 3) (1 6))
 ((8 5) (7 2) (6 8) (5 1) (4 4) (3 7) (2 3) (1 6))
 ((8 3) (7 7) (6 2) (5 8) (4 5) (3 1) (2 4) (1 6))
 ((8 3) (7 1) (6 7) (5 5) (4 8) (3 2) (2 4) (1 6))
 ((8 8) (7 2) (6 5) (5 3) (4 1) (3 7) (2 4) (1 6))
 ((8 3) (7 5) (6 2) (5 8) (4 1) (3 7) (2 4) (1 6))
 ((8 3) (7 5) (6 7) (5 1) (4 4) (3 2) (2 8) (1 6))
 ((8 5) (7 2) (6 4) (5 6) (4 8) (3 3) (2 1) (1 7))
 ((8 6) (7 3) (6 5) (5 8) (4 1) (3 4) (2 2) (1 7))
 ((8 5) (7 8) (6 4) (5 1) (4 3) (3 6) (2 2) (1 7))
 ((8 4) (7 2) (6 5) (5 8) (4 6) (3 1) (2 3) (1 7))
 ((8 4) (7 6) (6 1) (5 5) (4 2) (3 8) (2 3) (1 7))
 ((8 6) (7 3) (6 1) (5 8) (4 5) (3 2) (2 4) (1 7))
 ((8 5) (7 3) (6 1) (5 6) (4 8) (3 2) (2 4) (1 7))
 ((8 4) (7 2) (6 8) (5 6) (4 1) (3 3) (2 5) (1 7))
 ((8 6) (7 3) (6 5) (5 7) (4 1) (3 4) (2 2) (1 8))
 ((8 6) (7 4) (6 7) (5 1) (4 3) (3 5) (2 2) (1 8))
 ((8 4) (7 7) (6 5) (5 2) (4 6) (3 1) (2 3) (1 8))
 ((8 5) (7 7) (6 2) (5 6) (4 3) (3 1) (2 4) (1 8)))
> 

検算が難しいが、鏡像関係も全て含めると全部で92通りらしいので、取り敢えず解の数は合っている。
処理が少し冗長だったり、safe?の引数に必ずしもkが要らない気もするのでもっとシンプルに書けそうだが。

Exercise 2.43

私の環境ではboard-size=6までは遅い様には感じないが、7で少し遅くなり、8になると数分待つ事に。

全体を再帰させる関数がループの内側で呼ばれるので、2.43の方が遅い事は容易に想像出来るが、見積もる事は意外と難しそう。

board-size=8と仮定して、(queen-cols 8)は(queen-cols 7)を8回、(queen-cols 7)は呼ばれる度に、(queen-cols 6)を8回、…、(queen-cols 1)は呼ばれる度に(queen-cols 0)を8回呼び出すので、queen-colsは1+88=16777217回呼ばれる予想。2.42では(queen-cols 8)〜(queen-cols 0)がそれぞれ1回ずつなので9回。ただ1回の呼び出しで掛かる時間はkに依存しそうなので、2.42の計算で掛かる時間をTと置いても、queen-colsの呼び出し回数だけでTの何倍になるかとか見積もるのは難しい気がする。
まぁそこを割り切ってざっくり計算してしまうと概ねboard-size対board-sizeboard-sizeなのでT×board-sizeboard-size-1位と見積もれるのか。

折角なので(queens 8)についてDrRacketでプロファイルを取ってみる。2.43のプロファイルを取るには流石に10分以上掛かった。

procedure 2.42 2.43
position-ref 363176 207362304
enumerate-interval 115101 132338961
accumulate 99389 132338961
safe-pos? 81696 59878720
add-position 15720 50889536
adjoin-position 11570 50889536
safe? 11570 50889536
queen-cols 9 19173961
flatmap 8 2396745

queen-colsは概ね近いが予想よりも少し多く呼ばれている。上手く説明は出来ない。

実は良く見ると2.42でもenumerate-intervalは冗長に呼ばれている。本当はqueensが呼ばれた時に1回呼べば良い筈。そう考えるとここに登場する関数は全て副作用無しで同じ引数には必ず同じ結果を返すので、結果を記憶して再利用すれば本質的には呼び出し回数はあまり問題とならないのかも知れない。

*1:cellに入れたドットペアと言う意味ではなく、単に二つの数字の組と言う意味