my attempt to do the exercises in sicp.

Sunday, July 27, 2008

sicp exercise 2.65


;; Exercise 2.65.  Use the results of exercises 2.63 and  2.64 to give O(n) implementations of union-set and intersection-set for sets implemented as (balanced) binary trees.

;; To union the two sets implemented as balanced binary trees, convert both the tree into list, compute union of the two ordered list, convert the resulting list into balanced binary tree.


(define (union-set set1 set2)
    (cond ((null? set1) set2)
          ((null? set2) set1)
          ((and (null? set1) (null? set2)) (list))
          (else
            (let ((x1 (car set1))
                  (x2 (car set2)))
              (cond ((> x1 x2) (cons x2
                                     (union-set set1 (cdr set2))))
                    ((= x1 x2) (cons x1
                                     (union-set (cdr set1) (cdr set2))))
                    ((< x1 x2) (cons x1
                                     (union-set (cdr set1) set2))))))))

(define (intersection-set set1 set2)
  (if (or (null? set1) (null? set2))
      '()   
      (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)))))))

(define NULL (list))

(define (make-tree item left right) (list item left right))
(define (entry tree) (car tree))
(define (left-branch tree) (cadr tree))
(define (right-branch tree) (caddr tree))

(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 NULL))

(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))
                (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 (union-tree tree1 tree2)
  (let ((list1 (tree->list tree1))
        (list2 (tree->list tree2)))
    (let ((union-list (union-set list1 list2)))
      (list->tree union-list))))

(define (intersection-tree tree1 tree2)
  (let ((list1 (tree->list tree1))
        (list2 (tree->list tree2)))
    (let ((intersection-list (intersection-set list1 list2)))
      (list->tree intersection-list))))

(define set1 (list 100 200 300 400 500))
(define set2 (list 10 20 30 40 50))
(define set3 (list 1 2 35 45 55))
(define set4 (list 10 20 50 70 90))

(define tree1 (list->tree set1))
(define tree2 (list->tree set2))
(define tree3 (list->tree set3))
(define tree4 (list->tree set4))

(display (union-tree tree1 tree2)) (newline)
(display (intersection-tree tree2 tree4)) (newline)


No comments: