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

jirf

Solution

My solution relies on the fact that we can traverse trees in order in O(n) time. By transforming the trees into a list-like form, (head . tail), we can reduce the problem to a linear recursive process of comparing each set's "head".

Note 1

Sorry for the length of this...

Note 2

My solution is a little dense for a couple of reasons

  1. My code operates on any number of sets, not just 2 (IDK why I did that)
  2. I wanted to avoid creating a bunch of redundant lists so I created a function that would traverse a tree in something of the fashion of a Python iterator. These algorithms would work on list representations of tree's just as well.

Helper Functions 

  
 (define (fold-left op initial sequence) 
   (define (iter seq result) 
     (if (null? seq) 
         result 
         (iter (cdr seq) 
               (op (car seq) 
                   result)))) 
   (iter sequence initial)) 
  
 (define (filter predicate? sequence) 
   (cond 
     ((null? sequence) nil) 
     (else 
      (if (predicate? (car sequence)) 
          (cons (car sequence) 
                (filter predicate? (cdr sequence))) 
          (filter predicate? (cdr sequence)))))) 
  
 (define (any? predicate? elements) 
   ;; cause (apply or (list blah blah)) does not work 
   (fold-left 
    (lambda (left right) 
      (or (predicate? left) right)) 
    #f 
    elements)) 
  
 (define (all? predicate? elements) 
   ;; cause (apply and (list blah blah)) does not work 
   (fold-left 
    (lambda (left right) 
      (and (predicate? left) right)) 
    #t 
    elements)) 
  
 (define (remove-nulls elements) 
   ;; guess what this does :) 
   (filter (lambda (x) (not (null? x))) elements))

Traverse Tree "Iterator"

I took the code for tree->list and reversed the order to make it highest to lowest and wrapped the second recursive call in a lambda so that I could halt traversal of the tree. This allowed me to avoid creating like a few redundant lists. 

 (define (traverse-left-tree tree) 
   ;; reverse in-order traversal of binary-tree 
   ;; the exact same thing as tree->list 
   ;; except I reversed the order of recursion 
   ;; of the branches to go from greatest to least 
   ;; and put a lambda around the call to recurse on left 
   ;; to allow for halted traversal 
   (define (iter tree result) 
     (if (null? tree) 
         result 
         (iter 
          (right-branch tree) 
          (cons (entry tree) 
                (lambda () 
                  (iter 
                   (left-branch tree) 
                   result)))))) 
   (iter tree nil))

Union

If the sets we want to Union are represented in the form (head . tail) from greatest to least (as they are if we pass them to the traverse-left-tree function above) 

 (define set-1 ((max-entry set-1) (- set-1 (max-entry set-1)))) 
 (define set-2 ((max-entry set-2) (- set-2 (max-entry set-2)))) 
                   . 
                   . 
                   . 
 (define set-n ((max-entry set-n) (- set-n (max-entry set-n))))

Then it can be shown that big-boy: 

 (define big-boy (apply max (map car (list set-1 set-2 .. set-n))))

Is not in any set-x where: 

 (not (= big-boy (car set-x)))

By definition (car set-x) is not equal to big-boy and because big-boy is the max of all heads then (car set-x) is smaller than big-boy. Therefore no other element in set-x is = big-boy because every other element of the set is also smaller than (car set-x) because greatest first order.

So we can safely recurse on 

 (union (cons big-boy result) 
        (map 
          ;; (cdr s) is wrapped in a lambda so we have to call it 
          (lambda (s) (if (= (car s) big-boy) ((cdr s)) s)) 
          sets))

Here is the actual solution 

 (define (union-set-tree . sets) 
   (define (iter result travelers) 
       (if (null? travelers);; if we have no sets to work with return 
           result 
           (let ((next-entry;; add the largest entry found to the union 
                  (apply 
                   max 
                   (map car travelers)))) 
             (iter 
              (cons next-entry 
                    result) 
              (remove-nulls 
               (map 
                (lambda (trav) 
                  (if (or 
                       (null? trav) 
                       (not (= next-entry (car trav)))) 
                      trav 
                      ((cdr trav)))) 
                travelers)))))) 
   (list->tree (iter nil (remove-nulls (map traverse-left-tree sets)))))

Intersection

The logic for set intersection is similar. We iterate over the trees represented as (head . tail) in the same way but instead of adding max automatically we only add it if each head equals max. This is because if each head does not equal max then all the heads that do not equal max are smaller than max so no other element in those sets can be max, and it is not in the intersection.

Solution 

 (define (intersection-set-tree . sets) 
   (define (iter result travelers) 
     ;; if any of the sets are null 
     ;; then the intersection is null 
     ;; so return result 
     (if (any? null? travelers) 
         result 
         (let ((new-max 
                (apply;; apply is used to allow max to operate on a list 
                 max 
                 (map car travelers)))) 
           (let ((new-result 
                  ;; if all heads equal max then add it to the result 
                  (if (all? 
                       (lambda (trav) 
                         (= new-max (car trav))) 
                       travelers) 
                      (cons new-max result) 
                      result))) 
             (iter 
             ;; recurse with new result popping the max off each set 
             ;; we find it in 
              new-result 
              (map 
               (lambda (trav) 
                 (if (or (null? trav) 
                         (not (= new-max (car trav)))) 
                     trav 
                     ((cdr trav)))) 
               travelers)))))) 
   (let ((trees (map traverse-left-tree sets)));;turns trees into (head . tail) 
     (if (any? null? trees) 
         ;; null set intersected with any other set is the null set 
         nil 
         (list->tree (iter nil (map traverse-left-tree sets))))))

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

Last modified : 2022-02-15 02:27:21
WiLiKi 0.5-tekili-7 running on Gauche 0.9