Scheme - データによる抽象の構築(階層データ構造と閉包性(階層構造(表現(構成子)の変更、選択子の変更、抽象の壁)))

計算機プログラムの構造と解釈
Gerald Jay Sussman, Julie Sussman
Harold Abelson (原著) 和田 英一 (翻訳)

開発環境

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

計算機プログラムの構造と解釈(Gerald Jay Sussman(原著)、Julie Sussman(原著)、Harold Abelson(原著)、和田 英一(翻訳)、ピアソンエデュケーション、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の2(データによる抽象の構築)、2.2(階層データ構造と閉包性)、2.2.2(階層構造)、問題 2.29-3.を解いてみる。

その他参考書籍

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

問題 2.29-3.

コード(BBEdit, Emacs)

sample.scm

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

;; これまでに書いた手続き
;; (load "./procedures.scm")

;; 二進モービルの表現をlistを使うものから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)
  (define (branch-weight branch weight)
    ((lambda (structure)
       (if (number? structure)
           (+ weight structure)
           (+ weight
              (total-weight structure))))
     (branch-structure branch)))
  (+ (branch-weight (left-branch mobile) 0)
     (branch-weight (right-branch mobile) 0)))

(define (balanced? mobile)
  (let ((left (left-branch mobile))
        (right (right-branch mobile)))
    (let ((left-length (branch-length left))
          (right-length (branch-length right))
          (left-structure (branch-structure left))
          (right-structure (branch-structure right)))
      (cond ((and (number? left-structure)
                  (number? right-structure))
             (= (* left-length left-structure)
                (* right-length right-structure)))
            ((and (number? left-structure)
                  (not (number? right-structure)))
             (and (= (* left-length left-structure)
                     (* right-length
                        (total-weight right-structure)))
                  (balanced? right-structure)))
            ((number? right-structure)
             (and (= (* left-length
                        (total-weight left-structure))
                     (* right-length right-structure))
                  (balanced? left-structure)))
            (else
             (and (= (* left-length
                        (total-weight left-structure))
                     (* right-length
                        (total-weight right-structure)))
                  (balanced? left-structure)
                  (balanced? right-structure)))))))


(define b1 (make-branch 1 2))
(define b2 (make-branch 2 1))
(define b3 (make-branch 3 4))
(define b4 (make-branch 4 3))
(define m1 (make-mobile b1 b2))
(define m2 (make-mobile b2 b1))
(define m3 (make-mobile b3 b4))
(define m4 (make-mobile b4 b3))
(define m5 (make-mobile b1 b4))
(define m6 (make-mobile b4
                        (make-branch 2
                                     (make-mobile (make-branch 20
                                                               2)
                                                  (make-branch 10
                                                               4)))))

(for-each (lambda (mobile)
            (print mobile ": " (balanced? mobile)))
          (list m1 m2 m3 m4 m5 m6))

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

$ ./sample.scm
((1 . 2) 2 . 1): #t
((2 . 1) 1 . 2): #t
((3 . 4) 4 . 3): #t
((4 . 3) 3 . 4): #t
((1 . 2) 4 . 3): #f
((4 . 3) 2 (20 . 2) 10 . 4): #t
$