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

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.

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

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

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

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

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

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".

Sorry for the length of this...

My solution is a little dense for a couple of reasons

- My code operates on any number of sets, not just 2 (IDK why I did that)
- 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.

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

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

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

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

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.

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

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.