関数型言語の勉強にSICPを読もう - (20) 2章 - データによる抽象の構築 - 2.3.2 (85-88ページ)

2.3.2 記号微分

これはなかなか面白い。サボらずに全部やってみよう。

最終目標は例えば

(deriv '(* x y) 'x)

の結果がyになること。
クォートされることから分かる通りx, yはSchemeの変数ではない。

SICPにある通り derivは variable? same-varibale? sum? addend augend make-sum product? multiplier multiplicand make-productを用いて以下のように表現できる。

(define (deriv exp var)
  (cond ((number? exp) 0) ;定数の微分は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))))

脱線するけどerror関数ってなんだろう。

gosh> (error "hage")
*** ERROR: hage
Stack Trace:

納得。

ついでに pair の理解が怪しかったので実験

(pair? 2)  ; #f
(pair? 'x) ; #f
(pair? (list 'x)) ;#t
(pair? '()) ;#f
(pair? (cons 2 3)) ;#t

もろもろの関数の定義。

(define (variable? x) (symbol? x))
(define (same-variable? v1 v2)
  (and (variable? v1) (variable? v2) (eq? v1 v2)))
(define (make-sum a1 a2) (list '+ a1 a2)) ; なるほど！
(define (make-product m1 m2) (list '* m1 m2))
(define (sum? x)
  (and (pair? x) (eq? (car x) '+)))
(define (addend s) (cadr s))
(define (augend s) (caddr s))
(define (product? x)
  (and (pair? x) (eq? (car x) '*)))
(define (multiplier p) (cadr p))
(define (multiplicand p) (caddr p))

最初 productを↓のように打ち間違えていたんだけどすぐ気づいた。こういう小さな進歩がとてもうれしいな。

(define (product? x)
  (and (pair? x) (eq? (cdar x) '*)))

さて実験

(deriv '(+ x 3) 'x)
gosh> (+ 1 0)
(deriv '(* x x) 'x)
gosh> (+ (* x 1) (* 1 x))

SICPにもあるように簡約化されていないのがうれしくない。
ここでderivでなくてmake-sum, make-productをいじるってのがポイントらしい。

(define (=number? exp num)
  (and (number? exp) (= exp num)))
(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 (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))))

(use slib)
(require 'trace)
(trace deriv)
(trace make-product)
(trace make-sum)
(trace product?)
(deriv '(+ x 3) 'x)
gosh<1
(deriv '(* 3 (+ x 3)) 'x)
gosh<(+ 3 (* 0 (+ x 3)))
(deriv '(* x x) 'x)
gosh<(+ x (* 1 x))

問題2.56

ここまでSICPに書いてあるコードを手打ちしていただけですが、それの理解度を試す問題です。
自分はあまり頭がよくないのでコードを打ちこんでおき、感じを掴んでおかないとぱっとは解けないです。（読むだけで理解できる人がうらやましい）

(define (make-exponent a b)
  (cond ((=number? b 0) 1)
        ((=number? a 1) 1)
        (else (list '** a b))))
(define (exponention? e)
  (and (pair? e) (eq? (car e) '**)))

(define (base e)
  (cadr e))
(define (exponent e)
  (caddr e))

を用意してあげて deriv を拡張します。

(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))))
        ((exponention? exp)
         (let ((a (base exp))
               (b (exponent exp)))
         (make-product (make-product b (make-exponent a (- b 1))) (deriv a var))))
        (else
         (error "unknown expression type -- DERIV" exp))))

letを無理矢理使ってみるテスト。

結果は

(deriv '(** x 5) 'x)
gosh>(* 5 (** x 4))

できた。

問題2.57

これはあれですよ、任意個の引数をとるあれですね。

(define (make-sum a1 a2 . a)
  (define (make-sum-local x y)
    (if (null? y)
        x
        (cond ((=number? x 0) y)
              ((=number? y 0) x)
              ((and (number? x) (number? y)) (+ x y))
              (else (list '+ x y)))))
  (make-sum-local (make-sum-local a1 a2) (car a)))

(define (make-product m1 m2 . m)
  (define (make-product-local x y)
    (if (null? y)
        x
        (cond ((or (=number? x 0) (=number? y 0)) 0)
              ((=number? x 1) y)
              ((=number? y 1) x)
              ((and (number? x) (number? y)) (* x y))
              (else (list '* x y)))))
  (make-product-local (make-product-local m1 m2) (car m)))

(deriv '(* x x x) 'x)
(deriv '(* x y (+ x 3)) 'x)

と思って解答見たら

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

(define (multiplicand p)
  (if (null? (cdddr p))
      (caddr p)
      (cons '* (cddr p))))

おっと。そういう意図なのか。うーん。
ダメだ何が正解で自分のアプローチがどうなの？とかが分からなくなってきた。

※「SICPを読もう」の目次はこちら