sicp-ex-2.65



<< Previous exercise (2.64) | Index | Next exercise (2.66) >>


hp

I don't see how to do this for arbitrary sets without recurring to allowing multiple copies of an element (using the O(n) from 2.60 for instance) i.e. using multisets.

  
 ;; we use union-set260 which is union for multisets and O(n). 
 ;; As both conversions tree->list2 (2.63) and list->tree are O(n) we are good 
 ;; NOTE THAT resulting tree is a multiset 
 (define (union-set265 s t) 
   (list->tree (union-set260 (tree->list-2 s) 
                             (tree->list-2 t)))) 
  

tig

leafac's algorithm for union-set does not work properly. If, for instance, the entry of one tree is bigger than the other, it won't compare the right branch of the tree with the bigger entry with the tree with the smaller entry. Try this:

 (union-set (list->tree '(1 2 3 5 7 9 46))  
             (list->tree '(5 6 10 11 20 23 46))) 
  
 ;; => (11 (6 (5 (2 (1 () ()) (3 () ())) (9 (7 () ()) (46 () ()))) (10 () ())) (23 (20 () ()) (46 () ()))) 

46 shows up twice.


leafac

If you want to avoid the conversions back and forth from representations, you can choose to don't use the results of exercises 2.63 and 2.64:

 (define (union-set a b) 
   (cond ((null? a) b) 
         ((null? b) a) 
         (else 
          (let ((a-entry (entry a)) 
                (a-left-branch (left-branch a)) 
                (a-right-branch (right-branch a)) 
                (b-entry (entry b)) 
                (b-left-branch (left-branch b)) 
                (b-right-branch (right-branch b))) 
            (cond ((= a-entry b-entry) 
                   (make-tree a-entry 
                              (union-set a-left-branch b-left-branch) 
                              (union-set a-right-branch b-right-branch))) 
                  ((< a-entry b-entry) 
                   (make-tree b-entry 
                              (union-set a b-left-branch) 
                              b-right-branch)) 
                  ((> a-entry b-entry) 
                   (make-tree a-entry 
                              (union-set a-left-branch b) 
                              a-right-branch))))))) 
  
 (union-set (list->tree '(1 3 5)) 
            (list->tree '(2 3 4))) 
 ;; => (3 (2 (1 () ()) ()) (5 (4 () ()) ())) 
  
 ;warning this algo has wrong output 
 ;; check input as bst1 bst2 as: 
 ; (define bst1 (list->tree '(1 2 3 4 5 6 7))) 
 ; (define bst2 (list->tree '(6 7 8 9))) 
 (define (intersection-set a b) 
   (cond ((null? a) ()) 
         ((null? b) ()) 
         (else 
          (let ((a-entry (entry a)) 
                (a-left-branch (left-branch a)) 
                (a-right-branch (right-branch a)) 
                (b-entry (entry b)) 
                (b-left-branch (left-branch b)) 
                (b-right-branch (right-branch b))) 
            (cond ((= a-entry b-entry) 
                   (make-tree a-entry 
                              (intersection-set a-left-branch b-left-branch) 
                              (intersection-set a-right-branch b-right-branch))) 
                  ((< a-entry b-entry) 
                   (union-set 
                    (intersection-set a-right-branch 
                                      (make-tree b-entry () b-right-branch)) 
                    (intersection-set (make-tree a-entry a-left-branch ()) 
                                      b-left-branch))) 
                  ((> a-entry b-entry) 
                   (union-set 
                    (intersection-set (make-tree a-entry () a-right-branch) 
                                      b-right-branch) 
                    (intersection-set a-left-branch 
                                      (make-tree b-entry b-left-branch ()))))))))) 
  
 (intersection-set (list->tree '(3 5 10)) 
                   (list->tree '(1 2 3 4 5 7))) 
 ;; => (5 (3 () ()) ()) 
  

ljp

anohter solution

  
 (define (addjoin x set) 
   (cond ((null? set) (make-tree x '() '())) 
         ((= x (entry set)) set) 
         ((< x (entry set)) (make-tree (entry set) (addjoin x (left-branch set)) (right-branch set))) 
         ((> x (entry set)) (make-tree (entry set) (left-branch set) (addjoin x (right-branch set)))))) 
 (define (element-of? x set) 
   (cond ((null? set) false) 
         ((= x (entry set)) true) 
         ((< x (entry set)) (element-of? x (left-branch set))) 
         ((> x (entry set)) (element-of? x (right-branch set))))) 
 (define (union-set set1 set2) 
   (cond ((null? set1) set2) 
         (else 
          (let ((result-entry (addjoin (entry set1) set2))) 
            (let ((left-result (union-set (left-branch set1) result-entry))) 
              (union-set (right-branch set1) left-result)))))) 
 (define (intersection-set set1 set2) 
   (cond ((null? set1) '()) 
         ((null? set2) '()) 
         ((element-of? (entry set1) set2) 
          (make-tree (entry set1) 
                     (intersection-set (left-branch set1) set2) 
                     (intersection-set (right-branch set1) set2))) 
         (else 
          (union-set (intersection-set (left-branch set1) set2) 
                     (intersection-set (right-branch set1) set2))))) 
  
 ;next is annother list->tree 
 (define (sub-lst lst a b) 
     (define (iter lst index a b result) 
       (cond ((or (null? lst) (> index b)) result) 
             ((< index a) (iter (cdr lst) (+ index 1) a b result)) 
             (else 
              (iter (cdr lst) (+ index 1) a b (append result (list (car lst))))))) 
     (iter lst 0 a b '())) 
 (define (list->tree2 lst) 
   (let* ((n (length lst)) 
         (part (quotient (- n 1) 2))) 
     (cond ((= n 0) '()) 
           ((= n 1) (make-tree (car lst) '() '())) 
           (else 
            (let ((left-part (sub-lst lst 0 (- part 1))) 
                  (right-part (sub-lst lst part n))) 
              (let ((entry (car right-part))) 
                (make-tree entry  
                           (list->tree2 left-part) 
                           (list->tree2 (cdr right-part))))))))) 
  

emj

Exercise 2.65 says to 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. I don't see that in any of these solutions. I am renaming tree->list-2 (from the course text) to tree->list.

 ;; ************Union set balanced************ 
 ;; Strategy: use tree->list to convert both trees to lists 
 ;; Use the previous union-set for lists 
 ;; Use list->tree to convert back to a (now) balanced tree. 
  
 (define (union-set-bal set1 set2) 
   (cond ((null? set1) set2) 
         ((null? set2) set1) 
         (else (list->tree (union-set (tree->list set1) (tree->list set2)))))) 
  
 ;; ***********Intersection set balanced********** 
 ;; Use tree->list to convert both trees to lists 
 ;; Use previous intersection-set for lists 
 ;; Use list->tree to convert back to balanced tree 
  
 (define (intersection-set-bal set1 set2) 
   (cond ((null? set1) nil) 
         ((null? set2) nil) 
         (else (list->tree (intersection-set (tree->list set1) (tree->list set2)))))) 
  
 ;; ************Also used***************** 
  
 (define (union-set set1 set2) 
   (cond ((and (null? set1) (not (null? set2))) set2) 
         ((and (null? set2) (not (null? set1))) set1) 
         ((and (null? set2) (null? set1)) nil) 
         ((> (car set1) (car set2)) (cons (car set2) (union-set set1 (cdr set2)))) 
         ((< (car set1) (car set2)) (cons (car set1) (union-set (cdr set1) set2))) 
         (else (cons (car set1) (union-set (cdr set1) (cdr 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 (entry tree) (car tree)) 
  
 (define (left-branch tree) (car (cdr tree))) 
  
 (define (right-branch tree) (car (cdr (cdr 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)) 
                 (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))) 
                 '(if uncommented, the next two prints help to show the way this procedure works) 
                 '(print (make-tree this-entry left-tree right-tree)) 
                 '(print remaining-elts) 
                 (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 (max x1 x2) 
   (if (> x1 x2) x1 x2)) 
    
 ;; ***************Testing****************** 
  
 (depth (union-set-bal (list->tree '(1 2 3 5 7 9 46)) (list->tree '(5 6 10 11 20 23 46)))) 
 ;;4 
 (depth (intersection-set-bal 
   (list->tree '(1 3 5 7 10 14 15 20 31 50 51 53 55 57 59 61 63 65)) 
   (list->tree '(1 3 5 8 10 24 25 30 41 50 52 54 56 58 60 62 64 66)))) 
 ;;3 
  
 ;; ************Used for testing************** 
 (define (depth tree) 
   (if (null? tree) 
       0 
       (+ 1 (max (depth (car (cdr tree))) 
                 (depth (car (cdr (cdr tree)))))))) 

cgb

Can't we just use intersection-set and union-set from ex. 2.60 and 2.62? In this case we would just first convert our trees using tree->list-2 and, after the procedure, convert the lists again using list->tree, as the exercise statement sort of implies when it asks to "use the results of exercises 2.63 [tree->list] and 2.64 [list->tree]". I just adapted the code form these exercises, but I'm not sure if this implementation has an order of growth O(n)

  
 (define (union-set set1 set2) 
   (define (aux set1 set2) 
     (cond ((null? set2) set1) 
           ((null? set1) set2) 
           ((= (car set1) (car set2)) 
            (cons (car set1) (aux (cdr set1) (cdr set2)))) 
           ((< (car set1) (car set2)) (cons (car set1) (aux (cdr set1) set2))) 
           (else (cons (car set2) (aux set1 (cdr set2)))))) 
   (list->tree (aux (tree->list-2 set1) (tree->list-2 set2)))) 
  
 (define (intersection-set set1 set2) 
   (define (aux set1 set2) 
         (cond ((or (null? set1) (null? set2)) '()) 
               ((= (car set1) (car set2)) 
                (cons (car set1) (aux (cdr set1) (cdr set2)))) 
               ((< (car set1) (car set2)) 
                (aux (cdr set1) set2)) 
               ((> (car set1) (car set2)) 
                (aux set1 (cdr set2))))) 
   (list->tree (aux (tree->list-2 set1) (tree->list-2 set2)))) 

dave

This is how I did it. Using tree->list2 from ex2.63 and list->tree from ex2.64. union-set is O(n) because it does one cons call for every number in the resulting set which, worst case, is the length of set1 plus the length of set2. It also calls list->tree once and tree->list twice. So we have O(n) + O(n) + 2*O(n).

Similar reasoning can be applied to intersection-set.

  
 (define (union-set set1 set2) 
   (define (union-list set1 set2) 
     (cond ((null? set1) set2) 
           ((null? set2) set1) 
           (else  (let ((x1 (car set1)) (x2 (car set2))) 
                    (cond ((equal? x1 x2) 
                           (cons x1 (union-list (cdr set1) (cdr set2)))) 
                          ((< x1 x2) 
                           (cons x1 (union-list (cdr set1) set2))) 
                          ((< x2 x1) 
                           (cons x2 (union-list set1 (cdr set2))))))))) 
   (list->tree (union-list (tree->list set1) (tree->list set2)))) 
  
 (define (intersection-set set1 set2) 
   (define (intersection-list set1 set2) 
     (cond ((null? set1) '()) 
           ((null? set2) '()) 
           (else (let ((x1 (car set1)) (x2 (car set2))) 
                   (cond ((equal? x1 x2) 
                          (cons x1 (intersection-list (cdr set1) (cdr set2)))) 
                         ((< x1 x2) 
                          (intersection-list (cdr set1) set2)) 
                         ((< x2 x1) 
                          (intersection-list set1 (cdr set2)))))))) 
   (list->tree (intersection-list (tree->list set1) (tree->list set2)))) 
  


<< Previous exercise (2.64) | Index | Next exercise (2.66) >>