sicp-2-3-3-representing-sets

#lang racket

;;;;;;;;;;
;; 2.59 ;;
;;;;;;;;;;

;; sets as unordered lists without duplicates

(define (element-of-set? x st)
  (cond [(empty? st) #f]
        [(equal? x (first st)) #t]
        [else (element-of-set? x (rest st))]))

(define (adjoin-set x st)
  (if (element-of-set? x st) st (cons x st)))

(define (intersection-set st1 st2)
  (cond [(or (empty? st1) (empty? st2)) empty]
        [(element-of-set? (first st1) st2)
         (cons (first st1)
               (intersection-set (rest st1) st2))]
        [else (intersection-set (rest st1) st2)]))

(define (union-set st1 st2)
  (cond [(empty? st1) st2]
        [(empty? st2) st1]
        [(element-of-set? (first st1) st2)
         (union-set (rest st1) st2)]
        [else (cons (first st1)
                    (union-set (rest st1) st2))]))

(define st1 '(0 4 2 1 3))
(define st2 '(5 3 7 4 6))
(element-of-set? 7 st1)
;; #f
(element-of-set? 4 st1)
;; #t
(intersection-set st1 st2)
;; '(4 3)
(union-set st1 st2)
;; '(0 2 1 5 3 7 4 6)

;;;;;;;;;;
;; 2.60 ;;
;;;;;;;;;;

;; sets as unordered lists with duplicates allowed

(define (new-adjoin-set x st) (cons x st))

(define (new-union-set st1 st2) (append st1 st2))

;; Only adjoin-set and union-set would change.  adjoin-set becomes constant time,
;; and union-set becomes O(n).  element-of-set? is still O(n) and
;; intersection-set is still O(n ^ 2).  However, this n is no longer the number of
;; elements in the set.  n is now the number of elements in the list, which could
;; be arbitrarily larger.  So allowing duplicates is only something you would do
;; if you needed to do many adjoin-sets and did not need the other operations to
;; run efficiently.

;;;;;;;;;;
;; 2.61 ;;
;;;;;;;;;;

;; sets as ordered lists

(define (ordered-element-of-set? x st)
  (cond [(empty? st) #f]
        [(= x (first st)) #t]
        [(< x (first st)) #f]
        [else (ordered-element-of-set? x (rest st))]))

(define (ordered-intersection-set st1 st2)
  (cond [(or (empty? st1) (empty? st2)) empty]
        [else
          (define x1 (first st1))
          (define x2 (first st2))
          (cond [(= x1 x2)
                 (cons x1 (ordered-intersection-set (rest st1) (rest st2)))]
                [(< x1 x2) (ordered-intersection-set (rest st1) st2)]
                [else (ordered-intersection-set st1 (rest st2))])]))

(define (ordered-adjoin-set x st)
  (cond [(empty? st) (list x)]
        [(= x (first st)) st]
        [(< x (first st)) (cons x st)]
        [else (cons (first st) (ordered-adjoin-set x (rest st)))]))

;; ordered-adjoin-set will terminate when we encounter an element of st that is
;; bigger than or equal to x.  On average this will happen after examining half
;; the elements in st.

;;;;;;;;;;
;; 2.62 ;;
;;;;;;;;;;

(define (ordered-union-set st1 st2)
  (cond [(empty? st1) st2]
        [(empty? st2) st1]
        [else
          (define x1 (first st1))
          (define x2 (first st2))
          (cond [(= x1 x2)
                 (cons x1 (ordered-union-set (rest st1) (rest st2)))]
                [(< x1 x2)
                 (cons x1 (ordered-union-set (rest st1) st2))]
                [else (cons x2 (ordered-union-set st1 (rest st2)))])]))

(define st3 '(0 1 2 3 4))
(define st4 '(3 4 5 6 7))
(ordered-element-of-set? 7 st3)
;; #f
(ordered-element-of-set? 4 st3)
;; #t
(ordered-intersection-set st3 st4)
;; '(3 4)
(ordered-union-set st3 st4)
;; '(0 1 2 3 4 5 6 7)

;;;;;;;;;;
;; 2.63 ;;
;;;;;;;;;;

;; sets as binary trees

(define (entry tree) (first tree))
(define (left-branch tree) (second tree))
(define (right-branch tree) (third tree))
(define (make-tree entry left right) (list entry left right))

(define (tree-element-of-set? x st)
  (cond [(empty? st) #f]
        [(= x (entry st)) #t]
        [(< x (entry st))
         (tree-element-of-set? x (left-branch st))]
        [else (tree-element-of-set? x (right-branch st))]))

(define (tree-adjoin-set x st)
  (cond [(empty? st) (make-tree x empty empty)]
        [(= x (entry st)) st]
        [(< x (entry st))
         (make-tree (entry st)
                    (tree-adjoin-set x (left-branch st))
                    (right-branch st))]
        [else (make-tree (entry st)
                         (left-branch st)
                         (tree-adjoin-set x (right-branch st)))]))

;; two ways to convert a bst into a list

(define (tree->list1 tree)
  (if (empty? tree)
    empty
    (append (tree->list1 (left-branch tree))
            (cons (entry tree)
                  (tree->list1 (right-branch tree))))))

(define (tree->list2 tree)
  (define (copy-to-list tree result-list)
    (if (empty? tree)
      result-list
      (copy-to-list (left-branch tree)
                    (cons (entry tree)
                          (copy-to-list (right-branch tree)
                                        result-list)))))
  (copy-to-list tree empty))

(define tree-2-16-1 (make-tree 7
                               (make-tree 3
                                          (list 1 empty empty)
                                          (list 5 empty empty))
                               (make-tree 9
                                          empty
                                          (list 11 empty empty))))
(define tree-2-16-2 (make-tree 3
                               (list 1 empty empty)
                               (make-tree 7
                                          (list 5 empty empty)
                                          (make-tree 9
                                                     empty
                                                     (list 11 empty empty)))))
(define tree-2-16-3 (make-tree 5
                               (make-tree 3
                                          (list 1 empty empty)
                                          empty)
                               (make-tree 9
                                          (list 7 empty empty)
                                          (list 11 empty empty))))

(displayln tree-2-16-1)
;; (7 (3 (1 () ()) (5 () ())) (9 () (11 () ())))
(tree->list1 tree-2-16-1)
;; '(1 3 5 7 9 11)
(tree->list2 tree-2-16-1)
;; '(1 3 5 7 9 11)

(displayln tree-2-16-2)
;; (3 (1 () ()) (7 (5 () ()) (9 () (11 () ()))))
(tree->list1 tree-2-16-2)
;; '(1 3 5 7 9 11)
(tree->list2 tree-2-16-2)
;; '(1 3 5 7 9 11)

(displayln tree-2-16-3)
;; (5 (3 (1 () ()) ()) (9 (7 () ()) (11 () ())))
(tree->list1 tree-2-16-3)
;; '(1 3 5 7 9 11)
(tree->list2 tree-2-16-3)
;; '(1 3 5 7 9 11)

;; a.  The two procedures do produce the same result for every tree.  Both produce
;; a left traversal of the tree.

;; b.  Both trees make two recursive calls on subproblems of about half-size, but
;; tree->list2 does constant work outside the recursion while tree->list1 does
;; linear work outside the recursion because of the call to append.  So
;; tree->list2 should be O(n), and tree->list1 should be O(n log n).

;;;;;;;;;;
;; 2.64 ;;
;;;;;;;;;;

(define (list->tree elements)
  (first (partial-tree elements (length elements))))
(define (partial-tree elts n)
  (cond [(zero? n) (cons empty elts)]
        [else
          (define left-size (quotient (sub1 n) 2))
          (define left-result (partial-tree elts left-size))
          (define left-tree (first left-result))
          (define non-left-elts (rest left-result))
          (define right-size (- n (add1 left-size)))
          (define this-entry (first non-left-elts))
          (define right-result (partial-tree (rest non-left-elts) right-size))
          (define right-tree (first right-result))
          (define remaining-elts (rest right-result))
          (cons (make-tree this-entry left-tree right-tree)
                remaining-elts)]))

;; a.  partial-tree takes an ordered list and a number, and returns a list
;; containing: a balanced binary tree consisting of the first number elements of
;; the ordered list, and the remaining unused elements.  The procedure works by
;; splitting the requisite number of elements into a triple of smaller numbers, a
;; middle number, and bigger numbers, recursively sending off the smaller and
;; bigger numbers to be made into trees, then using those trees as branches to
;; create the top-level tree having the middle element as entry.

(partial-tree '(1 2 3 4) 0)
;; '(() 1 2 3 4)
(partial-tree '(1 2 3 4) 1)
;; '((1 () ()) 2 3 4)
(partial-tree '(1 2 3 4) 2)
;; '((1 () (2 () ())) 3 4)
(partial-tree '(1 2 3 4) 3)
;; '((2 (1 () ()) (3 () ())) 4)
(partial-tree '(1 2 3 4) 4)
;; '((2 (1 () ()) (3 () (4 () ()))))

(list->tree '(1 3 5 7 9 11))
;; '(5 (1 () (3 () ())) (9 (7 () ()) (11 () ())))

    ;; 5
  ;; /   \
 ;; 1     9
;; / \   / \
   ;; 3 7  11

;; b.  partial-tree does constant work outside the recursion and makes two
;; recursive calls, each on a subproblem of about half size.  So the recursion
;; tree has n nodes and thus partial-tree runs in linear time.

;;;;;;;;;;
;; 2.65 ;;
;;;;;;;;;;

;; We can get linear time union-set and intersection-set for our tree
;; representation of sets by:  taking a tree, converting it into an ordered list
;; in linear time using tree->list2, then using the linear time operations we have
;; for sets as ordered lists, then converting back into trees, again in linear
;; time, using list->tree.

(define (tree-union-set t1 t2)
  (define l1 (tree->list2 t1))
  (define l2 (tree->list2 t2))
  (define list-result (ordered-union-set l1 l2))
  (list->tree list-result))

(define (tree-intersection-set t1 t2)
  (define l1 (tree->list2 t1))
  (define l2 (tree->list2 t2))
  (define list-result (ordered-intersection-set l1 l2))
  (list->tree list-result))

(define t1 (make-tree 3
                      (list 1 empty empty)
                      (make-tree 7
                                 (list 5 empty empty)
                                 (make-tree 9
                                            empty
                                            (list 11 empty empty)))))
(tree->list2 t1)
;; '(1 3 5 7 9 11)

(define t2 (make-tree 5
                      (make-tree 2
                                 (list 1 empty empty)
                                 empty)
                      (make-tree 8
                                 (list 7 empty empty)
                                 (list 11 empty empty))))
(tree->list2 t2)
;; '(1 2 5 7 8 11)

(tree-union-set t1 t2)
;; '(5 (2 (1 () ()) (3 () ())) (8 (7 () ()) (9 () (11 () ()))))
(tree->list2 (tree-union-set t1 t2))
;; '(1 2 3 5 7 8 9 11)

(tree-intersection-set t1 t2)
;; '(5 (1 () ()) (7 () (11 () ())))
(tree->list2 (tree-intersection-set t1 t2))
;; '(1 5 7 11)

;;;;;;;;;;
;; 2.66 ;;
;;;;;;;;;;

(define (tree-lookup given-key set-of-records)
  (cond [(empty? set-of-records) #f]
        [(= given-key (entry set-of-records))
         (entry set-of-records)]
        [(< given-key (entry set-of-records))
         (tree-lookup given-key (left-branch set-of-records))]
        [else (tree-lookup given-key (right-branch set-of-records))]))

(displayln t1)
;; (3 (1 () ()) (7 (5 () ()) (9 () (11 () ()))))
(tree-lookup 9 t1)
;; 9
(tree-lookup 8 t1)
;; #f