SICP-Refresher-Chapter-2(4)

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61

;; a

;; 数字和符号是 scheme 的基本元素，有语言内置的过程可以识别和区分；而且区分之后
;; 直接返回数值，并不需要过程计算（如果一定要全部都使用表格分发也行，但改动较多
;; 且无必要）；

;; b & c

;;其余过程和 3.3.2 实例及乘幂求导练习一致
(define (addend s) (car s))

(define (augend s)
  (if (null? (cdr s))
      0
      (cons '+ (cdr s))))

(define (multiplier p) (car p))

(define (multiplicand p)
  (if (null? (cdr p))
      1
      (cons '* (cdr p))))

(define (exponent x)
  (cadr x))

(define (base x)
  (car x))

(define (deriv-product operands var)
  (make-sum
   (make-product (multiplier operands)
		 (deriv (multiplicand operands) var))
   (make-product (deriv (multiplier operands) var)
		 (multiplicand operands))))

(define (deriv-sum operands var)
  (make-sum (deriv (addend operands) var)
	    (deriv (augend operands) var)))

(define (deriv-exponentiation operands var)
  (make-product (exponent operands)
		(make-product
		 (make-exponentiation
		  (base operands)
		  (make-sum (exponent operands) (- 1)))
		 (deriv (base operands) var))))

;; install

(define (install-deriv-package)
  (put 'deriv '* deriv-product)
  (put 'deriv '+ deriv-sum)
  (put 'deriv '** deriv-exponentiation))

;; d

(define (install-deriv-package)
  (put '* 'deriv deriv-product)
  (put '+ 'deriv deriv-sum)
  (put '** 'deriv deriv-exponentiation))

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35

;; 以前自己的解答，就不翻译了
;; a

(define (get-record name file)
  ((get 'get-record (tag file)) name (contents file)))

;; file (cons tag (cons name record) ... ) or some other structures
;; (put 'get-record the-exact-tag the-exact-get-record-procedure)


;; b

(define (get-salary name file)
  (let ((record (get-record name file)))
    ((get 'get-salary (tag record)) (contents record))))

;; record (cons tag salary-content ...) or some other structures
;; put behaves like a


;; c

(define (find-employee-record name file-list)
  (define (iter file-list result)
    (cond ((null? file-list) result)
	  ((null? (get-record name (car file-list)))
	   (iter (cdr file-list) result))
	  (else (iter (cdr file-list) (cons (get-record name (car file-list)) results)))))
  (iter file-list '()))


;; d

;; if possible, give new and uniq#+HUGO_TAGS to this file and its certain records
;; with the procedure 'put' and n#+HUGO_TAGS, install the corresponding procedures

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11

(define (make-from-mag-ang x y)
  (define (dispatch op)
    (cond ((eq? op 'magnitude) x)
	  ((eq? op 'angle) y)
	  ((eq? op 'real-part)
	   (* x (cos y)))
	  ((eq? op 'imag-part)
	   (* x (sin y)))
	  (else
	   (error "Unknown op -- MAKE-FROM-MAG-ANG" op))))
  dispatch)

1
2
3
4
5
6

;; 带有显式分派的通用型操作在加入一个新类型或者新操作时对代码的改动较大，带来不
;; 便，容易引进错误

;; 消息传递更适合用于需要经常加入新的数据对象类型的系统；

;; 数据导向更适合用于需要经常加入新的操作的系统（存疑，经常加入新的操作的话，使用消息传递风格并不会更麻烦）；