Scheme - データによる抽象の構築(階層データ構造と閉包性(階層構造(二進モービル, 回転力, 釣り合い)))

計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著) ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著) Julie Sussman (原著)
Gerald Jay Sussman (原著) 和田 英一 (翻訳)

開発環境

• OS X Yosemite - Apple (OS)
• Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
• Scheme (プログラミング言語)
• kscheme, Gauche (処理系)

計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の2(データによる抽象の構築)、2.2(階層データ構造と閉包性)、2.2.2(階層構造)、問題2.29-c.を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
• プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)
• Scheme手習い

問題2.29-c.

コード(BBEdit, Emacs)

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

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

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

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

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

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

(define total-weight
  (lambda (mobile)
    (+ (branch-weight (left-branch mobile))
       (branch-weight (right-branch mobile)))))

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

(define balanced?
  (lambda (mobile)
    (let ((branch-left (left-branch mobile))
          (branch-right (right-branch mobile)))
      (let ((branch-left-structure (branch-structure branch-left))
            (branch-right-structure (branch-structure branch-right)))
        (and (= (* (branch-length branch-left)
                   (branch-weight branch-left))
                (* (branch-length branch-right)
                   (branch-weight branch-right)))
             (if (pair? branch-left-structure)
                 (balanced? branch-left-structure)
                 #t)
             (if (pair? branch-right-structure)
                 (balanced? branch-right-structure)
                 #t))))))



(define branch1 (make-branch 1 20))
(define branch2 (make-branch 2 10))

(define mobile1 (make-mobile branch1 branch2))

(define branch3 (make-branch 1 mobile1))
(define branch4 (make-branch 1 30))

(define mobile2 (make-mobile branch3 branch4))
(define mobile3 (make-mobile branch1 branch4))
(begin (display branch1)
       (newline)
       (display branch2)
       (newline)
       (display mobile1)       
       (newline)
       (display (balanced? mobile1))
       (newline)
       (display branch3)
       (newline)
       (display branch4)
       (newline)
       (display mobile2)
       (newline)
       (display (balanced? mobile2))
       (newline)
       (display branch1)
       (newline)
       (display branch4)
       (newline)
       (display mobile3)
       (newline)
       (display (balanced? mobile3))
       (newline))
       

入出力結果(Terminal(kscheme), REPL(Read, Eval, Print, Loop))

$ gosh sample29_c.scm
(1 20)
(2 10)
((1 20) (2 10))
#t
(1 ((1 20) (2 10)))
(1 30)
((1 ((1 20) (2 10))) (1 30))
#t
(1 20)
(1 30)
((1 20) (1 30))
#f
$