計算機プログラムの構造と解釈 第二版 P63 問題2.29

二進モービルの問題。

ググってもこんなのしか出てこない。
http://d.hatena.ne.jp/nTeTs/20090716
ヒャッハーとか言ってるので、id:nTeTsにはトラックの免許を上げた方がいい。
もし俺が国王であったら、彼にのみトラックの免許をあたえて、
すっかすかの環八で、トラックの荷台？無しで400km/hで爆走していただく。

でも図的には大体こんな感じらしい。

wikipedia モビール
http://ja.wikipedia.org/wiki/%E3%83%A2%E3%83%93%E3%83%BC%E3%83%AB

んでそう、この問題は問題を箇条書きにしてるので題意とかもかかない。

dの問題は、

(cdr (car ...

みたいな部分を

(cdr ..

に書き換えるだけでオッケーだ。

実装

#!/usr/local/bin/gosh
;; -*- coding: utf-8 -*-

(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)))


;; cons ヴァージョン
;(define (make-mobile left right)
;  (cons left right))

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

 
;(define (left-branch mobile)
;  (car mobile))
 
;(define (right-branch mobile)
;  (cdr mobile))
 
;(define (branch-length branch)
;  (car branch))
 
;(define (branch-structure branch)
;  (cdr branch))

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

(define (balanced? mobile)
  (if (not (pair? mobile)) #t
    (if (= (* (branch-length (left-branch mobile)) (total-weight (branch-structure (left-branch mobile))))
           (* (branch-length (right-branch mobile)) (total-weight (branch-structure (right-branch mobile)))))
      (if (balanced? (branch-structure (left-branch mobile)))
        (if (balanced? (branch-structure (right-branch mobile))) #t
          #f)
        #f)
      #f)))


(define my-branch0 (make-branch 1 1))
(define my-branch1 (make-branch 1 10))
(define my-branch2 (make-branch 2 5))
(define my-branch3 (make-branch 1 (make-mobile my-branch1 my-branch2)))


(define my-mobile0 (make-mobile (make-branch 1 5) (make-branch 1 5)))
(define my-mobile1 (make-mobile my-branch0 (make-branch 1 5)))
(define my-mobile2 (make-mobile my-branch3 my-branch3))

;; main
(define (main args)

  (display "my-mobile0の全体の重さは10")
  (newline)
  (display "(total-weight my-mobile0): ")
  (display (total-weight my-mobile0))
  (newline)

  (display "my-mobile1の全体の重さは6")
  (newline)
  (display "(total-weight my-mobile1): ")
  (display (total-weight my-mobile1))
  (newline)

  (display "my-mobile2の全体の重さは30")
  (newline)
  (display "(total-weight my-mobile2): ")
  (display (total-weight my-mobile2))
  (newline)

  (newline)

  (display "my-mobile0は釣り合ってる。")
  (newline)
  (display "(balanced? my-mobile0): ")
  (display (balanced? my-mobile0))
  (newline)

  (display "my-mobile1は釣り合ってない。")
  (newline)
  (display "(balanced? my-mobile1): ")
  (display (balanced? my-mobile1))
  (newline)

  (display "my-mobile2は釣り合ってる。")
  (newline)
  (display "(balanced? my-mobile2): ")
  (display (balanced? my-mobile2))
  (newline)

 0)

実効

my-mobile0の全体の重さは10
(total-weight my-mobile0): 10
my-mobile1の全体の重さは6
(total-weight my-mobile1): 6
my-mobile2の全体の重さは30
(total-weight my-mobile2): 30

my-mobile0は釣り合ってる。
(balanced? my-mobile0): #t
my-mobile1は釣り合ってない。
(balanced? my-mobile1): #f
my-mobile2は釣り合ってる。
(balanced? my-mobile2): #t

よしっ！