sarabander/p2pu-sicp

binary trees

1 parent 5ba8704 commit 9015a0bc7580230591bd66a4d7384d10f02edada 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
 @@ -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).
 @@ -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.
 @@ -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.
 @@ -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