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) (make-sum (deriv (addend 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)))) (define (addend x) (cadr x)) (define (augend x) (caddr x) (if (null? (cdddr x)) (caddr 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 (multiplier x) (cadr x)) (define (multiplicand x) (if (null? (cdddr x)) (caddr 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 (exponent x) (cadr x)) (define (base x) (caddr x)) (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の演算と型を入れ替える