開発環境
- OS X Lion - Apple(OS)
- Emacs、BBEdit - Bare Bones Software, Inc. (Text Editor)
- プログラミング言語: MIT/GNU Scheme
計算機プログラムの構造と解釈(Gerald Jay Sussman(原著)、Julie Sussman(原著)、Harold Abelson(原著)、和田 英一(翻訳)、ピアソンエデュケーション)の2(データによる抽象の構築)、2.3(記号データ)、2.3.3(例: 集合の表現)、二進木としての集合の問題 2.65を解いてみる。
その他参考書籍
問題 2.65
コード
sample.scm
(define (entry tree) (car tree))
(define (left-branch tree) (cadr tree))
(define (right-branch tree) (caddr tree))
(define (make-tree entry left right)
(list entry left right))
(define (list->tree elements)
(car (partial-tree elements (length elements))))
(define (partial-tree elts n)
(if (= n 0)
(cons '() elts)
(let ((left-size (quotient (- n 1) 2)))
(let ((left-result (partial-tree elts left-size)))
(let ((left-tree (car left-result)))
(let ((left-tree (car left-result))
(non-left-elts (cdr left-result))
(right-size (- n (+ left-size 1))))
(let ((this-entry (car non-left-elts))
(right-result (partial-tree (cdr non-left-elts)
right-size)))
(let ((right-tree (car right-result))
(remaining-elts (cdr right-result)))
(cons (make-tree this-entry left-tree right-tree)
remaining-elts)))))))))
(define (tree->list tree)
(define (copy-to-list tree result-list)
(if (null? tree)
result-list
(copy-to-list (left-branch tree)
(cons (entry tree)
(copy-to-list (right-branch tree)
result-list)))))
(copy-to-list tree '()))
(define (union-set-list set1 set2)
(cond ((null? set1) set2)
((null? set2) set1)
(else (let ((x1 (car set1))
(x2 (car set2)))
(cond ((= x1 x2) (union-set-list (cdr set1) set2))
((< x1 x2) (cons x1
(union-set-list (cdr set1) set2)))
(else (cons x2 (union-set-list set1 (cdr set2)))))))))
(define (intersection-set-list set1 set2)
(if (or (null? set1) (null? set2))
'()
(let ((x1 (car set1)) (x2 (car set2)))
(cond ((= x1 x2)
(cons x1
(intersection-set-list (cdr set1)
(cdr set2))))
((< x1 x2)
(intersection-set-list (cdr set1) set2))
((< x2 x1)
(intersection-set-list set1 (cdr set2)))))))
(define (union-set set1 set2)
(let ((list1 (tree->list set1))
(list2 (tree->list set2)))
(let ((set-list (union-set-list list1 list2)))
(list->tree set-list))))
(define (intersection-set set1 set2)
(let ((list1 (tree->list set1))
(list2 (tree->list set2)))
(let ((set-list (intersection-set-list list1 list2)))
(list->tree set-list))))
; テスト
(define set0-list '())
(define set-list (list 1 2 3 4 5 6 7 8 9 10))
(define even-set-list (list 2 4 6 8 10))
(define odd-set-list (list 1 3 5 7 9))
(define sets-list (list set0-list set-list even-set-list odd-set-list)))
(define (union-test items)
(if (null? items)
0
(let ((set-list (car items)))
(for-each (lambda (items)
(newline)
(display set-list)
(display " union ")
(display items)
(display " = ")
(display (tree->list (union-set (list->tree set-list)
(list->tree items)))))
sets-list)
(union-test (cdr items)))))
(define (intersection-test items)
(if (null? items)
0
(let ((set-list (car items)))
(for-each (lambda (items)
(newline)
(display set-list)
(display " intersection ")
(display items)
(display " = ")
(display (tree->list (intersection-set (list->tree set-list)
(list->tree items)))))
sets-list)
(intersection-test (cdr items)))))
入出力結果(Terminal, REPL(Read, Eval, Print, Loop))
1 ]=> (union-test sets-list) () union () = () () union (1 2 3 4 5 6 7 8 9 10) = (1 2 3 4 5 6 7 8 9 10) () union (2 4 6 8 10) = (2 4 6 8 10) () union (1 3 5 7 9) = (1 3 5 7 9) (1 2 3 4 5 6 7 8 9 10) union () = (1 2 3 4 5 6 7 8 9 10) (1 2 3 4 5 6 7 8 9 10) union (1 2 3 4 5 6 7 8 9 10) = (1 2 3 4 5 6 7 8 9 10) (1 2 3 4 5 6 7 8 9 10) union (2 4 6 8 10) = (1 2 3 4 5 6 7 8 9 10) (1 2 3 4 5 6 7 8 9 10) union (1 3 5 7 9) = (1 2 3 4 5 6 7 8 9 10) (2 4 6 8 10) union () = (2 4 6 8 10) (2 4 6 8 10) union (1 2 3 4 5 6 7 8 9 10) = (1 2 3 4 5 6 7 8 9 10) (2 4 6 8 10) union (2 4 6 8 10) = (2 4 6 8 10) (2 4 6 8 10) union (1 3 5 7 9) = (1 2 3 4 5 6 7 8 9 10) (1 3 5 7 9) union () = (1 3 5 7 9) (1 3 5 7 9) union (1 2 3 4 5 6 7 8 9 10) = (1 2 3 4 5 6 7 8 9 10) (1 3 5 7 9) union (2 4 6 8 10) = (1 2 3 4 5 6 7 8 9 10) (1 3 5 7 9) union (1 3 5 7 9) = (1 3 5 7 9) ;Value: 0 1 ]=> (intersection-test sets-list) () intersection () = () () intersection (1 2 3 4 5 6 7 8 9 10) = () () intersection (2 4 6 8 10) = () () intersection (1 3 5 7 9) = () (1 2 3 4 5 6 7 8 9 10) intersection () = () (1 2 3 4 5 6 7 8 9 10) intersection (1 2 3 4 5 6 7 8 9 10) = (1 2 3 4 5 6 7 8 9 10) (1 2 3 4 5 6 7 8 9 10) intersection (2 4 6 8 10) = (2 4 6 8 10) (1 2 3 4 5 6 7 8 9 10) intersection (1 3 5 7 9) = (1 3 5 7 9) (2 4 6 8 10) intersection () = () (2 4 6 8 10) intersection (1 2 3 4 5 6 7 8 9 10) = (2 4 6 8 10) (2 4 6 8 10) intersection (2 4 6 8 10) = (2 4 6 8 10) (2 4 6 8 10) intersection (1 3 5 7 9) = () (1 3 5 7 9) intersection () = () (1 3 5 7 9) intersection (1 2 3 4 5 6 7 8 9 10) = (1 3 5 7 9) (1 3 5 7 9) intersection (2 4 6 8 10) = () (1 3 5 7 9) intersection (1 3 5 7 9) = (1 3 5 7 9) ;Value: 0
0 コメント:
コメントを投稿