练习 2.29

a) left-branch 函数 和 right-branch 函数

先将题目给出的 make-mobilemake-branch 的定义敲下来:

;;; 29-make-mobile-and-make-branch.scm

(define (make-mobile left right)
    (list left right))

(define (make-branch length structure)
    (list length structure))

根据以上定义,先写出对应的 left-branchright-branch

;;; 29-left-branch-and-right-branch.scm

(define (left-branch mobile)
    (car mobile))

(define (right-branch mobile)
    (cadr mobile))

然后是对应的 branch-lengthbranch-structure

;;; 29-branch-length-and-branch-structure.scm

(define (branch-length branch)
    (car branch))

(define (branch-structure branch)
    (cadr branch))

为了使用的方便,将以上三个文件放进一个文件里面:

;;; 29-mobile-reppresent.scm

(load "29-make-mobile-and-make-branch.scm")
(load "29-left-branch-and-right-branch.scm")
(load "29-branch-length-and-branch-structure.scm")

然后进行测试:

1 ]=> (load "29-mobile-represent.scm")

;Loading "29-mobile-represent.scm"...
;  Loading "29-make-mobile-and-make-branch.scm"... done
;  Loading "29-left-branch-and-right-branch.scm"... done
;  Loading "29-branch-length-and-branch-structure.scm"... done
;... done
;Value: branch-structure

1 ]=> (define mobile (make-mobile (make-branch 10 25)
                                  (make-branch 5 20)))

;Value: mobile

1 ]=> (left-branch mobile)

;Value 11: (10 25)

1 ]=> (right-branch mobile)

;Value 12: (5 20)

1 ]=> (branch-length (right-branch mobile))

;Value: 5

1 ]=> (branch-structure (right-branch mobile))

;Value: 20

b) total-weight 函数

通过分析题目,可以得出计算一个活动体重量所需的两条规则:

  1. 对于一个活动体来说,它的总重量就是这个活动体的左右两个分支的重量之和。
  2. 对于一个分支来说,如果这个分支的 structure 部分是一个数,那么这个数就是这个分支的重量;另一方面,如果这个分支的 structure 部分指向另一个活动体,那么这个活动体的总重量就是这个分支的重量。

根据上面的两条规则,现在可以给出 total-weight 函数的定义了:

;;; 29-total-weight.scm

(load "29-left-branch-and-right-branch.scm")
(load "29-branch-length-and-branch-structure.scm")

(define (total-weight mobile)
    (+ (branch-weight (left-branch mobile))         ; 计算左右两个分支的重量之和
       (branch-weight (right-branch mobile))))

(define (branch-weight branch)
    (if (hangs-another-mobile? branch)              ; 如果分支吊着另一个活动体
        (total-weight (branch-structure branch))    ; 那么这个活动体的总重量就是这个分支的重量
        (branch-structure branch)))                 ; 否则, 分支的 structure 部分就是分支的重量

(define (hangs-another-mobile? branch)              ; 检查分支是否吊着另一个活动体
    (pair? (branch-structure branch)))

测试:

1 ]=> (load "29-mobile-represent.scm")

;Loading "29-mobile-represent.scm"...
;  Loading "29-make-mobile-and-make-branch.scm"... done
;  Loading "29-left-branch-and-right-branch.scm"... done
;  Loading "29-branch-length-and-branch-structure.scm"... done
;... done
;Value: branch-structure

1 ]=> (load "29-total-weight.scm")

;Loading "29-total-weight.scm"...
;  Loading "29-left-branch-and-right-branch.scm"... done
;  Loading "29-branch-length-and-branch-structure.scm"... done
;... done
;Value: hangs-another-mobile?

1 ]=> (define mobile (make-mobile (make-branch 10 20)       ; 活动体的总重量为 20 + 25 = 45
                                  (make-branch 10 25)))

;Value: mobile

1 ]=> (total-weight mobile)

;Value: 45

1 ]=> (define another-mobile (make-mobile (make-branch 10 mobile)   ; 左分支吊着另一个活动体,总重为 45
                                          (make-branch 10 20)))     ; 右分支的重量是 20

;Value: another-mobile

1 ]=> (total-weight another-mobile)

;Value: 65

c) 检查活动体是否平衡

一个平衡的活动体需要满足以下两个条件:

  1. 这个活动体左右两个分支的力矩相等
  2. 这个活动体左右两个分支上的所有子活动体(如果有的话)也都平衡

很明显,要判断一个活动体是否平衡,我们不仅要检查给定的活动体,还要递归地检查给定活动体的所有子活动体才行。

首先,写出计算分支力矩的程序,这要用到前面定义的 branch-weight

;;; 29-branch-torque.scm

(load "29-branch-length-and-branch-structure.scm")  ; 载入 branch-length
(load "29-total-weight.scm")                        ; 载入 branch-weight

(define (branch-torque branch)
    (* (branch-length branch)
       (branch-weight branch)))

测试力矩程序:

1 ]=> (load "29-branch-torque.scm")

;Loading "29-branch-torque.scm"...
;  Loading "29-branch-length-and-branch-structure.scm"... done
;  Loading "29-total-weight.scm"...
;    Loading "29-left-branch-and-right-branch.scm"... done
;    Loading "29-branch-length-and-branch-structure.scm"... done
;  ... done
;... done
;Value: branch-torque

