読者です 読者をやめる 読者になる 読者になる

計算機プログラムの構造と解釈 第二版 P93 問題2.65

sicp

この問題はθ(n)の手続きをいくつも使ってやっていく。
変な書き方だけど
θ(n) = θ(n) + θ(n) + θ(n)
だから、いくら使ってもオッケーだ!!


そういう訳で、P90のintersection-setと
問題2.62のunion-setを利用する。


戦略としては
・木構造->順序づけられたリストに変換->intersection-set(順序づけられたリスト)->木構造に変換
・木構造->順序づけられたリストに変換->union-set(順序づけられたリスト)->木構造に変換


という戦略をとる。そういう訳で、実装です。


実装

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

(use ggc.debug.trace)
(use math.mt-random)


(define nil '())

(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 (element-of-set? x set)
  (cond ((null? set) #f) 
        ((= x (entry set)) #t) 
        ((< x (entry set))
         (element-of-set? x (left-branch set)))
        ((> x (entry set))
         (element-of-set? x (right-branch set)))))


(define (adjoin-set x set)
  (cond ((null? set) (make-tree x nil nil))
        ((= x (entry set)) set)
        ((< x (entry set))
         (make-tree (entry set)
                    (adjoin-set x (left-branch set))
                    (right-branch set)))
        ((> x (entry set))
         (make-tree (entry set)
                    (left-branch set)
                    (adjoin-set x (right-branch set))))))



;;問題2.63
(define (tree->list-1 tree)
  (if (null? tree) nil
    (append (tree->list-1 (left-branch tree))
            (cons (entry tree)
                  (tree->list-1 (right-branch tree))))))


(define (tree->list-2 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 nil))

;;&#181;問題2.64
(define (list->tree elements)
  (car (partial-tree elements (length elements))))

(define (partial-tree elts n)
  (if (= n 0) (cons nil elts)
    (let ((left-size (quotient (- n 1) 2)))
      (let ((left-result (partial-tree elts left-size)))
        (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))))))))


;;P90から抜粋
(define (intersection-set set1 set2)
  (if (or (null? set1) (null? set2))
    nil
    (let ((x1 (car set1))
          (x2 (car set2)))
      (cond ((= x1 x2)
             (cons x1
                   (intersection-set (cdr set1)
                                     (cdr set2))))
            ((< x1 x2)
             (intersection-set (cdr set1) set2))
            ((< x2 x1)
             (intersection-set set1 (cdr set2)))))))

;;問題2.62から
(define (union-set set1 set2)
  (cond ((null? set1) set2)
        ((null? set2) set1)
        (else
          (let ((x1 (car set1))
                (x2 (car set2)))
            (cond ((= x1 x2) (cons x1 (union-set (cdr set1) (cdr set2))))
                  ((< x1 x2) (cons x1 (union-set (cdr set1) set2)))
                  ((< x2 x1) (cons x2 (union-set set1 (cdr set2)))))))))




(define (union-set-for-tree tree1 tree2)
  (list->tree (union-set (tree->list-1 tree1)
                         (tree->list-1 tree2))))

(define (intersection-set-for-tree tree1 tree2)
  (list->tree (intersection-set (tree->list-1 tree1)
                                (tree->list-1 tree2))))


;;P91 図2.16の木を表したもの左からtree1、tree2、tree3
(define tree1 (make-tree 7
                         (make-tree 3
                                    (make-tree 1 nil nil)
                                    (make-tree 5 nil nil))
                         (make-tree 9
                                    nil
                                    (make-tree 11 nil nil))))

(define tree2 (make-tree 3
                         (make-tree 1 nil nil)
                         (make-tree 7
                                    (make-tree 5 nil nil)
                                    (make-tree 9
                                               nil
                                               (make-tree 11 nil nil)))))

(define tree3 (make-tree 5
                         (make-tree 3
                                    (make-tree 1 nil nil)
                                    nil)
                         (make-tree 9
                                    (make-tree 7 nil nil)
                                    (make-tree 11 nil nil))))

;;P92図2.17の木を表した物を、tree4とする。
(define tree4 (make-tree 1
                         nil
                         (make-tree 2
                                    nil
                                    (make-tree 3
                                               nil
                                               (make-tree 4
                                                          nil
                                                          (make-tree 5
                                                                     nil
                                                                     (make-tree 6
                                                                                nil
                                                                                (make-tree 7 nil nil))))))))


;; main
(define (main args)

  (display "tree1 :")
  (display tree1)
  (newline)
  
  (display "tree2 :")
  (display tree2)
  (newline)
  
  (display "tree3 :")
  (display tree3)
  (newline)
  
  (display "tree4 :")
  (display tree4)
  (newline)

  (display "(intersection-set-for-tree tree3 tree4) :")
  (display (intersection-set-for-tree tree3 tree4))
  (newline)

  (display "(union-set-for-tree tree3 tree4) :")
  (display (union-set-for-tree tree3 tree4))
  (newline)
  0)


実行

tree1 :(7 (3 (1 () ()) (5 () ())) (9 () (11 () ())))
tree2 :(3 (1 () ()) (7 (5 () ()) (9 () (11 () ()))))
tree3 :(5 (3 (1 () ()) ()) (9 (7 () ()) (11 () ())))
tree4 :(1 () (2 () (3 () (4 () (5 () (6 () (7 () ())))))))
(intersection-set-for-tree tree3 tree4) :(3 (1 () ()) (5 () (7 () ())))
(union-set-for-tree tree3 tree4) :(5 (2 (1 () ()) (3 () (4 () ()))) (7 (6 () ()) (9 () (11 () ()))))

ちょっと実行テストの割には例が悪いな。。。