Scheme - データによる抽象の構築(階層データ構造と閉包性(階層構造))

計算機プログラムの構造と解釈[第2版]
原著

開発環境

• macOS Sierra - Apple (OS)
• Emacs (Text Editor)
• Scheme (プログラミング言語)
• kscheme (ksi)(github) (処理系)

計算機プログラムの構造と解釈[第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.25、26、27、28、29.を取り組んでみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs

問題2.25、26、27、28、29.

コード(Emacs)

(begin
  (load "procedures.scm")
  (newline)
  (define (p obj) (display obj) (newline))

  (p '2.25)
  (define list1 '(1 3 (5 7 9)))
  (define list2 '((7)))
  (define list3 '(1 (2 (3 (4 (5 (6 7)))))))

  (p (car (cdr (car (cdr (cdr list1))))))
  (p (car (car list2)))
  (p (car (cdr
           (car (cdr
                 (car (cdr
                       (car (cdr
                             (car (cdr
                                   (car (cdr list3)))))))))))))

  (p '2.26)
  (define x (list 1 2 3))
  (define y (list 4 5 6))
  (p (equal? (append x y) '(1 2 3 4 5 6)))
  (p (equal? (cons x y) '((1 2 3) 4 5 6)))
  (p (equal? (list x y) '((1 2 3) (4 5 6))))

  (p '2.27)
  (define (reverse list)
    (define (iter list result)
      (if (null? list)
          result
          (iter (cdr list) (cons (car list) result))))
    (iter list '()))

  (define (deep-reverse list)
    (define (iter list result)
      (if (null? list)
          result
          (if (list? (car list))
              (iter (cdr list) (cons (reverse (car list)) result))
              (iter (cdr list) (cons (car list) result)))))
    (iter list '()))
    
  (define x (list (list 1 2) (list 3 4)))
  (p x)
  (p (reverse x))
  (p (deep-reverse x))

  (p '2.28)
  (define (fringe  list)
    (if (null? list)
        '()
        (if (list? (car list))
            (fringe (append (car list) (cdr list)))
            (cons (car list) (fringe (cdr list))))))
    

  (define x (list (list 1 2) (list 3 4)))
  (p (fringe x))
  (p (fringe (list x x)))

  (p '2.29)
  (define (make-mobile left right)
    (list left right))
  (define (left-branch mobile) (car mobile))
  (define (right-branch mobile) (car (cdr mobile)))

  (p 'a)
  (define (make-branch length structure)
    (list length structure))
  (define (branch-length branch) (car branch))
  (define (branch-structure branch) (car (cdr branch)))

  (p 'b)
  (define (total-weight mobile)
    (+ (branch-weight (left-branch mobile))
       (branch-weight (right-branch mobile))))  
  (define (branch-weight branch)
    ((lambda (structure)
       (if (number? structure)
           structure
           (total-weight structure)))
     (branch-structure branch)))
  
  (p 'c)
  (define (torque branch)
    (* (branch-length branch)
       (branch-weight branch)))
  (define (balanced-branch? branch)
    ((lambda (structure)
       (if (number? structure)
           #t
           (balanced? structure)))
     (branch-structure branch)))
  (define (balanced? mobile)
    ((lambda (left right)
       (and (= (torque left) (torque right))
            (balanced-branch? left)
            (balanced-branch? right)))
     (left-branch mobile)
     (right-branch mobile)))

  (define mobile (make-mobile
                  (make-branch 2 (make-mobile
                                  (make-branch 20 1)
                                  (make-branch 10 2)))
                  (make-branch 2 3)))
  
  (p (balanced? mobile))

  (p 'd)
  (define (make-mobile left right)
    (cons left right))
  (define (make-branch length structure)
       (cons length structure))
  ;; 2箇所修正
  (define (right-branch mobile)
    (cdr mobile))
  (define (branch-structure branch)
    (cdr branch))

  (define mobile (make-mobile
                  (make-branch 2 (make-mobile
                                  (make-branch 20 1)
                                  (make-branch 10 2)))
                  (make-branch 2 3)))
  
  (p (balanced? mobile))

  'done)

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

$ ksi < sample24.scm
ksi> 
2.25
7
7
7
2.26
#t
#t
#t
2.27
((1 2) (3 4))
((3 4) (1 2))
((4 3) (2 1))
2.28
(1 2 3 4)
(1 2 3 4 1 2 3 4)
2.29
a
b
c
#t
d
#t
=> done
ksi> $