@uents blog

Code wins arguments.

SICP 読書ノート#9 - 2.2.3 公認インターフェースとしての並び - 写像の入れ子 (pp.71-73)

「§2.2.3 公認インターフェースの並び」の「写像の入れ子」から。

写像の入れ子

まずは写経。

enumerate-intervalから復習。

(define (enumerate-interval low high)
  (if (> low high)
      nil
      (cons low (enumerate-interval (+ low 1) high))))
racket@> (enumerate-interval 1 6)
'(1 2 3 4 5 6)

テキストの例のn=6の場合のi,jの対を作成してみる。

racket@> (let ((n 6))
  (accumulate append
              nil
              (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の(enumerate-interval 1 n)'(1 2 3 4 5 6) を返すので

  • 1の場合の内側のmapのenumera-intervalは、nil
  • 2の場合の内側のmapのenumera-intervalは、'(1)
  • 3の場合の内側のmapのenumera-intervalは、'(1 2)
  • 4の場合の内側のmapのenumera-intervalは、'(1 2 3)
  • 5の場合の内側のmapのenumera-intervalは、'(1 2 3 4)
  • 6の場合の内側のmapのenumera-intervalは、'(1 2 3 4 5)

となるので、それをlistで組み合われば、上記のような結果が得られる。

ここでmapとappendのaccumlationをflatmapとして定義しなおす。

(define (flatmap proc sequence)
  (accumulate append nil (map proc sequence)))

i,jの対を作成するコードをflatmapを使って書き直してみる。

racket@> (let ((n 6))
  (flatmap 
   (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))

いまいちflatmapが腑に落ちないのでもう少し遊んでみる。

まずは単純に要素をプリント。'(1 2 3 4 5 6)はflatmapの戻値、それ以外はdisplayの出力結果。

;; flatmapのテスト
(flatmap (lambda (x) (begin
                       (display (format "~a ~%" x))
                       x))
         (list (list 1 2) (list 3) (list 4 5 6)))

(1 2) 
(3) 
(4 5 6) 
'(1 2 3 4 5 6)

つまり、flatmapはsequenceからひとずつ要素を取り出してはprocに渡し、procからの出力をappendする手続きと言える。

もうひとつテスト。

racket@> (flatmap (lambda (x)
                    (map (lambda (n) (* n 2)) x))
                  (list (list 1 2) (list 3) (list 4 5 6)))

'(2 4 6 8 10 12)

ただしflatmapは入れ子のリストは展開できない。

racket@> (flatmap (lambda (x) (begin
                                (display (format "~a ~%" x))
                                x))
                  (list (list 1 2) (list 3 (list 4 5)) (list (list 7) 8 9)))
(1 2) 
(3 (4 5)) 
((7) 8 9) 
'(1 2 3 (4 5) (7) 8 9)

これでflatmapなんとなくわかった。

次に、対の和が素数かどうかを判定する手続きなどを実装する。 pair-sumを追加して、SICPのテキストと少し変えてみた。

;; prime?を借りるためにロード
(require math/number-theory)

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

(define (prime-sum? pair)
  (prime? (pair-sum pair)))

(define (make-pair-sum pair)
  (append pair (cons (pair-sum pair) nil)))

最後にprime-sum-pairsを写経。

(define (prime-sum-pairs n)
  ;; (3) i,j,i+jのpairのリストを作成する
  (map make-pair-sum
       ;; (2) i+jが素数のpairだけをリストに残す
       (filter prime-sum?
               ;; (1) ここでi,jの対のリストを作成
               (flatmap
                (lambda (i)
                  (map (lambda (j) (list i j))
                       (enumerate-interval 1 (- i 1))))
                (enumerate-interval 1 n)))))

動作確認。

rakect@> (prime-sum-pairs 6)
'((2 1 3) (3 2 5) (4 1 5) (4 3 7) (5 2 7) (6 1 7) (6 5 11))

写像(map)を入れ子にすることでイテレーションを組み合わせることができる。 forの内側でforを使って配列を作るのような処理と同じだが、 例えばJavaScriptの場合だと、今回のようなアプローチを知らなければ、 forループのなかに何でも詰め込んでしまうようなコードを書いてしまいそうな気がする。

var isPrime = function(n) {
    if (n == 1) {
        return true;
    }
    for (var i = 2; i < n; i++) {
        if (n % i == 0) {
            return false;
        }
    }
    return true;
};

var primeSumPairs = function(n) {
    var pairs = [];
    
    for (var i = 1; i <= n; i++) {
        for (j = 1; j < i; j++) {
            var sum = i + j;
            if (isPrime(sum)) {
                pairs.push([i, j, sum]);
            }
        }
    }
    return pairs;
};

primeSumPairs(6);
// => [ [ 2, 1, 3 ],
//      [ 3, 2, 5 ],
//      [ 4, 1, 5 ],
//      [ 4, 3, 7 ],
//      [ 5, 2, 7 ],
//      [ 6, 1, 7 ],
//      [ 6, 5, 11 ] ]

今回のような短い例であれば、上記のような実装でもわかるが、 これが長く複雑な処理の場合はどうだろう?

そうではなくて、SICPの例のように、基本的な部品を手続きによって作成し、 それらの入出力を組み合わせることでより明解なプログラムが実装できる。

問題 2.40

1<=i<j<=nの対(i,j)の並びを生成する手続きunique-pairsを定義し、 prime-sum-pairsを簡単にする。

まずはunique-pairs。

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

prime-sum-pairsはさらに簡単になる。

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

問題 2.41

与えられた整数nに対し、nより小さいか等しい相異なる整数i,j,kの順序づけられた3つの組で、 和が与えられた整数sになるものをすべて見つけよ。

「与えられた整数nに対し、nより小さいか等しい相異なる整数i,j,kの順序づけられた3つの組」、

  • n=1の場合は、nil
  • n=2の場合は、nil
  • n=3の場合は、'((1 2 3))
  • n=4の場合は、'((1 2 3) (1 2 4) (1 3 4) (2 3 4))
  • n=Nの場合は、'((1 2 3) (1 2 4) ... (N-2 N-2 N))

を作成する手続きを考える。

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


racket@> (unique-trio 6)
'((1 2 3) (1 2 4) (1 3 4) (2 3 4)
  (1 2 5) (1 3 5) (2 3 5) (1 4 5) (2 4 5) (3 4 5)
  (1 2 6) (1 3 6) (2 3 6) (1 4 6) (2 4 6) (3 4 6) (1 5 6) (2 5 6) (3 5 6) (4 5 6))

sum(i,j,k) = sが成り立つ対をfilterで絞り込む

(define (trio-sum trio)
  (+ (car trio) (cadr trio) (caddr trio)))

(define (equal-sum-trio n s)
  (filter (lambda (t) (= (trio-sum t) s))
          (unique-trio n)))

テスト。

racket@> (equal-sum-trio 6 10)
'((2 3 5) (1 4 5) (1 3 6))

問題 2.42

8クイーンパズル。解くのに3日かかった…

(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?を実装して queens手続きを完成させよ、という問題。

まずクイーンの置き方の全ての組み合わせについて、

  • k=0の場合は、nil
  • k=1の場合は、'((1 1))
  • k=2の場合は、'(((1 1) (2 1)) ((1 1) (2 2)) ((1 2) (2 1)) ((1 2) (2 2)))
  • k=3の場合は、'(((1 1) (2 1) (3 1)) ... ((1 3) (2 3) (3 3)))
  • ...

としたい。

よって(queen-cols 0)の結果である(list empty-board)のempty-boardはnilである。

(define empty-board nil)

safe?はよくわからないので、いったん

(define (safe? k positions) #t)

としてしまい、クイーンの置き方の全ての組み合わせが出るように、adjoin-positionを実装する。

adjoin-positionもひとまず、

(define (adjoin-position new-row k rest-of-queens)
  (display (format "n-row=~a k=~a r-queens=~a ~%" new-row k rest-of-queens)))

として、queensを評価してみると、

racket@> (queens 1)
n-row=1 k=1 r-queens=() 

racket@> (queens 2)
n-row=1 k=1 r-queens=() 
n-row=2 k=1 r-queens=() 
n-row=1 k=2 r-queens=#<void> 
n-row=2 k=2 r-queens=#<void> 
n-row=1 k=2 r-queens=#<void> 
n-row=2 k=2 r-queens=#<void> 

racket@> (queens 3)
n-row=1 k=1 r-queens=() 
n-row=2 k=1 r-queens=() 
n-row=3 k=1 r-queens=() 
n-row=1 k=2 r-queens=#<void> 
n-row=2 k=2 r-queens=#<void> 
n-row=3 k=2 r-queens=#<void> 
n-row=1 k=2 r-queens=#<void> 
n-row=2 k=2 r-queens=#<void> 
n-row=3 k=2 r-queens=#<void> 
n-row=1 k=2 r-queens=#<void> 
n-row=2 k=2 r-queens=#<void> 
n-row=3 k=2 r-queens=#<void> 
n-row=1 k=3 r-queens=#<void> 
n-row=2 k=3 r-queens=#<void> 
n-row=3 k=3 r-queens=#<void> 
n-row=1 k=3 r-queens=#<void> 
n-row=2 k=3 r-queens=#<void> 
n-row=3 k=3 r-queens=#<void> 
n-row=1 k=3 r-queens=#<void> 
n-row=2 k=3 r-queens=#<void> 
n-row=3 k=3 r-queens=#<void> 
n-row=1 k=3 r-queens=#<void> 
n-row=2 k=3 r-queens=#<void> 
n-row=3 k=3 r-queens=#<void> 
n-row=1 k=3 r-queens=#<void> 
n-row=2 k=3 r-queens=#<void> 
n-row=3 k=3 r-queens=#<void> 
n-row=1 k=3 r-queens=#<void> 
n-row=2 k=3 r-queens=#<void> 
n-row=3 k=3 r-queens=#<void> 
n-row=1 k=3 r-queens=#<void> 
n-row=2 k=3 r-queens=#<void> 
n-row=3 k=3 r-queens=#<void> 
n-row=1 k=3 r-queens=#<void> 
n-row=2 k=3 r-queens=#<void> 
n-row=3 k=3 r-queens=#<void> 
n-row=1 k=3 r-queens=#<void> 
n-row=2 k=3 r-queens=#<void> 
n-row=3 k=3 r-queens=#<void> 

と、r-queensに対してkとn-rowsから作られるpositionを 追加していけばよいことが何となくわかる。

よって、

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

として、queensを再度評価すると、

racket@> (queens 1)
'(((1 1)))

racket@> (queens 2)
'(((1 1) (2 1)) ((1 1) (2 2)) ((1 2) (2 1)) ((1 2) (2 2)))

racket@> (queens 3)
'(((1 1) (2 1) (3 1))
  ((1 1) (2 1) (3 2))
  ((1 1) (2 1) (3 3))
  ((1 1) (2 2) (3 1))
  ((1 1) (2 2) (3 2))
  ((1 1) (2 2) (3 3))
  ((1 1) (2 3) (3 1))
  ((1 1) (2 3) (3 2))
  ((1 1) (2 3) (3 3))
  ((1 2) (2 1) (3 1))
  ((1 2) (2 1) (3 2))
  ((1 2) (2 1) (3 3))
  ((1 2) (2 2) (3 1))
  ((1 2) (2 2) (3 2))
  ((1 2) (2 2) (3 3))
  ((1 2) (2 3) (3 1))
  ((1 2) (2 3) (3 2))
  ((1 2) (2 3) (3 3))
  ((1 3) (2 1) (3 1))
  ((1 3) (2 1) (3 2))
  ((1 3) (2 1) (3 3))
  ((1 3) (2 2) (3 1))
  ((1 3) (2 2) (3 2))
  ((1 3) (2 2) (3 3))
  ((1 3) (2 3) (3 1))
  ((1 3) (2 3) (3 2))
  ((1 3) (2 3) (3 3)))

と所望の結果が得られた。

次に、safe?を

(define (safe? k positions)
  (display (format "k=~a pos=~a ~%" k positions))
  #t)

として、queensを再度評価すると、

racket@> (queens 1)
k=1 pos=((1 1)) 

racket@> (queens 2)
k=1 pos=((1 1)) 
k=1 pos=((1 2)) 
k=2 pos=((1 1) (2 1)) 
k=2 pos=((1 1) (2 2)) 
k=2 pos=((1 2) (2 1)) 
k=2 pos=((1 2) (2 2)) 

racket@> (queens 3)
k=1 pos=((1 1)) 
k=1 pos=((1 2)) 
k=1 pos=((1 3)) 
k=2 pos=((1 1) (2 1)) 
k=2 pos=((1 1) (2 2)) 
k=2 pos=((1 1) (2 3)) 
k=2 pos=((1 2) (2 1)) 
k=2 pos=((1 2) (2 2)) 
k=2 pos=((1 2) (2 3)) 
k=2 pos=((1 3) (2 1)) 
k=2 pos=((1 3) (2 2)) 
k=2 pos=((1 3) (2 3)) 
k=3 pos=((1 1) (2 1) (3 1)) 
k=3 pos=((1 1) (2 1) (3 2)) 
k=3 pos=((1 1) (2 1) (3 3)) 
k=3 pos=((1 1) (2 2) (3 1)) 
k=3 pos=((1 1) (2 2) (3 2)) 
k=3 pos=((1 1) (2 2) (3 3)) 
k=3 pos=((1 1) (2 3) (3 1)) 
k=3 pos=((1 1) (2 3) (3 2)) 
k=3 pos=((1 1) (2 3) (3 3)) 
k=3 pos=((1 2) (2 1) (3 1)) 
k=3 pos=((1 2) (2 1) (3 2)) 
k=3 pos=((1 2) (2 1) (3 3)) 
k=3 pos=((1 2) (2 2) (3 1)) 
k=3 pos=((1 2) (2 2) (3 2)) 
k=3 pos=((1 2) (2 2) (3 3)) 
k=3 pos=((1 2) (2 3) (3 1)) 
k=3 pos=((1 2) (2 3) (3 2)) 
k=3 pos=((1 2) (2 3) (3 3)) 
k=3 pos=((1 3) (2 1) (3 1)) 
k=3 pos=((1 3) (2 1) (3 2)) 
k=3 pos=((1 3) (2 1) (3 3)) 
k=3 pos=((1 3) (2 2) (3 1)) 
k=3 pos=((1 3) (2 2) (3 2)) 
k=3 pos=((1 3) (2 2) (3 3)) 
k=3 pos=((1 3) (2 3) (3 1)) 
k=3 pos=((1 3) (2 3) (3 2)) 
k=3 pos=((1 3) (2 3) (3 3)) 

となる。safe?は着目するクイーンがすでに配置されたクイーンに対し、 同行または斜めでなければ#tを返せばよいので、以下のように実装できる。

(define (safe? k positions)
  (safe-iter? (- k 1) k positions))

(define (safe-iter? i k positions)
  (if (= i 0)
      #t
      (let ((old-pos (list-ref positions (- i 1)))
            (new-pos (list-ref positions (- k 1))))
        (and (not (= (cadr old-pos) (cadr new-pos)))
             (not (= (cadr old-pos) (- (cadr new-pos) (- k i))))
             (not (= (cadr old-pos) (+ (cadr new-pos) (- k i))))
             (safe-iter? (- i 1) k positions)))))

テスト。

racket@> (queens 1)
'(((1 1)))

racket@> (queens 2)
'()

racket@> (queens 3)
'()

racket@> (queens 4)
'(((1 2) (2 4) (3 1) (4 3)) ((1 3) (2 1) (3 4) (4 2)))

racket@> (queens 8)
'(((1 1) (2 5) (3 8) (4 6) (5 3) (6 7) (7 2) (8 4))
  ((1 1) (2 6) (3 8) (4 3) (5 7) (6 4) (7 2) (8 5))
  ((1 1) (2 7) (3 4) (4 6) (5 8) (6 2) (7 5) (8 3))
  ((1 1) (2 7) (3 5) (4 8) (5 2) (6 4) (7 6) (8 3))
  ...
  ((1 8) (2 2) (3 4) (4 1) (5 7) (6 5) (7 3) (8 6))
  ((1 8) (2 2) (3 5) (4 3) (5 1) (6 7) (7 4) (8 6))
  ((1 8) (2 3) (3 1) (4 6) (5 2) (6 5) (7 7) (8 4))
  ((1 8) (2 4) (3 1) (4 3) (5 6) (6 2) (7 7) (8 5)))

答え合わせは エイト・クイーン - Wikipedia でやりました。合ってそう。

問題 2.43

safe?を

(define (safe? k positions)
  (display (format "k=~a pos=~a ~%" k positions))
  #t)

とした上で、Louisによるqueensを実装し、

(define (queens-louis board-size)
  (define (queen-cols k)
    (if (= k 0)
        (list empty-board)
        (filter
         (lambda (positions) (safe? k positions))
         (flatmap
          (lambda (new-row)
            (map (lambda (rest-of-queens)
                   (adjoin-position new-row k rest-of-queens))
                 (queen-cols (- k 1))))
          (enumerate-interval 1 board-size)))))
  (queen-cols board-size))

評価してみると、

racket@> (queens-louis 3)
k=1 pos=((1 1)) 
k=1 pos=((1 2)) 
k=1 pos=((1 3)) 
k=1 pos=((1 1)) 
k=1 pos=((1 2)) 
k=1 pos=((1 3)) 
k=1 pos=((1 1)) 
k=1 pos=((1 2)) 
k=1 pos=((1 3)) 
k=2 pos=((1 1) (2 1)) 
k=2 pos=((1 2) (2 1)) 
k=2 pos=((1 3) (2 1)) 
k=2 pos=((1 1) (2 2)) 
k=2 pos=((1 2) (2 2)) 
k=2 pos=((1 3) (2 2)) 
k=2 pos=((1 1) (2 3)) 
k=2 pos=((1 2) (2 3)) 
k=2 pos=((1 3) (2 3)) 
k=1 pos=((1 1)) 
k=1 pos=((1 2)) 
k=1 pos=((1 3)) 
k=1 pos=((1 1)) 
k=1 pos=((1 2)) 
k=1 pos=((1 3)) 
k=1 pos=((1 1)) 
k=1 pos=((1 2)) 
k=1 pos=((1 3)) 
k=2 pos=((1 1) (2 1)) 
k=2 pos=((1 2) (2 1)) 
k=2 pos=((1 3) (2 1)) 
k=2 pos=((1 1) (2 2)) 
k=2 pos=((1 2) (2 2)) 
k=2 pos=((1 3) (2 2)) 
k=2 pos=((1 1) (2 3)) 
k=2 pos=((1 2) (2 3)) 
k=2 pos=((1 3) (2 3)) 
k=1 pos=((1 1)) 
k=1 pos=((1 2)) 
k=1 pos=((1 3)) 
k=1 pos=((1 1)) 
k=1 pos=((1 2)) 
k=1 pos=((1 3)) 
k=1 pos=((1 1)) 
k=1 pos=((1 2)) 
k=1 pos=((1 3)) 
k=2 pos=((1 1) (2 1)) 
k=2 pos=((1 2) (2 1)) 
k=2 pos=((1 3) (2 1)) 
k=2 pos=((1 1) (2 2)) 
k=2 pos=((1 2) (2 2)) 
k=2 pos=((1 3) (2 2)) 
k=2 pos=((1 1) (2 3)) 
k=2 pos=((1 2) (2 3)) 
k=2 pos=((1 3) (2 3)) 
k=3 pos=((1 1) (2 1) (3 1)) 
k=3 pos=((1 2) (2 1) (3 1)) 
k=3 pos=((1 3) (2 1) (3 1)) 
k=3 pos=((1 1) (2 2) (3 1)) 
k=3 pos=((1 2) (2 2) (3 1)) 
k=3 pos=((1 3) (2 2) (3 1)) 
k=3 pos=((1 1) (2 3) (3 1)) 
k=3 pos=((1 2) (2 3) (3 1)) 
k=3 pos=((1 3) (2 3) (3 1)) 
k=3 pos=((1 1) (2 1) (3 2)) 
k=3 pos=((1 2) (2 1) (3 2)) 
k=3 pos=((1 3) (2 1) (3 2)) 
k=3 pos=((1 1) (2 2) (3 2)) 
k=3 pos=((1 2) (2 2) (3 2)) 
k=3 pos=((1 3) (2 2) (3 2)) 
k=3 pos=((1 1) (2 3) (3 2)) 
k=3 pos=((1 2) (2 3) (3 2)) 
k=3 pos=((1 3) (2 3) (3 2)) 
k=3 pos=((1 1) (2 1) (3 3)) 
k=3 pos=((1 2) (2 1) (3 3)) 
k=3 pos=((1 3) (2 1) (3 3)) 
k=3 pos=((1 1) (2 2) (3 3)) 
k=3 pos=((1 2) (2 2) (3 3)) 
k=3 pos=((1 3) (2 2) (3 3)) 
k=3 pos=((1 1) (2 3) (3 3)) 
k=3 pos=((1 2) (2 3) (3 3)) 
k=3 pos=((1 3) (2 3) (3 3)) 

と、queens-colsを内側の入れ子に入れてしまったため、 同じ組み合わせを何度もチェックしているケースがあることがわかる。

問題2.42の解く時間に対して、Louisのプログラムはborder-sizeの階乗倍分の時間を要する。

次回は、「§2.2.4 図形言語」から。


※「SICP読書ノート」の目次はこちら