Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
161 lines (141 sloc) 5.31 KB

a)

这题问的是为什么不能将相近的谓词number?same-variable?也加入到数据分派中。

那么我们假设能加入数据分派中,那么就是下面的情况:

           +   |  *   | number? | same-variable |
        +---------------------------------------+
  deriv |  op1 | op2  |   op3   |      op4      |
        +---------------------------------------+
         
                   求导系统的操作表

很明显,上面这个操作表是不合理的,因为number?same-variable?并不是一种数据类型。

另一种角度,如果exp是一个numbervariable的话,我们无法对其使用operatoroperands函数,所以无法将number?same-variable?也加入到数据分派中。

b)

(load "lib/deriv.scm")
(load "lib/complex_number.scm")
(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))

(define (install-add-package)
  (define (make-sum a1 a2)
    (list '+ a1 a2))
  (define (sum? x)
    (and (pair? x) (eq? (cadr x) '+)))
  (define (addend s) (caddr s))
  (define (augend s) (cadr s))
  (define (deriv_inner exp var)
    (make-sum (deriv (addend exp) var)
              (deriv (augend exp) var)))
  ;与外界交互的接口
  (define (tag x) (attach-tag '+ x))
  (put 'deriv '+ deriv_inner)
  (put 'make-sum '+ 
    (lambda (x y) (tag (make-sum x y)))))


(define (install-product-package)
  (define (make-product m1 m2)
    (list '* m1 m2))  
  (define (product? x)
    (and (pair? x) (eq? (cadr x) '*)))
  (define (multiplier p) (caddr p))  
  (define (multiplicand p) (cadr p))
  (define (deriv_inner exp var)
    (make-sum
      (make-product (multiplier exp)
                    (deriv (multiplicand exp) var))
      (make-product (multiplicand exp)
                    (deriv (multiplier exp) var))))

  ;与外界交互的接口
  (define (tag x) (attach-tag '* x))
  (put 'deriv '* deriv_inner)
  (put 'make-product '*
    (lambda (m1 m2) (tag (make-product m1 m2)))))

(install-add-package)
(install-product-package)
; 定义两个构造函数
(define (make-sum a1 a2)
  ((get 'make-sum '+) a1 a2))
(define (make-product m1 m2)
  ((get 'make-product '*) m1 m2))

(deriv (make-sum 'x 'x) 'x)
;Value: (+ 1 1)
(deriv (make-product 'x 'y) 'x)
;Value: (+ + (* y 1) (* x 0))  这里的第一个+为tag

上面这种做法是我第一次做的,感觉有些别扭,尤其是乘法的那个demo,后来在网上找到另一种思路,不再单独构造add与product的package,而是直接构造一个deriv的package。这种方式貌似更贴近题意,因为题目b)要求我们写出针对和式与积式的求导过程,但是这种方式在增加一个新类型时,需要修改这个package,貌似达不到数据抽象的目的了,因为基于数据导向的程序设计思想就是,增加新类型时,不改变之前代码,更多解释,可参考练习2.76。Anyway,我这里还是贴出来,供大家参考。

(define (install-deriv-package)
  (define (=number? exp num)
    (and (number? exp) (= exp num))) 

  ; sum
  (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 (addend opds) (car opds))
  (define (augend opds) (cadr opds))
  (define (deriv-sum opds var)
    (make-sum (deriv (addend opds) var)
              (deriv (augend opds) var)))

  ; product
  (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))))
  (define (multiplier opds) (car opds))
  (define (multiplicand opds) (cadr opds))
  (define (deriv-product opds var) 
    (make-sum 
     (make-product (multiplier opds)
                   (deriv (multiplicand opds) var))
     (make-product (deriv (multiplier opds) var)
                   (multiplicand opds))))
  ; exponentiation
  (define (make-exponentiation base exp)
    (cond ((=number? exp 0) 1)
          ((=number? exp 1) base)
          (else (list '** base exp))))
  (define (base opds) (car opds))
  (define (exponent opds) (cadr opds))
  (define (deriv-exponentation opds var)
    (make-product
     (exponent opds)
     (make-product
      (make-exponentiation (base opds)
                           (make-sum (exponent opds) (- 1)))
      (deriv (base opds) var))))

  ;; interface
  (put 'deriv '+ deriv-sum)
  (put 'deriv '* deriv-product)
  (put 'deriv '** deriv-exponentation) 
  'done)

(install-deriv-package)
(deriv '(+ (* 3 x) y) 'x)
;Value: 3
(deriv '(* x y) 'x)
;Value: y
(deriv '(** x n) 'x)
;Value 25: (* n (** x (+ n -1)))

c)

增加新类型(也就是表达式类型)的求导运算,增加相应的install-*-package过程即可,这里省略。

d)

如果deriv里面改成如下形式

((get (operator exp) 'deriv) (operands exp) var)

我们只需要在我们的install-*-package过程中更改put的顺序即可。

(put '* 'deriv add-deriv)
(put '+ 'deriv product-deriv)