問題2-29

二進モービル問題です。頭の中で振り子を想像しながら、問題に取り組んでいきました。
まずは、モービルから枝の要素を取得する処理と、枝から長さとそれ自身(重量か、子モービル)を取得する処理を書きました。

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

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

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

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

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

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

以下のようなモービルを作成して、実際に正しく動くかどうかを確認します。

(define x (make-mobile (make-branch 4 4)
                       (make-branch 4 4)))

(define y (make-mobile (make-branch 4
                                    (make-mobile (make-branch 5 3)
                                                 (make-branch 3 6)))
                       (make-branch 7 7)))

(define z1 (make-mobile (make-branch 7
                                     (make-mobile (make-branch 8 3)
                                                  (make-branch 6 4)))
                       (make-branch 7 7)))

(define z2 (make-mobile (make-branch 7
                                     (make-mobile (make-branch 3 3)
                                                  (make-branch 3 4)))
                        (make-branch 7 7)))

(left-branch x)
(right-branch x)
(left-branch y)
(branch-length (left-branch y))
(branch-structure (left-branch y))
(right-branch (branch-structure (left-branch y)))

=>(4 4)
=>(4 4)
=>(4 ((5 3) (3 6)))
=>4
=>((5 3) (3 6))
=>(3 6)

次は、モービル全体の重量を計測するための手続きです。

(define (total-weight mobile)
  (define (branch-weight branch)
    (if (pair? (branch-structure branch))
        (total-weight (branch-structure branch))
        (branch-structure branch)))
  (+ (branch-weight (left-branch mobile))
     (branch-weight (right-branch mobile))))

(total-weight x)
(total-weight y)
(total-weight z1)
(total-weight z2)

=>8
=>16
=>14
=>14

その次は、モービル全体が釣り合っているかどうかを判定するための手続きです。長さも考慮しなければならない、子モービルの釣り合いも考慮しなければならない、ということなので、段階的に進めてみました。最初は、「重量」が最上段で釣り合っているかどうかをテストする手続きです。

(define (branch-weight branch)
  (if (pair? (branch-structure branch))
      (total-weight (branch-structure branch))
      (branch-structure branch)))

(define (center-weight-only-balanced? mobile)
  (= (branch-weight (left-branch mobile))
     (branch-weight (right-branch mobile))))

(center-weight-only-balanced? x)
(center-weight-only-balanced? y)
(center-weight-only-balanced? z1)
(center-weight-only-balanced? z2)

=>#t
=>#f
=>#t
=>#t

枝の長さを考慮すると、以下のようになります。

(define (center-balanced? mobile)
  (define (power branch)
    (* (branch-length branch)
       (branch-weight branch)))
  (= (power (left-branch mobile))
     (power (right-branch mobile))))

(center-balanced? x)
(center-balanced? y)
(center-balanced? z1)
(center-balanced? z2)

=>#t
=>#f
=>#t
=>#t

このままでは、z2がtrueになってしまいます。しかし、z2は子モービルで釣り合いが取れていないので、そこまでチェックするようにします。

(define (balanced? mobile)
  (define (power branch)
    (* (branch-length branch)
       (branch-weight branch)))
  (define (self-balanced? mobile)
    (= (power (left-branch mobile))
       (power (right-branch mobile))))
  (define (search-branch branch)
    (if (pair? (branch-structure branch))
        (balanced? (branch-structure branch))
        #t))
  (if (self-balanced? mobile)
      (and (search-branch (left-branch mobile))
           (search-branch (right-branch mobile)))
      #f))

(balanced? x)
(balanced? y)
(balanced? z1)
(balanced? z2)

=>#t
=>#f
=>#t
=>#f

make-mobileやmake-branchの内部処理をlistではなくconsにした場合にどうなるかを試したところ、right-branchやbranch-structureの内部処理を(car (cdr x))ではなく、単にcdrと書けば同じように動きます。「抽象の壁」を上手く作れると、ちょっとした仕様変更なら修正箇所が少なくて済むことを確認することができました。