Scheme - データによる抽象の構築(階層データ構造と閉包性(公認インターフェースとしての並び(写像の入れ子)))

計算機プログラムの構造と解釈[第2版]
原著

開発環境

• macOS Sierra - Apple (OS)
• Emacs (Text Editor)
• Scheme (プログラミング言語)
• kscheme (ksi)(github) (処理系)

計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原著: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の第2章(データによる抽象の構築)、2.2(階層データ構造と閉包性)、2.2.3(公認インターフェースとしての並び)、写像の入れ子、問題2.40、41、42、43.を取り組んでみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs

問題2.40、41、42、43.

コード(Emacs)

(begin
  ;; (load "procedures.scm")
  (newline)
  (define (p obj) (display obj) (newline))

  (define (filter pred seq)
    (if (null? seq)
        seq
        (if (pred (car seq))
            (cons (car seq) (filter pred (cdr seq)))
            (filter pred (cdr seq)))))
  (define (smallest-divisor n) (find-divisor n 2))
  (define (find-divisor n test-divisor)
    (if (> (square test-divisor) n)
        n
        (if (divides? test-divisor n)
            test-divisor
            (find-divisor n (+ test-divisor 1)))))
  (define (divides? a b) (= (remainder b a) 0))
  (define (prime? n)
    (= n (smallest-divisor n)))
  
  (define (enumerate-interval low high)
    (if (> low high)
        '()
        (cons low (enumerate-interval (+ low 1) high))))
  (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 (prime-sum? pair)
    (prime? (+ (car pair) (cadr pair))))
  
  (p "2.40")
  (define (unique-pairs n)
    (flatmap (lambda (i)
               (map (lambda (j) (list j i))
                    (enumerate-interval 1 (- i 1))))
             (enumerate-interval 1 n)))
  (define (prime-sum-pairs n)
    (filter prime-sum? (unique-pairs n)))
  
  (p (prime-sum-pairs 6))

  (p '2.41)

  (define (sum-seq-triple n s)
    (filter (lambda (seq)
              (= (+ (car seq) (cadr seq) (caddr seq)) s))
            (flatmap (lambda (k)
                       (map (lambda (pair)
                              (list (car pair) (cadr pair) k))
                            (unique-pairs (- k 1))))
                     (enumerate-interval 1 n))))
  (p (sum-seq-triple 10 20))

  (p '2.42)
  (define (position row col) (list row col))
  (define (position-row p) (car p))
  (define (position-col p) (cadr p))

  (define empty-board '())
  (define (adjoin-position new-row k queens)
    (append queens (list (position new-row k))))

  (define (safe? k positions)
    (define (get-k positions k)
      (if (= k 1)
          (car positions)
          (get-k (cdr positions ) (- k 1))))
    (define k-pos (get-k positions k))
    (define (iter positions)
      (if (null? (cdr positions))
          #t
          ((lambda (p)
             (if (or (and (not (= (position-row p) (position-row k-pos)))
                          (not (= (position-col p) (position-col k-pos)))
                          (not (= (abs (/ (- (position-col p)
                                             (position-col k-pos))
                                          (- (position-row p)
                                             (position-row k-pos))))
                                  1)))
                     (and (= (position-row p) (position-row k-pos))
                          (= (position-col p) (position-col k-pos))))
                 (iter (cdr positions))
                 #f))
           (car positions))))
    (iter positions))
  
  (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))


  (for-each (lambda (queen)
              (p queen))
            (queens 5))

  ;; 2.43
  ;; flatmapにおけるqueen-colsの実行回数が2.42のboard-size 倍になるから速度を遅くする。
  'done)

入出力結果(Terminal(kscheme), REPL(Read, Eval, Print, Loop))

$ ksi < sample40.scm
ksi> 
2.40
((1 2) (2 3) (1 4) (3 4) (2 5) (1 6) (5 6))
2.41
((5 7 8) (5 6 9) (4 7 9) (3 8 9) (4 6 10) (3 7 10) (2 8 10) (1 9 10))
2.42
((1 1) (3 2) (5 3) (2 4) (4 5))
((1 1) (4 2) (2 3) (5 4) (3 5))
((2 1) (4 2) (1 3) (3 4) (5 5))
((2 1) (5 2) (3 3) (1 4) (4 5))
((3 1) (1 2) (4 3) (2 4) (5 5))
((3 1) (5 2) (2 3) (4 4) (1 5))
((4 1) (1 2) (3 3) (5 4) (2 5))
((4 1) (2 2) (5 3) (3 4) (1 5))
((5 1) (2 2) (4 3) (1 4) (3 5))
((5 1) (3 2) (1 3) (4 4) (2 5))
=> done
ksi> $