Scheme - 標準部品化力、オブジェクトおよび状態(可変データのモデル化(表の表現(局所表の作り方(メモ化(memorization), テーブル化(tabulation)))))

計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著) ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著) Julie Sussman (原著)
Gerald Jay Sussman (原著) 和田 英一 (翻訳)

開発環境

• OS X El Capitan - Apple (OS)
• Emacs(Text Editor)
• Scheme (プログラミング言語)
• kscheme (github) (処理系)

計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の第3章(標準部品化力、オブジェクトおよび状態)、3.3(可変データのモデル化)、3.3.3(表の表現)、局所表の作り方、問題3.27.を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
• プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)
• Scheme手習い

問題3.27.

コード(Emacs)

(begin
  (define (print obj)
    (display obj)
    (newline))

  ;; ((key . value) left right)
  (define (make-table)
    (let ((local-table '()))
      (define (make-tree record left right) (list record left right))
      (define (key tree) (caar tree))
      (define (value tree) (cdar tree))
      (define (left-branch tree) (cadr tree))
      (define (right-branch tree) (caddr tree))
      (define (lookup-iter k tree)
        (cond ((null? tree) #f)
              ((= k (key tree)) (value tree))
              ((< k (key tree)) (lookup-iter k (left-branch tree)))
              (else (lookup-iter k (right-branch tree)))))
      (define (lookup k) (lookup-iter k local-table))
      (define (insert-iter! k v tree)
        (cond ((eq? tree '())
               (set! local-table (make-tree (cons k v) '() '()))
               'done)
              ((= k (key tree)) (set-cdr! (car tree) v)
               'done)
              ((< k (key tree))
               (if (null? (left-branch tree))
                   (set-car! (cdr tree) (make-tree (cons k v) '() '()))
                   (insert-iter! k v (left-branch tree)))
               'done)
              (else
               (if (null? (right-branch tree))
                   (set-car! (cddr tree) (make-tree (cons k v) '() '()))
                   (insert-iter! k v (right-branch tree)))
               'done)))
      (define (insert! k value) (insert-iter! k value local-table))
      (define (dispatch m)
        (cond ((eq? m 'lookup-proc) lookup)
              ((eq? m 'insert-proc!) insert!)
              (else (display "Unknown operation -- TABLE ")
                    (print m))))
      dispatch))

  (define *count* 0)
  (define (memorize f)
    (let ((table (make-table)))
      (lambda (x)
        (let ((previously-computed-result ((table 'lookup-proc) x)))
          (or previously-computed-result
              (let ((result (f x)))
                ((table 'insert-proc!) x result)
                result))))))
  
  (define (fib n)    
    (begin (set! *count* (+ *count* 1))
           (cond ((= n 0) 0)
                 ((= n 1) 1)
                 (else (+ (fib (- n 1))
                          (fib (- n 2)))))))
  (define memo-fib
    (memorize (lambda (n)
                (begin (set! *count* (+ *count* 1))
                       (cond ((= n 0) 0)
                             ((= n 1) 1)
                             (else (+ (memo-fib (- n 1))
                                      (memo-fib (- n 2)))))))))
  
  ;; うまく働かない(fib が再帰的に呼び出されることになりメモ化が働かない)
  (define memo-fib1 (memorize fib))
  (define (print-result x)
    (begin (display "result: ")
           (display x)
           (display ", count: ")
           (print *count*)
           (set! *count* 0)))
  (print-result (fib 10))
  (print-result (memo-fib 10))
  (print-result (memo-fib1 10))
  )

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

$ ./kscheme sample27.scm
result: 55, count: 177
result: 55, count: 11
result: 55, count: 177
$