Permalink
Browse files

binary trees

  • Loading branch information...
1 parent 5ba8704 commit 9015a0bc7580230591bd66a4d7384d10f02edada @sarabander committed Sep 20, 2011
Showing with 377 additions and 0 deletions.
  1. +114 −0 2.3/2.63.scm
  2. +63 −0 2.3/2.64.scm
  3. +165 −0 2.3/2.65.scm
  4. +35 −0 2.3/2.66.scm
View
@@ -0,0 +1,114 @@
+
+;; From the book
+(define (entry tree) (car tree))
+
+(define (left-branch tree) (cadr tree))
+
+(define (right-branch tree) (caddr tree))
+
+(define (make-tree entry left right)
+ (list entry left right))
+
+(define (tree->list-1 tree)
+ (if (null? tree)
+ '()
+ (append (tree->list-1 (left-branch tree))
+ (cons (entry tree)
+ (tree->list-1 (right-branch tree))))))
+
+(define (tree->list-2 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 '()))
+
+;; a.
+
+;; The trees from figure 2.16
+(define tree1 '(7 (3 (1 () ()) (5 () ())) (9 () (11 () ()))))
+(define tree2 '(3 (1 () ()) (7 (5 () ()) (9 () (11 () ())))))
+(define tree3 '(5 (3 (1 () ()) ()) (9 (7 () ()) (11 () ()))))
+
+(tree->list-1 tree1) ; '(1 3 5 7 9 11)
+(tree->list-2 tree1) ; '(1 3 5 7 9 11)
+
+(tree->list-1 tree2) ; '(1 3 5 7 9 11)
+(tree->list-2 tree2) ; '(1 3 5 7 9 11)
+
+(tree->list-1 tree3) ; '(1 3 5 7 9 11)
+(tree->list-2 tree3) ; '(1 3 5 7 9 11)
+
+;; The 2 procedures seem to produce the same list with these trees.
+
+;; We try some unbalanced trees:
+(define tree4 '(1 () (2 () (3 () (4 () ())))))
+(define tree5 '(1 (2 (3 (4 () ()) ()) ()) ()))
+
+(tree->list-1 tree4) ; '(1 2 3 4)
+(tree->list-2 tree4) ; '(1 2 3 4)
+
+(tree->list-1 tree5) ; '(4 3 2 1)
+(tree->list-2 tree5) ; '(4 3 2 1)
+
+;; Still same results.
+
+;; b.
+
+(define counter 0)
+
+;; Call counter added to both
+(define (tree->list-1 tree)
+ (set! counter (add1 counter))
+ (if (null? tree)
+ '()
+ (append (tree->list-1 (left-branch tree))
+ (cons (entry tree)
+ (tree->list-1 (right-branch tree))))))
+
+(define (tree->list-2 tree)
+ (define (copy-to-list tree result-list)
+ (set! counter (add1 counter))
+ (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 '()))
+
+(set! counter 0)
+
+(tree->list-1 tree1) ; '(1 3 5 7 9 11)
+(tree->list-2 tree1) ; '(1 3 5 7 9 11)
+
+(tree->list-1 tree2) ; '(1 3 5 7 9 11)
+(tree->list-2 tree2) ; '(1 3 5 7 9 11)
+
+(tree->list-1 tree3) ; '(1 3 5 7 9 11)
+(tree->list-2 tree3) ; '(1 3 5 7 9 11)
+
+;; Each of the 6 procedures above took 13 steps to execute.
+
+(tree->list-1 tree4) ; '(1 2 3 4)
+(tree->list-2 tree4) ; '(1 2 3 4)
+
+(tree->list-1 tree5) ; '(4 3 2 1)
+(tree->list-2 tree5) ; '(4 3 2 1)
+
+;; These took 9 steps.
+
+(define tree6 '(7 (3 (1 () ()) (5 () ())) (9 () (13 (11 () ()) (15 () ())))))
+
+(tree->list-1 tree6) ; '(1 3 5 7 9 11 13 15)
+(tree->list-2 tree6) ; '(1 3 5 7 9 11 13 15)
+
+;; Both of these took 17 steps.
+
+;; So, both procedures take 2n + 1 steps to convert trees with n elements.
+;; Order of growth is O(n).
View
@@ -0,0 +1,63 @@
+;; Needs make-tree from 2.63
+
+(define (list->tree elements)
+ (car (partial-tree elements (length elements))))
+
+(define (partial-tree elts n)
+ (set! counter (add1 counter))
+ (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)))
+ (cons (make-tree
+ this-entry left-tree right-tree)
+ remaining-elts))))))))
+
+;; a.
+
+;; In brief, partial-tree starts by partitioning the first n elements of
+;; list 'elts' into three parts: left part, node entry and right part.
+;; It then recursively calls partial-tree again on the left and right parts,
+;; producing left and right subtrees branching out from 'this-entry'.
+;; If n is odd, the left and right subtrees will be the same size, otherwise
+;; left is smaller. Finally, it uses make-tree to construct a tree out of
+;; the root entry ('this-entry'), left subtree and right subtree.
+
+(list->tree '(1 3 5 7 9 11)) ; '(5 (1 () (3 () ())) (9 (7 () ()) (11 () ())))
+
+;; 5
+;; / \
+;; / \
+;; / \
+;; 1 9
+;; \ / \
+;; 3 7 11
+
+;; For checking
+(tree->list-1 '(5 (1 () (3 () ())) (9 (7 () ()) (11 () ()))))
+;; '(1 3 5 7 9 11)
+
+;; b.
+
+;; The order of growth should be O(n), because in each step the list is halved,
+;; but two partial-tree calls are spawned. These halvings and doublings balance
+;; each other out. We check this by adding a counter to partial-tree.
+
+(define counter 0)
+
+(list->tree '(1 3 5 7 9 11)) ; counter = 13
+(list->tree '(1 3 5 7 9 11 13 15)) ; counter = 17
+(list->tree '(1 3 5 7 9 11 13 15 17 19)) ; counter = 21
+
+(set! counter 0)
+
+;; Number of steps is 2n + 1, which is still O(n) growth.
View
@@ -0,0 +1,165 @@
+
+;; Some helper procedures
+(define (cut-left-branch tree)
+ (make-tree (entry tree)
+ '()
+ (right-branch tree)))
+
+(cut-left-branch (list->tree '(1 2 3 4 5))) ; '(3 () (4 () (5 () ())))
+
+(define (cut-right-branch tree)
+ (make-tree (entry tree)
+ (left-branch tree)
+ '()))
+
+(cut-right-branch (list->tree '(1 2 3 4 5))) ; '(3 (1 () (2 () ())) ())
+
+;; Union
+(define (union-set-2 tree1 tree2)
+ (set! counter (add1 counter))
+ (cond ((empty? tree1) tree2)
+ ((empty? tree2) tree1)
+ (else
+ (let ((entry1 (entry tree1))
+ (entry2 (entry tree2))
+ (left1 (left-branch tree1))
+ (left2 (left-branch tree2))
+ (right1 (right-branch tree1))
+ (right2 (right-branch tree2)))
+ (cond ((= entry1 entry2)
+ (make-tree entry1
+ (union-set-2 left1 left2)
+ (union-set-2 right1 right2)))
+ ((< entry1 entry2)
+ (union-set-2
+ (make-tree entry2
+ (union-set-2 (cut-right-branch tree1)
+ left2)
+ right2)
+ right1))
+ ((< entry2 entry1)
+ (union-set-2
+ (make-tree entry1
+ (union-set-2 (cut-right-branch tree2)
+ left1)
+ right1)
+ right2))
+ (else (error "Should be unreachable place.")))))))
+
+;;Check
+(tree->list-1
+ (union-set-2 '()
+ (list->tree '(1 2 3)))) ; '(1 2 3)
+
+(tree->list-1
+ (union-set-2 (list->tree '(1 2 3))
+ (list->tree '(1 2 3)))) ; '(1 2 3)
+
+(tree->list-1
+ (union-set-2 (list->tree '(0 2 4))
+ (list->tree '(1 2 3)))) ; '(0 1 2 3 4)
+
+(tree->list-1
+ (union-set-2 (list->tree '(-3 0 1))
+ (list->tree '(4 7 9)))) ; '(-3 0 1 4 7 9)
+
+(list->tree
+ (tree->list-1
+ (union-set-2 (list->tree '(2 4 6 8))
+ (list->tree '(1 3 5)))))
+; '(4 (2 (1 () ()) (3 () ())) (6 (5 () ()) (8 () ())))
+
+(list->tree
+ (tree->list-1
+ (union-set-2 (list->tree '(2 4))
+ (list->tree '(1 3))))) ; counter = 28
+
+(list->tree
+ (tree->list-1
+ (union-set-2 (list->tree '(2 4 6 8))
+ (list->tree '(1 3 5 7))))) ; counter = 52
+
+(list->tree
+ (tree->list-1
+ (union-set-2 (list->tree '(2 4 6 8 10 12 14 16))
+ (list->tree '(1 3 5 7 9 11 13 15))))) ; counter = 100
+
+(set! counter 0)
+
+;; Growth of union-set-2 is linear.
+
+;; Intersection
+(define (intersection-set-2 tree1 tree2)
+ (set! counter (add1 counter))
+ (cond ((or (empty? tree1) (empty? tree2)) empty)
+ (else
+ (let ((entry1 (entry tree1))
+ (entry2 (entry tree2))
+ (left1 (left-branch tree1))
+ (left2 (left-branch tree2))
+ (right1 (right-branch tree1))
+ (right2 (right-branch tree2)))
+ (cond ((= entry1 entry2)
+ (make-tree entry1
+ (intersection-set-2 left1 left2)
+ (intersection-set-2 right1 right2)))
+ ((< entry1 entry2)
+ (union-set-2
+ (intersection-set-2 (cut-right-branch tree1)
+ left2)
+ (intersection-set-2 right1 tree2)))
+ ((< entry2 entry1)
+ (union-set-2
+ (intersection-set-2 (cut-right-branch tree2)
+ left1)
+ (intersection-set-2 right2 tree1)))
+ (else (error "Should be unreachable place.")))))))
+
+(tree->list-1
+ (intersection-set-2 (list->tree '())
+ (list->tree '()))) ; '()
+
+(tree->list-1
+ (intersection-set-2 (list->tree '(1 3 5 8 10))
+ (list->tree '(1 5 6 8 9)))) ; '(1 5 8)
+
+(tree->list-1
+ (intersection-set-2 (list->tree '(2 4 6 8))
+ (list->tree '(1 3 5 7)))) ; '()
+
+;; Counting procedure calls
+(set! counter 0)
+
+(list->tree
+ (tree->list-1
+ (intersection-set-2 (list->tree '(2 4))
+ (list->tree '(1 3))))) ; counter = 22
+
+(list->tree
+ (tree->list-1
+ (intersection-set-2 (list->tree '(2 4 6 8))
+ (list->tree '(1 3 5 7))))) ; counter = 42
+
+(list->tree
+ (tree->list-1
+ (intersection-set-2 (list->tree '(2 4 6 8 10 12 14 16))
+ (list->tree '(1 3 5 7 9 11 13 15))))) ; counter = 91
+
+(set! counter 0)
+
+(list->tree
+ (tree->list-1
+ (intersection-set-2 (list->tree '(1 3))
+ (list->tree '(1 3))))) ; counter = 25
+
+(list->tree
+ (tree->list-1
+ (intersection-set-2 (list->tree '(2 4 6 8))
+ (list->tree '(2 4 6 8))))) ; counter = 45
+
+(list->tree
+ (tree->list-1
+ (intersection-set-2 (list->tree '(1 3 5 7 9 11 13 15))
+ (list->tree '(1 3 5 7 9 11 13 15))))) ; counter = 85
+
+;; intersection-set-2 also grows linearly.
View
@@ -0,0 +1,35 @@
+
+;; From the book (searches linear sets)
+(define (lookup given-key set-of-records)
+ (cond ((null? set-of-records) false)
+ ((equal? given-key (key (car set-of-records)))
+ (car set-of-records))
+ (else (lookup given-key (cdr set-of-records)))))
+
+;; --------------------------
+
+(define alphabet-record
+ (list->tree '((1 'a) (3 'c) (4 'd) (7 'g) (8 'h))))
+; '((4 'd) ((1 'a) () ((3 'c) () ())) ((7 'g) () ((8 'h) () ())))
+
+(define key car)
+
+(key (entry alphabet-record)) ; 4
+
+;; New lookup for binary trees
+(define (lookup given-key tree-of-records)
+ (cond ((null? tree-of-records) false)
+ ((= given-key (key (entry tree-of-records)))
+ (entry tree-of-records))
+ ((< given-key (key (entry tree-of-records)))
+ (lookup given-key (left-branch tree-of-records)))
+ ((> given-key (key (entry tree-of-records)))
+ (lookup given-key (right-branch tree-of-records)))
+ (else (error "This location should be unreachable."))))
+
+
+(lookup 7 alphabet-record) ; '(7 'g)
+(lookup 1 alphabet-record) ; '(1 'a)
+(lookup 4 alphabet-record) ; '(4 'd)
+(lookup 2 alphabet-record) ; #f
+(lookup 9 alphabet-record) ; #f

0 comments on commit 9015a0b

Please sign in to comment.