1 (define (test-case actual expected)
2   (newline)
3   (display "Actual:   ")
4   (display actual)
5   (newline)
6   (display "Expected: ")
7   (display expected)
8   (newline))
9 
10 
11 (define (entry tree) (car tree))
12 (define (left-branch tree) (cadr tree))
13 (define (right-branch tree) (caddr tree))
14 (define (make-tree entry left right)
15   (list entry left right))
16 
17 (define (element-of-set? x set)
18   (cond ((null? set) #f)
19 	((= x (entry set)) #t)
20 	((< x (entry set))
21 	 (element-of-set? x (left-branch set)))
22 	((> x (entry set))
23 	 (element-of-set? x (right-branch set)))))
24 
25 (define (adjoin-set x set)
26   (cond ((null? set) (make-tree x '() '()))
27 	((= x (entry set)) set)
28 	((< x (entry set))
29 	 (make-tree (entry set)
30 		    (adjoin-set x (left-branch set))
31 		    (right-branch set)))
32 	((> x (entry set))
33 	 (make-tree (entry set)
34 		    (left-branch set)
35 		    (adjoin-set x (right-branch set))))))
36 (define (tree->list-1 tree)
37   (if (null? tree)
38       '()
39       (append (tree->list-1 (left-branch tree))
40 	      (cons (entry tree)
41 		    (tree->list-1 (right-branch tree))))))
42 (define (tree->list-2 tree)
43   (define (copy-to-list tree result-list)
44     (if (null? tree)
45 	result-list
46 	(copy-to-list (left-branch tree)
47 		      (cons (entry tree)
48 			    (copy-to-list (right-branch tree)
49 					  result-list)))))
50   (copy-to-list tree '()))
51 
52 (define (list->tree elements)
53   (car (partial-tree elements (length elements))))
54 
55 (define (partial-tree elts n)
56   (if (= n 0)
57       (cons '() elts)
58       (let ((left-size (quotient (- n 1) 2)))
59 	(let ((left-result (partial-tree elts left-size)))
60 	  (let ((left-tree (car left-result))
61 		(non-left-elts (cdr left-result))
62 		(right-size (- n (+ left-size 1))))
63 	    (let ((this-entry (car non-left-elts))
64 		  (right-result (partial-tree (cdr non-left-elts)
65 					      right-size)))
66 	      (let ((right-tree (car right-result))
67 		    (remaining-elts (cdr right-result)))
68 		(cons (make-tree this-entry left-tree right-tree)
69 		      remaining-elts))))))))
70 
71 ;; Exercise 2.65.  Use the results of exercises 2.63 and  2.64 to give (n) implementations of union-set and intersection-set for sets implemented as (balanced) binary trees.41 
72 
73 (define (union-set set1 set2)
74   (define (union-set-list list1 list2)
75     (cond ((null? list1) list2)
76 	  ((null? list2) list1)
77 	  (else 
78 	   (let ((l1 (car list1))
79 		 (l2 (car list2)))
80 	     (cond ((= l1 l2) 
81 		    (cons l1 (union-set-list (cdr list1) (cdr list2))))
82 		   ((< l1 l2)
83 		    (cons l1 (union-set-list (cdr list1) list2)))
84 		   ((> l1 l2)
85 		    (cons l2 (union-set-list list1 (cdr list2)))))))))
86   (list->tree (union-set-list (tree->list-2 set1) 
87 			      (tree->list-2 set2))))
88 
89 
90 (test-case (union-set '() '()) '())
91 (test-case (union-set (make-tree 5 '() '()) '()) '(5 () ()))
92 (test-case (union-set '() (make-tree 5 (make-tree 3 '() '()) (make-tree 7 '() '()))) '(5 (3 () ()) (7 () ())))
93 (test-case 
94  (union-set
95   (make-tree 3 
96 	     (make-tree 1 
97 			(make-tree 0 '() '()) 
98 			(make-tree 2 '() '()))
99 	     (make-tree 5 
100 			(make-tree 4 '() '()) 
101 			(make-tree 6 '() '())))
102   (make-tree 1
103 	     '()
104 	     (make-tree 3
105 			'()
106 			(make-tree 5
107 				   '()
108 				   (make-tree 7
109 					      '()
110 					      (make-tree 9
111 							 '()
112 							 '()))))))	     
113  '(4 (1 (0 () ()) (2 () (3 () ()))) (6 (5 () ()) (7 () (9 () ())))))
114 (test-case 
115  (union-set
116   (make-tree 3 
117 	     (make-tree 1 
118 			(make-tree 0 '() '()) 
119 			(make-tree 2 '() '()))
120 	     (make-tree 5 
121 			(make-tree 4 '() '()) 
122 			(make-tree 6 '() '())))
123   (make-tree 1
124 	     '()
125 	     (make-tree 3
126 			'()
127 			(make-tree 5
128 				   '()
129 				   (make-tree 7
130 					      '()
131 					      (make-tree 9
132 							 '()
133 							 '()))))))	     
134  '(4 (1 (0 () ()) (2 () (3 () ()))) (6 (5 () ()) (7 () (9 () ())))))
135 (test-case
136  (union-set
137   '(1 () (2 () (3 () (5 (4 () ()) (10 (8 (7 () ()) ()) (12 (11 () ()) (14 () ())))))))
138   '(11 (4 (3 () (2 () ())) (9 () ())) (12 () (15 (14 (13 () ()) ()) ()))))
139  '(8 (3 (1 () (2 () ())) (5 (4 () ()) (7 () ()))) (12 (10 (9 () ()) (11 () ())) (14 (13 () ()) (15 () ())))))
140   
141 			(make-tree 0 '() '()) 
142 			(make-tree 2 '() '()))
143 	     (make-tree 5 
144 			(make-tree 4 '() '()) 
145 			(make-tree 6 '() '())))