乐正

Actions speak louder than words.

Sicp-ex3-37

问题

与下面更具表达式风格的定义相比,过程celsius-fahrenheit-converter显得过于麻烦了:

1
2
3
4
5
6
7
(define (celsius-fahrenheit-converter x)
  (c+ (c* (c/ (cv 9) (cv5))
           x)
      (cv 32)))

(define C (make-connector))
(define F (celsius-fahrenheit-converter C))

这里的c+c*等等是算术运算的“约束版”。例如,c+以两个连接器作为参数,返回另一个连接器,它与那两个连接器具有加法约束:

1
2
3
4
(define (c+ x y)
  (let ((z (make-connector)))
    (adder x y z)
    z))

请定义模拟过程c-c*c/cv(常量值),使我们可以利用它们定义出各种复合约束,就像前面有关反门的例子。

解答

练习3.37 (ex3-37.scm) download
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
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
(define (c+ x y)
  (let ((z (make-connector)))
    (adder x y z)
    z))

(define (c- x y)
  (let ((z (make-connector)))
    (subtracer x y z)
    z))

(define (c* m1 m2)
  (let ((prod (make-connector)))
    (multiplier m1 m2 prod)
    prod))

(define (cv value)
  (let ((connector (make-connector)))
    (constant value connector)
    connector))

(define (c/ d1 d2)
  (let ((value (make-connector)))
    (divider d1 d2 value)
    value))

(define (subtracer x y z)
  (define (proccess-new-value)
    (cond ((and (has-value? x) (has-value? y))
           (set-value! z
                       (- (get-value x) (get-value y))
                       me))
          ((and (has-value? x) (has-value? z))
           (set-value! y
                       (- (get-value x) (get-value z))
                       me))
          ((and (has-value? y) (has-value? z))
           (set-value! x
                       (+ (get-value z) (get-value y))
                       me))))
  (define (process-forget-value)
    (forget-value! x me)
    (forget-value! y me)
    (forget-value! z me)
    (proccess-new-value))
  (define (me request)
    (cond ((eq? request 'I-have-a-value)
           (proccess-new-value))
          ((eq? request 'I-lost-my-value)
           (process-forget-value))
          (else (error "Unknown request -- ADDER" request))))
  (connect x me)
  (connect y me)
  (connect z me)
  me)

(define (divider d1 d2 value)
  (define (process-new-value)
    (cond ((and (and (has-value? d1) (has-value? d2))
                (= (get-value d1) 0))
           (set-value! value 0 me))
          ((and (and (has-value? d1) (has-value? d2))
                (= (get-value d2) 0))
           (error "Dividend value 0" (get-value d2)))
          ((and (has-value? d1) (has-value? d2))
           (set-value! value
                       (/ (get-value d1)
                          (get-value d2))
                       me))
          ((and (has-value? d1) (has-value? value))
           (set-value! d2
                       (/ (get-value value)
                          (get-value d1))
                       me))
          ((and (has-value? d2) (has-value? value))
           (set-value! d1
                       (/ (get-value value)
                          (get-value d2))
                       me))))
  (define (process-forget-value)
    (forget-value! d1 me)
    (forget-value! d2 me)
    (forget-value! value me)
    (process-new-value))
  (define (me request)
    (cond ((eq? request 'I-have-a-value)
           (process-new-value))
          ((eq? request 'I-lost-my-value)
           (process-forget-value))
          (else (error "Unknown request -- Divider" request))))
  (connect d1 me)
  (connect d2 me)
  (connect value me)
  me)

测试

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
(probe "Celsius temp: " C)
$12 = #<procedure me (request)>

(probe "Fahrenheit temp: " F)
$13 = #<procedure me (request)>

(set-value! C 14 'user)
Probe: Celsius temp:  = 14
Probe: Fahrenheit temp:  = 286/5
$14 = done

(forget-value! C 'user)
Probe: Celsius temp:  = ?
Probe: Fahrenheit temp:  = ?
$15 = done

(set-value! C 0 'user)
Probe: Celsius temp:  = 0
Probe: Fahrenheit temp:  = 32
$16 = done

(forget-value! C 'user)
Probe: Celsius temp:  = ?
Probe: Fahrenheit temp:  = ?
$17 = done

(set-value! F 32 'user)
Probe: Fahrenheit temp:  = 32
Probe: Celsius temp:  = 0
$18 = done

draft

« sicp-ex3-36 sicp-ex3-38 »

Comments