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.3(記号データ)、2.3.3(例: 集合の表現)、集合と情報検索、問題2.66.を取り組んでみる。

その他参考書籍

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

問題2.66.

コード(Emacs)

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

  (define (make-record k v) (cons k v))
  (define (key record) (car record))
  (define (value record) (cdr record))
  
  (define (entry tree) (car tree))
  (define (left-branch tree) (cadr tree))
  (define (right-branch tree) (caddr tree))
  (define (make-tree entry left right) (list entry left right))
  (define (element-of-set? x set)
    (if (null? set)
        #f
        ((lambda (e)
           (if (= x e)
               #t
               (if (< x e)
                   (element-of-set? x (left-branch set))
                   (element-of-set? x (right-branch set)))))
         (key (entry set)))))
  
  (define (list->tree elements)
    (car (partial-tree elements (length elements))))
  (define (tree->list tree)
    (define (copy-to-list tree result-list)
      (if (null? tree)
          result-list
          (copy-to-list (left-branch tree)
                        (cons (entry tree)
                              (copy-to-list (right-branch tree)
                                            result-list)))))
    (copy-to-list tree '()))
  
  (define (partial-tree elts n)
    (if (= n 0)
        (cons '() elts)
        ((lambda (left-size)
           ((lambda (left-result)
              ((lambda (left-tree non-left-elts right-size)
                 ((lambda (this-entry right-result)
                    ((lambda (right-tree remaining-elts)
                       (cons (make-tree this-entry left-tree right-tree)
                             remaining-elts))
                     (car right-result) (cdr right-result)))
                  (car non-left-elts) (partial-tree (cdr non-left-elts)
                                                    right-size)))
               (car left-result) (cdr left-result) (- n (+ left-size 1))))
            (partial-tree elts left-size)))
         (quotient (- n 1) 2))))
  
  (define (lookup given-key set-of-records)
    (if (null? set-of-records)
        #f
        ((lambda (e)
           ((lambda (k)
              (if (< given-key k)
                  (lookup given-key (left-branch set-of-records))
                  (if (= given-key k)
                      e
                      (lookup given-key (right-branch set-of-records)))))
            (key e)))
         (entry set-of-records))))

  (define keys '(1 3 5 7 9 11))
  (define records (list->tree
                   (map make-record
                        keys
                        '(a b c d e f))))
  (p records)
  (p (tree->list records))
  (for-each (lambda (k)
              (p (lookup k records)))
            (append keys '(2 4 6 8 10)))

  'done))

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

$ ksi < sample66.scm
ksi> 
((5 . c) ((1 . a) () ((3 . b) () ())) ((9 . e) ((7 . d) () ()) ((11 . f) () ())))
((1 . a) (3 . b) (5 . c) (7 . d) (9 . e) (11 . f))
(1 . a)
(3 . b)
(5 . c)
(7 . d)
(9 . e)
(11 . f)
#f
#f
#f
#f
#f
=> done
ksi> $