sicp-ex-2.65



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


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


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