Scheme - データによる抽象の構築(抽象データの多重表現(データ主導プログラミングと加法性(手通気の目印、型の変更)))

計算機プログラムの構造と解釈
Gerald Jay Sussman, Julie Sussman
Harold Abelson (原著) 和田 英一 (翻訳)
異なる出版社で予約受付中

開発環境

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

計算機プログラムの構造と解釈(Gerald Jay Sussman(原著)、Julie Sussman(原著)、Harold Abelson(原著)、和田 英一(翻訳)、ピアソンエデュケーション、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の2(データによる抽象の構築)、2.4(抽象データの多重表現)、2.4.3(データ主導プログラミングと加法性)、問題 2.73-d.を解いてみる。

その他参考書籍

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

問題 2.73-d.

コード(BBEdit, Emacs)

sample.scm

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

;; これまでに書いた手続き
(load "./procedures.scm")

;; 各get、put手続きのシステムの他の部分とのインターフェース箇所を修正すればいい
(define (deriv exp var)
  (cond ((number? exp) 0)
        ((varible? exp)
         (if (same-variable? exp var)
             1
             0))
        ;; 修正箇所
        (else ((get (operator exp) 'deriv)
               (operands exp)
               var))))

;; 和の微分手続きとそれをを設定するのに必要な補助プログラム
(define (install-sum-package)
  (define (deriv exp var)
    (make-sum (deriv (addend exp)
                     var)
              (deriv (augend exp)
                     var)))
  (define (make-sum a1 a2)
    (cond ((=number? a1 0) a2)
          ((=number? a2 0) a1)
          ((and (number? a1)
                (number? a2))
           (+ a1 a2))
          (else (list '+ a1 a2))))
  (define (addend e)
    (cadr e))
  (define (augend e)
    (caddr e))
  (define (=number? exp num)
    (and (number? exp)
         (= exp num)))

  ;; ;; 修正箇所
  ;; システムの他の部分とのインターフェース
  (put '+ 'deriv deriv)
  (put '+ 'make-sum make-sum)
  (put '+ '=number? =number?)
  'done)

;; 積の微分手続きとそれをを設定するのに必要な補助プログラム
(define (install-product-package)
  (define (deriv exp var)
    (make-sum
     (make-product (multiplier exp)
                   (deriv (multiplicand exp)
                          var))
     (make-product (deriv (multiplier exp)
                          var)
                   (multiplicand exp))))
  (define (make-product m1 m2)
    (cond ((or (=number? m1 0)
               (=number? m2 0))
           0)
          ((=number? m1 1) 1)
          ((=number? m2 1) 1)
          ((and (number? m1)
                (number? m2))
           (* m1 m2))
          (else (list '* m1 m2))))
  (define (multiplier p)
    (cadr p))
  (define (multiplicand p)
    (caddr p))
  (define (make-sum a1 a2)
    (cond ((=number? a1 0) a2)
          ((=number? a2 0) a1)
          ((and (number? a1)
                (number? a2))
           (+ a1 a2))
          (else (list '+ a1 a2))))
  (define (=number? exp num)
    (and (number? exp)
         (= exp num)))

  ;; 修正箇所
  ;; システムの他の部分とのインターフェース
  (put '* 'deriv deriv)
  (put '* 'make-product make-product)
  'done)

;; べき乗の微分手続きとそれをを設定するのに必要な補助プログラム
(define (install-expt-package)
  (define (deriv exp var)
    (let ((n (exponent exp))
          (u (base exp)))
      (make-product
       (make-product n
                     (make-exponetiation u
                                         (make-sum n -1)))
       (deriu var))))
  (define (exponent exp) (caddr exp))
  (define (base exp) (cadr exp))
  (define (make-product m1 m2)
    (cond ((or (=number? m1 0)
               (=number? m2 0))
           0)
          ((=number? m1 1) 1)
          ((=number? m2 1) 1)
          ((and (number? m1)
                (number? m2))
           (* m1 m2))
          (else (list '* m1 m2))))
  (define (=number? exp num)
    (and (number? exp)
         (= exp num)))

  ;; 修正箇所
  ;; システムの他の部分とのインターフェース
  (put '** 'deriv deriv)
  (put '** 'make-expt make-expt)
  'done)

;; データ主導システムに設定(get, putの実装はまだなのでコメントアウト)
;; (install-sum-package)
;; (install-product-package)
;; (install-expt-package)

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

$ ./sample.scm
$