読者です 読者をやめる 読者になる 読者になる

SICP2.53~2.58 記号データ 〜記号微分に挑む!〜

プログラミング SICP

 これまで扱ってきたデータは数値だった。これを任意の記号に拡張することで、記号微分x^2 -> 2x)なんかも可能にしようぜ!という話。

;2.53
gosh> (list 'a 'b 'c)
(a b c)
gosh> (list (list 'george))
((george))
gosh> (cdr '((x1 x2) (y1 y2)))
((y1 y2))
gosh> (car '((x1 x2) (y1 y2)))
(x1 x2)
gosh> (pair? (car '( a short list)))
#f

;リストxにitemが含まれているかどうかチェックする関数
gosh> (define (memq item x)
 (cond ((null? x) #f)
       ((eq? item (car x)) x)
       (else (memq item (cdr x)))))
memq
gosh>
(memq 'red '((red shoes) (blue socks)))
#f
gosh> (memq 'red '(red shoes blue socks))
(red shoes blue socks)

一瞬(cdr '((x1 x2) (y1 y2)))の結果にちょっと驚いてしまった。

;(list 1) == (cons 1 ()) == '(1)
;なので
gosh> (cdr '(1 2))
(2)
gosh> (cdr (cdr '(1 2)))
()
gosh> (car (cdr '(1 2)))
2
;2.54 同じ順に同じ要素が並んだリストかどうかを判定するequal?を実装せよ
gosh> (define (equal? a b)
  (cond ((and (not (pair? a)) (not (pair? b)))
         (eq? a b))
        ((and (pair? a) (pair? b))
;再帰で、最終的に全要素をアトムまで分解してeq?で判定できるよう展開する
         (and (equal? (car a) (car b)) (equal? (cdr a) (cdr b))))
        (else #f)))
equal?
gosh>
(equal? '(this is a list) '(this is a list))
#t
gosh>
(equal? '(this is a list) '(this (is a) list))
#f
;ちなみにこの定義だと数値の同一性は判定できない
;2.55
gosh> (car ''abc)
quote
;なぜquoteと返ってくるのか述べよ
;->(car (quote (quote  abc)))だから

 というわけで、2.55までは簡単に終わりました。いや〜、幸先良いですね〜。ここまでサクサクこれたんだから、きっと2.56〜2.58までも簡単に違いない〜(棒読み。
 85ページ、2.3.2 記号微分に入ります。

;これが記号微分に必要な微分規則。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))))
        (else
         (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 (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))

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

ご覧いただければわかるように、まぁ、解として間違っちゃいないけれど、非常に見苦しい。簡約していきましょう(むずい)。

(define (=number? exp num);number?じゃないので注意
 (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))))

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

 簡約されて結構わかりやすくなってきた。これを踏まえて次の問題に取りかかる。

;2.56
;exponentiation?(指数かどうかを返す)、base(基数を返す)、exponent(指数を返す)、make-exponentiation(指数を含む式を作る)を実装し、べき乗を含む式を扱えるようにderivを拡張せよ
(define (exponentiation? x)
  (and (pair? x) (eq? (car x) '**)))

(define (base s) (cadr s))

(define (exponent s) (caddr s))

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

(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) (- (exponent exp) 1)))
           (deriv (base exp) var)))
        (else
          (error "unknown expression type -- DERIV" exp))))


(deriv '(** x 2) 'x)
(* 2 x)
gosh>
(deriv '(** x 1) 'x)
1
gosh>
(deriv '(** x 0) 'x)
0

 …辛い。56でここまで厳しいとは…。57,58はいったいどうなってしまうんだ…?



〜月日は流れ〜


勉強会当日昼。
「無理」