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

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

開発環境

• OS X Mavericks - Apple(OS)
• Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
• Scheme (プログラミング言語)
• Gauche (処理系)

計算機プログラムの構造と解釈[第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プロジェクト (著), 川合 史朗 (監修), オライリージャパン)

問題 3.27.

memo-fib手続きによりn番目のFibonacci数を計算するとき、1からnまでの各(fib i)の計算は、表に存在する場合はそれを使い、存在しない場合は計算してそれを表に追加する、すなわち、1どの計算でいいので、n番目のFibonacciはnに比例したステップ数で計算出来る。

memo-fibを単に(memoize fib)と定義した場合は、(else以降の部分がメモ化した手続きではなく、表に記録、参照をしないので、同様には働かない。

コード(BBEdit, Emacs)

table1.scm

;; -*- coding: utf-8 -*-

;; 1次元の表
(define (lookup key table)
  (let ((record (assoc key (cdr table))))
    (if record
        (cdr record)
        #f)))

(define (assoc key records)
  (cond ((null? records) #f)
        ((equal? key (caar records)) (car records))
        (else (assoc key (cdr records)))))

(define (insert! key value table)
  (let ((record (assoc key (cdr table))))
    (if record
        (set-cdr! record value)
        (set-cdr! table
                  (cons (cons key value) (cdr table)))))
  'ok)

(define (make-table)
  (list '*table*))

sample3_27.scm

#!/usr/bin/env gosh
;; -*- coding: utf-8 -*-

(load "./table1.scm")

(define (fib n)
  (cond ((= n 0) 0)
        ((= n 1) 1)
        (else (+ (fib (- n 1))
                 (fib (- n 2))))))

(define (memoize f)
  (let ((table (make-table)))
    (lambda (x)
      (print table)
      (let ((previously-computed-result (lookup x table)))
        (or previously-computed-result
            (let ((result (f x)))
              (insert! x result table)
              result))))))

(define memo-fib
  (memoize (lambda (n)
             (cond ((= n 0) 0)
                   ((= n 1) 1)
                   (else (+ (memo-fib (- n 1))
                            (memo-fib (- n 2))))))))

(define memo-fib-1 (memoize fib))

(for-each (lambda (f)
            (print f ": " (f 3)))
          (list fib memo-fib memo-fib-1))

(for-each (lambda (f)
            (print f ": " (f 10)))
          (list fib memo-fib memo-fib-1))

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

$ ./sample3_27.scm
#<closure fib>: 2
(*table*)
(*table*)
(*table*)
(*table* (1 . 1))
(*table* (2 . 1) (0 . 0) (1 . 1))
#<closure (memoize memoize)>: 2
(*table*)
#<closure (memoize memoize)>: 2
#<closure fib>: 55
(*table* (3 . 2) (2 . 1) (0 . 0) (1 . 1))
(*table* (3 . 2) (2 . 1) (0 . 0) (1 . 1))
(*table* (3 . 2) (2 . 1) (0 . 0) (1 . 1))
(*table* (3 . 2) (2 . 1) (0 . 0) (1 . 1))
(*table* (3 . 2) (2 . 1) (0 . 0) (1 . 1))
(*table* (3 . 2) (2 . 1) (0 . 0) (1 . 1))
(*table* (3 . 2) (2 . 1) (0 . 0) (1 . 1))
(*table* (3 . 2) (2 . 1) (0 . 0) (1 . 1))
(*table* (3 . 2) (2 . 1) (0 . 0) (1 . 1))
(*table* (4 . 3) (3 . 2) (2 . 1) (0 . 0) (1 . 1))
(*table* (5 . 5) (4 . 3) (3 . 2) (2 . 1) (0 . 0) (1 . 1))
(*table* (6 . 8) (5 . 5) (4 . 3) (3 . 2) (2 . 1) (0 . 0) (1 . 1))
(*table* (7 . 13) (6 . 8) (5 . 5) (4 . 3) (3 . 2) (2 . 1) (0 . 0) (1 . 1))
(*table* (8 . 21) (7 . 13) (6 . 8) (5 . 5) (4 . 3) (3 . 2) (2 . 1) (0 . 0) (1 . 1))
(*table* (9 . 34) (8 . 21) (7 . 13) (6 . 8) (5 . 5) (4 . 3) (3 . 2) (2 . 1) (0 . 0) (1 . 1))
#<closure (memoize memoize)>: 55
(*table* (3 . 2))
#<closure (memoize memoize)>: 55
$