Scheme - データによる抽象の構築(記号データ(例: 記号微分(前置演算子を中置きに書き換える, 演算子の優先順位, 一般化)))

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

開発環境

• OS X Yosemite - Apple (OS)
• Emacs(Text Editor)
• Scheme (プログラミング言語)
• kscheme, Gauche (処理系)

計算機プログラムの構造と解釈[第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.2(例: 記号微分)、問題2.58-b.を解いてみる。

その他参考書籍

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

問題2.58-b.

コード(Emacs)

(define (deriv exp var)
  (cond ((number? exp) 0)
        ((variable? exp)
         (if (same-variable? exp var) 1 0))
        ((sum? exp)
         (make-sum (deriv (addend exp) var)
                   (deriv (augend exp) var)))
        ((product? exp)
         (make-sum
          (make-product (multiplier exp)
                        (deriv (multiplicand exp) var))
          (make-product (deriv (multiplier exp) var)
                        (multiplicand exp))))
        ((exponentiation? exp)
         (make-product
          (make-product (exponent exp)
                        (make-exponentiation (base exp)
                                             (make-sum (exponent exp)
                                                       -1)))
          (deriv (base exp) var)))))
;; まだ、kschemeに手続き error を実装してないからコメントアウト
;; (error "unknown expression type -- DERIV" exp))))

(define (variable? x) (symbol? x))

(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))

(define (sum? x)
  (and (pair? x) (memq '+ x)))

(define (addend s)
  (define iter
    (lambda (x result)
      (let ((a (car x)))
        (if (eq? a '+)
            (if (null? (cdr result))
                (car result)
                result)
            (iter (cdr x) (cons a result))))))
  (iter s '()))

(define (augend s)
  ((lambda (x)
     (if (null? (cdr x))
         (car x)
         x))
   (cdr (memq '+ s))))

(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 (product? x)
  (and (pair? x) (memq '* x)))

(define (multiplier p)
  (define iter
    (lambda (x result)
      (let ((a (car x)))
        (if (eq? a '*)
            (if (null? (cdr result))
                (car result)
                result)
            (iter (cdr x) (cons a result))))))
  (iter p '()))


(define (multiplicand p)
  ((lambda (x)
     (if (null? (cdr x))
         (car x)
         x))
   (cdr (memq '* p))))


(define (make-product m1 m2)
  (cond ((or (=number? m1 0) (=number? m2 0)) 0)
        ((=number? m1 1) m2)
        ((=number? m2 1) m1)
        ((and (number? m1) (number? m2)) (* m1 m2))
        (else (list m1 '* m2))))

(define (=number? exp num)
  (and (number? exp) (= exp num)))

(define exponentiation?
  (lambda (exp)
    (and (pair? exp)
         (eq? (cadr exp) '**))))

(define make-exponentiation
  (lambda (base exponent)
    (cond ((=zero? exponent) 1)
          ((=one? exponent) base)
          (else (list base '** exponent)))))

(define base
  (lambda (exponentiation)
    (car exponentiation)))

(define exponent
  (lambda (exponentiation)
    (caddr exponentiation)))

(define =zero?
  (lambda (exp)
    (=number? exp 0)))

(define =one?
  (lambda (exp)
    (=number? exp 1)))

(begin (newline)
       (display (deriv '(x ** 10) 'x))
       (newline)
       (display (deriv '((5 * x) ** 10) 'x))
       (newline)
       (display (deriv '(((5 * x) + 1) ** 10) 'x))
       (newline)
       (display (deriv '(x + (3 * (x + (y + 2)))) 'x))
       (newline)
       (display (deriv '(x + 3 * (x + y + 2)) 'x))
       (newline))

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

$ kscheme < sample58_b.scm
kscm> kscm> kscm> kscm> kscm> kscm> kscm> kscm> kscm> kscm> kscm> kscm> kscm> kscm> kscm> kscm> kscm> kscm> kscm> 
(10 * (x ** 9))
((10 * ((5 * x) ** 9)) * 5)
((10 * (((5 * x) + 1) ** 9)) * 5)
4
4
#<undefined>
kscm> $