先将题目给出的 make-mobile
和 make-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-branch
和 right-branch
:
;;; 29-left-branch-and-right-branch.scm
(define (left-branch mobile)
(car mobile))
(define (right-branch mobile)
(cadr mobile))
然后是对应的 branch-length
和 branch-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
通过分析题目,可以得出计算一个活动体重量所需的两条规则:
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
一个平衡的活动体需要满足以下两个条件:
很明显,要判断一个活动体是否平衡,我们不仅要检查给定的活动体,还要递归地检查给定活动体的所有子活动体才行。
首先,写出计算分支力矩的程序,这要用到前面定义的 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
我们的活动体程序通过实现数据抽象的方式,将程序之间的关系很好地用构造函数和选择函数隔离开了,就算 make-mobile
和 make-branch
这两个构造函数使用新的表示方式,我们只需修改相应的选择函数,就可以让 mobile-balance?
等程序继续运行在新表示之下。
需要修改的选择程序有 left-branch
、 right-branch
、 branch-length
和 branch-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