2015/10/28

# SICP 問題 2.73

``````(define (deriv exp var)
(cond ((number? exp) 0)
((variable? exp) (if (same-variable? exp var) 1 0))
(else (get 'deriv (operator exp)) (operands exp) var)))

(define (operator exp) (car exp))

(define (operands exp) (cdr exp))
``````

;; a 元のプログラムと違うのはelseの行．
operatorの型に合わせたderivが呼ばれ残りの要素を処理する．
numberとvariableはリストでないので型を持たないため，データ主導の振り分けに吸収できない．

;; b

``````(define (install-deriv-sum-package)
(define (deriv-sum exp var)
(deriv (augend exp) var)))

(define (make-sum a1 a2)
(cond ((= a1 0) a2)
((= a2 0) a1)
((and (number? a1) (number? a2)) (+ a1 a2))
(else (list '+ a1 a2))))

(if (null? (cdddr x))
(cons '+ (cddr x))))

(put 'deriv '+ deriv-sum)
(put 'make '+ make-sum)
'done)

(define (install-deriv-product-package)
(define (deriv-product exp var)
((get 'make-sum '+)
(make-product (multiplier exp)
(deriv (multiplicand exp) var))
(make-product (multiplicand exp)
(deriv (multiplier exp) var))))

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

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

(put 'deriv '* deriv-product)
(put 'make '* make-product)

'done)
``````

;; c

``````(define (install-exponent-package)
(define (deriv-exponent exp var)
(let ((make-product (get make '*)))
(make-product
(make-product (exponent x)
(make-exponentiation (base x)
(- (exponent x) 1)))
(deriv (base x) var))))

(define (make-exponent b e)
(cond ((= e 0) 1)
((= e 1) b)
((= b 0) 0)
(else (list '** b e))))

(put 'deriv '** deriv-exponent)
(put 'make '** make-exponent)
'done)
``````

;; d putの演算と型を入れ替える