1 ]=> (load "29-make-mobile-and-make-branch.scm")

;Loading "29-make-mobile-and-make-branch.scm"... done
;Value: make-branch

1 ]=> (define branch (make-branch 10 20))

;Value: branch

1 ]=> (branch-torque branch)

;Value: 200

有了力矩计算程序之后,就可以写检查平衡的程序的了:

;;; 29-mobile-balance.scm

(load "29-left-branch-and-right-branch.scm")        ; 载入 left-branch 和 right-branch
(load "29-branch-length-and-branch-structure.scm")  ; 载入 branch-structure
(load "29-branch-torque.scm")                       ; 载入 branch-torque

(define (mobile-balance? mobile)
    (let ((left (left-branch mobile))
          (right (right-branch mobile)))
        (and                                        ; 必须同时满足以下三个条件,才是平衡的活动体
            (same-torque? left right)
            (branch-balance? left)
            (branch-balance? right))))

(define (same-torque? left right)
    (= (branch-torque left)
       (branch-torque right)))

(define (branch-balance? branch)
    (if (hangs-another-mobile? branch)              ; 如果分支上有子活动体
        (mobile-balance? (branch-structure branch))  ; 那么(递归地)检查子活动体的平衡性
        #t))                                        ; 否则,返回 #t

测试:

1 ]=> (load "29-mobile-balance.scm")

;Loading "29-mobile-balance.scm"...
;  Loading "29-left-branch-and-right-branch.scm"... done
;  Loading "29-branch-length-and-branch-structure.scm"... done
;  Loading "29-branch-torque.scm"...
;    Loading "29-branch-length-and-branch-structure.scm"... done
;    Loading "29-total-weight.scm"...
;      Loading "29-left-branch-and-right-branch.scm"... done
;      Loading "29-branch-length-and-branch-structure.scm"... done
;    ... done
;  ... done
;... done
;Value: branch-balance?

1 ]=> (load "29-mobile-represent.scm")

;Loading "29-mobile-represent.scm"...
;  Loading "29-make-mobile-and-make-branch.scm"... done
;  Loading "29-left-branch-and-right-branch.scm"... done
;  Loading "29-branch-length-and-branch-structure.scm"... done
;... done
;Value: branch-structure

1 ]=> (define balance-mobile (make-mobile (make-branch 10 10)
                                          (make-branch 10 10)))

;Value: balance-mobile

1 ]=> (mobile-balance? balance-mobile)

;Value: #t

1 ]=> (define unbalance-mobile (make-mobile (make-branch 0 0)
                                            (make-branch 10 10)))

;Value: unbalance-mobile

1 ]=> (mobile-balance? unbalance-mobile)

;Value: #f

1 ]=> (define mobile-with-sub-mobile (make-mobile (make-branch 10 balance-mobile)
                                                  (make-branch 10 balance-mobile)))

;Value: mobile-with-sub-mobile

1 ]=> (mobile-balance? mobile-with-sub-mobile)

;Value: #t

d) 新的表示方式

我们的活动体程序通过实现数据抽象的方式,将程序之间的关系很好地用构造函数和选择函数隔离开了,就算 make-mobilemake-branch 这两个构造函数使用新的表示方式,我们只需修改相应的选择函数,就可以让 mobile-balance? 等程序继续运行在新表示之下。

需要修改的选择程序有 left-branchright-branchbranch-lengthbranch-structure 四个:

;;; 29-new-selector.scm

(define (left-branch mobile)
    (car mobile))

(define (right-branch mobile)
    (cdr mobile))

(define (branch-length branch)
    (car branch))

(define (branch-structure branch)
    (cdr branch))

将书本里的新构造函数也敲下来:

;;; 29-new-constructor.scm

(define (make-mobile left right)
    (cons left right))

(define (make-branch length structure)
    (cons length structure))

使用 mobile-balance? 函数来测试新的活动体表示:

1 ]=> (load "29-mobile-balance.scm")

;Loading "29-mobile-balance.scm"...
;  Loading "29-left-branch-and-right-branch.scm"... done
;  Loading "29-branch-length-and-branch-structure.scm"... done
;  Loading "29-branch-torque.scm"...
;    Loading "29-branch-length-and-branch-structure.scm"... done
;    Loading "29-total-weight.scm"...
;      Loading "29-left-branch-and-right-branch.scm"... done
;      Loading "29-branch-length-and-branch-structure.scm"... done
;    ... done
;  ... done
;... done
;Value: branch-balance?

1 ]=> (load "29-new-selector.scm")

;Loading "29-new-selector.scm"... done
;Value: branch-structure

1 ]=> (load "29-new-constructor.scm")

;Loading "29-new-constructor.scm"... done
;Value: make-branch

1 ]=> (define mobile (make-mobile (make-branch 10 20)
                                  (make-branch 10 20)))

;Value: mobile

1 ]=> mobile                        ; 确认使用的是新表示

;Value 11: ((10 . 20) 10 . 20)

1 ]=> (mobile-balance? mobile)      ; 不必修改其他程序,就可以直接使用

;Value: #t

讨论

blog comments powered by Disqus