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.3(記号データ)、2.3.2(例: 記号微分)、問題 2.58-b.を解いてみる。

その他参考書籍

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

問題 2.58-b.

コード(BBEdit, Emacs)

sample.scm

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

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

(define (make-sum . items)
  (define (iter items result)
    (cond ((null? (cdr items))
           (if (=number? (car items)
                         0)
               (cond ((null? result)
                      0)
                     ((null? (cddr result))
                      (cadr result))
                     (else
                      (cdr result)))
               (if (null? result)
                   (car items)
                   (cons (car items)
                         result))))
          ((=number? (car items)
                     0)
           (iter (cdr items)
                 result))
          (else
           (iter (cdr items)
                 (cons '+
                       (cons (car items)
                             result))))))
  (iter items '()))

(define (addend s)
  (define (iter s result)
    (if (eq? (cadr s)
             '+)
        (if (null? result)
            (car s)
            (cons (car s)
                  result))
        (iter (cddr s)
              (cons (cadr s)
                    (cons (car s)
                          result)))))
  (iter s '()))

(define (augend s)
  (if (eq? (cadr s)
           '+)
      (if (null? (cdddr s))
          (caddr s)
          (cddr s))
      (augend (cddr s))))

(define (sum? x)
  (and (pair? x)
       (or (eq? (cadr x)
                '+)
           (and (not (null? (cdddr x)))
                (sum? (cddr x))))))

(define (make-product . items)
  (define (iter items result)
    (cond ((=number? (car items)
                     0)
           0)
          ((null? (cdr items))
           (if (=number? (car items)
                         1)
               (cond ((null? result)
                      1)
                     ((null? (cddr result))
                      (cadr result))
                     (else result))
               (if (null? result)
                   (car items)
                   (cons (car items)
                         result))))
          (else
           (iter (cdr items)
                 (cons '*
                       (cons (car items)
                             result))))))
  (iter items '()))

(define (multiplier p) (car p))

(define (multiplicand p)
  (if (eq? (cadr p)
           '*)
      (cond ((null? (cdddr p))
             (caddr p))
            ((not (sum? (cddr p)))
             (cddr p))
            (else
             (multiplicand (cddr p))))
      (multiplicand (cddr p))))

(define (product? x)
  (and (not (sum? x))
       (pair? x)
       (or (eq? (cadr x)
                '*)
           (and (not (null? (cdddr x)))
                (product? (cddr x))))))

(define (make-exponentiation b e)
  (cond ((=number? e 0) 1)
        ((=number? e 1) b)
        (else
         (list b '** e))))

(define (base exp) (car exp))

(define (exponent exp) (caddr exp))

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

(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))))
        (else
         (error "unknown expression type -- DERIV" #?=exp))))

(for-each (lambda (exp)
            (print "(derive " exp " x) = "
                   (deriv exp 'x)))
          (list '(x + 3)
                '(x * y)
                '((x * y) * (x + 3))
                '(x + (3 * (x + (y + 2))))
                '(x + 3 * (x + y + 2))))

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

 ./sample.scm
(derive (x + 3) x) = 1
(derive (x * y) x) = (y * 1)
(derive ((x * y) * (x + 3)) x) = (((x + 3) * (y * 1)) + (x * y))
(derive (x + (3 * (x + (y + 2)))) x) = (3 + 1)
(derive (x + 3 * (x + y + 2)) x) = (3 + 1)
$