理系学生日記

おまえはいつまで学生気分なのか

問題2-29

a

(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)
  (car (cdr mobile)))
(define (branch-length branch)
  (car branch))
(define (branch-structure branch)
  (car (cdr branch)))

b

木構造もどきの重さの和を計算する。

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

c

木構造もどきのトルクがつりあってたらtrueです。
プログラムかいててワケわかんなくなってきた。もっとキレイにかけるはずなんだけど。

(define (balanced? mobile)
  (define (calc-torque branch)
    (let ((structure (branch-structure branch)))
      (if (pair? structure)
	  (* (total-weight (branch-structure branch))
	     (branch-length branch))
	  (* structure
	     (branch-length branch)))))
  (define (balanced-mobile? m)
    (if (pair? m)
	(if (= (calc-torque (left-branch m))
	       (calc-torque (right-branch m)))
	    #t #f)
    #t))
  (let ((lb (left-branch mobile))
	(rb (right-branch mobile)))
    (and (balanced-mobile? mobile)
	 (if (pair? (branch-structure lb))
	     (balanced? (branch-structure lb))
	     #t)
	 (if (pair? (branch-structure rb))
	     (balanced? (branch-structure rb))
	     #t))))

d

こんなへんこう。

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