Implement till 2.66
parent
3c321654fb
commit
d461cbcac1
|
|
@ -0,0 +1,304 @@
|
|||
(load "util.scm")
|
||||
|
||||
(display "example - set via unordered list\n")
|
||||
|
||||
(define (element-of-set? x set)
|
||||
(cond ((null? set) false)
|
||||
((equal? x (car set)) true)
|
||||
(else (element-of-set? x (cdr set)))))
|
||||
|
||||
(define (adjoin-set x set)
|
||||
(if (element-of-set? x set)
|
||||
set
|
||||
(cons x set)))
|
||||
|
||||
(define (intersection-set s1 s2)
|
||||
(cond
|
||||
((or (null? s1) (null? s2)) '())
|
||||
((element-of-set? (car s1) s2) (cons (car s1) (intersection-set (cdr s1) s2)))
|
||||
(else (intersection-set (cdr s1) s2))))
|
||||
|
||||
(define s '(3 1 5))
|
||||
(display (element-of-set? 3 s)) (newline)
|
||||
(display (element-of-set? 4 s)) (newline)
|
||||
(display (adjoin-set 3 s)) (newline)
|
||||
(display (adjoin-set 4 s)) (newline)
|
||||
(display (intersection-set s '(3 1))) (newline)
|
||||
|
||||
|
||||
(display "\nex-2.59 - union-set") (newline)
|
||||
|
||||
(define (union-set s1 s2)
|
||||
(cond
|
||||
((null? s1) s2)
|
||||
((element-of-set? (car s1) s2) (union-set (cdr s1) s2))
|
||||
(else (union-set (cdr s1) (cons (car s1) s2)))))
|
||||
|
||||
|
||||
(display (union-set '(3 2 1) '(5 3))) (newline)
|
||||
|
||||
|
||||
(display "\nex-2.60 - set via list with duplicates") (newline)
|
||||
|
||||
; Does not change, but runtime increases because we have to iterate over the
|
||||
; duplicates.
|
||||
(define element-of-set?-dup element-of-set?)
|
||||
|
||||
(define s '(3 1 3 5))
|
||||
(display (element-of-set?-dup 3 s)) (newline)
|
||||
(display (element-of-set?-dup 4 s)) (newline)
|
||||
|
||||
; Runtime is constant.
|
||||
(define (adjoin-set-dup x set) (cons x set))
|
||||
(display (adjoin-set 3 s)) (newline)
|
||||
(display (adjoin-set 4 s)) (newline)
|
||||
|
||||
; Also stays the same, but becomes more expensive because of duplicates.
|
||||
(define intersection-set-dup intersection-set)
|
||||
(display (intersection-set s '(3 1))) (newline)
|
||||
|
||||
; We could also implement a version that de-duplicates but becomes even more
|
||||
; expensive.
|
||||
(define (intersection-set-dup s1 s2)
|
||||
(if (or (null? s1) (null? s2))
|
||||
'()
|
||||
(let ((rest (intersection-set-dup (cdr s1) s2)))
|
||||
(if (and (element-of-set?-dup (car s1) s2)
|
||||
(not (element-of-set?-dup (car s1) rest)))
|
||||
(adjoin-set-dup (car s1) rest)
|
||||
rest))))
|
||||
(display (intersection-set-dup s '(3 1))) (newline)
|
||||
|
||||
(define union-set-dup append)
|
||||
(display (union-set-dup '(3 2 1) '(5 3))) (newline)
|
||||
|
||||
; Applications that do a lot of adjoin and union operations would benefit from
|
||||
; this representation because they run in O(1) and O(n) runtime respectively.
|
||||
|
||||
(display "\nex-2.61 - set via ordered list") (newline)
|
||||
|
||||
(define (element-of-set? x set)
|
||||
(cond ((null? set) false)
|
||||
((= x (car set)) true)
|
||||
((< x (car set)) false)
|
||||
(else (element-of-set? x (cdr set)))))
|
||||
|
||||
(define (intersection-set s1 s2)
|
||||
(if (or (null? s1) (null? s2))
|
||||
'()
|
||||
(let ((x1 (car s1)) (x2 (car s2)))
|
||||
(cond
|
||||
((= x1 x2) (cons x1 (intersection-set (cdr s1) (cdr s2))))
|
||||
((< x1 x2) (intersection-set (cdr s1) s2))
|
||||
((> x1 x2) (intersection-set s1 (cdr s2)))))))
|
||||
|
||||
(define (adjoin-set x set)
|
||||
(cond
|
||||
((null? set) (list x))
|
||||
((= x (car set)) set)
|
||||
((< x (car set)) (cons x set))
|
||||
(else (cons (car set) (adjoin-set x (cdr set))))))
|
||||
|
||||
(define s '(1 3 5))
|
||||
(display (element-of-set? 3 s)) (newline)
|
||||
(display (element-of-set? 4 s)) (newline)
|
||||
(display (adjoin-set 3 s)) (newline)
|
||||
(display (adjoin-set 4 s)) (newline)
|
||||
(display (adjoin-set 4 '())) (newline)
|
||||
(display (adjoin-set 8 s)) (newline)
|
||||
(display (intersection-set s '(1 3))) (newline)
|
||||
|
||||
(display "\nex-2.62") (newline)
|
||||
|
||||
(define (union-set s1 s2)
|
||||
(cond
|
||||
((null? s1) s2)
|
||||
((null? s2) s1)
|
||||
(else
|
||||
(let ((x1 (car s1)) (x2 (car s2)))
|
||||
(cond
|
||||
((= x1 x2) (cons x1 (union-set (cdr s1) (cdr s2))))
|
||||
((< x1 x2) (cons x1 (union-set (cdr s1) s2)))
|
||||
((> x1 x2) (cons x2 (union-set s1 (cdr s2)))))))))
|
||||
|
||||
(display (union-set '(1 3 5 6 7) '(2 3 4 10))) (newline)
|
||||
|
||||
(assert (union-set (list 1 3 5) (list 2 4 6)) (list 1 2 3 4 5 6))
|
||||
(assert (union-set (list 1 3 5) '()) (list 1 3 5))
|
||||
(assert (union-set '() (list 1 3 5)) (list 1 3 5))
|
||||
(assert (union-set (list 1 2 5) (list 2 5 6)) (list 1 2 5 6))
|
||||
|
||||
(display "\nexample - set via binary tree\n")
|
||||
|
||||
(define (entry tree) (car tree))
|
||||
(define (left-branch tree) (cadr tree))
|
||||
(define (right-branch tree) (caddr tree))
|
||||
(define leaf '())
|
||||
(define (make-tree entry left right)
|
||||
(list entry left right))
|
||||
|
||||
(define (element-of-set? x set)
|
||||
(cond ((null? set) false)
|
||||
((= x (entry set)) true)
|
||||
((< x (entry set))
|
||||
(element-of-set? x (left-branch set)))
|
||||
((> x (entry set))
|
||||
(element-of-set? x (right-branch set)))))
|
||||
|
||||
(define (adjoin-set x set)
|
||||
(cond ((null? set) (make-tree x '() '()))
|
||||
((= x (entry set)) set)
|
||||
((< x (entry set))
|
||||
(make-tree (entry set)
|
||||
(adjoin-set x (left-branch set))
|
||||
(right-branch set)))
|
||||
((> x (entry set))
|
||||
(make-tree (entry set)
|
||||
(left-branch set)
|
||||
(adjoin-set x (right-branch set))))))
|
||||
|
||||
(define t (make-tree 7
|
||||
(make-tree 5
|
||||
(make-tree 4 leaf leaf)
|
||||
(make-tree 6 leaf leaf))
|
||||
(make-tree 11 leaf leaf)))
|
||||
|
||||
(display (element-of-set? 2 t)) (newline)
|
||||
(display (element-of-set? 6 t)) (newline)
|
||||
|
||||
|
||||
(display "\nex-2.63") (newline)
|
||||
|
||||
(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 '()))
|
||||
|
||||
; 7
|
||||
; / \
|
||||
; 5 11
|
||||
; / \
|
||||
; 4 6
|
||||
;
|
||||
; tree->list-1: (list 4 5 6 7 11)
|
||||
; tree->list-2: (list 4 5 6 7 11)
|
||||
|
||||
(assert (tree->list-1 t) (list 4 5 6 7 11))
|
||||
(assert (tree->list-2 t) (list 4 5 6 7 11))
|
||||
(display "a) The functions produce the same output.\n")
|
||||
(display "b) tree->list-1 is O(n*log(n)) because it uses append\n")
|
||||
(display " tree->list-2 is O(n) because each element is visited only once\n")
|
||||
|
||||
(display "\nex-2.64") (newline)
|
||||
|
||||
(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)))
|
||||
(cons (make-tree this-entry left-tree right-tree)
|
||||
remaining-elts))))))))
|
||||
|
||||
; a)
|
||||
;
|
||||
; Partial-tree uses a divide and conquer approach. For each step the list is
|
||||
; split into three parts. A left side, a current element and a right side. The
|
||||
; current element is the middle of the list. That way left side and right side
|
||||
; are of equal length or equal length minus one (depending on the parity of the
|
||||
; length of the list). For each half partial tree is called recursively and at
|
||||
; the end the result is put together. A list of the remaining elements is
|
||||
; propagated through the process.
|
||||
|
||||
; 5
|
||||
; / \
|
||||
; / \
|
||||
; 1 9
|
||||
; \ / \
|
||||
; 3 7 11
|
||||
|
||||
; b)
|
||||
;
|
||||
; Each element is touched once so it is O(n).
|
||||
|
||||
(display (list->tree '(1 2 3 4 5 6))) (newline)
|
||||
(display "[see comments]")
|
||||
(newline)
|
||||
|
||||
(display "\nex-2.65") (newline)
|
||||
|
||||
; 3 * O(n)
|
||||
(define (union-set-tree s1 s2)
|
||||
(list->tree (union-set (tree->list-1 s1)
|
||||
(tree->list-1 s2))))
|
||||
|
||||
(define t1 (list->tree (list 2 3 7)))
|
||||
(define t2 (list->tree (list 1 5 7)))
|
||||
|
||||
(display (union-set-tree t1 t2)) (newline)
|
||||
(assert (tree->list-1 (union-set-tree t1 t2))
|
||||
(list 1 2 3 5 7))
|
||||
|
||||
(define (intersection-set-tree set1 set2)
|
||||
(list->tree (intersection-set-list
|
||||
(tree->list-1 set1)
|
||||
(tree->list-1 set2))))
|
||||
|
||||
; Warning: These solutions only work for trees for which tree->list produces a
|
||||
; sorted listed.
|
||||
|
||||
|
||||
(display "\nex-2.66") (newline)
|
||||
|
||||
(define database
|
||||
(list (cons 1 "Aonso")
|
||||
(cons 3 "Linus")
|
||||
(cons 24 "Allan")))
|
||||
|
||||
(define key car)
|
||||
|
||||
(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)))))
|
||||
|
||||
(assert (lookup 24 database) (cons 24 "Allan"))
|
||||
(assert (lookup 262 database) #f)
|
||||
|
||||
(define (lookup given-key records)
|
||||
(if (null? records)
|
||||
#f
|
||||
(let ((current-key (key (entry records))))
|
||||
(cond ((= given-key current-key) (entry records))
|
||||
((< given-key current-key) (lookup given-key (left-branch records)))
|
||||
((> given-key current-key) (lookup given-key (right-branch records)))
|
||||
(else "OMG!")))))
|
||||
|
||||
(define database (list->tree database))
|
||||
(assert (lookup 24 database) (cons 24 "Allan"))
|
||||
(assert (lookup 262 database) #f)
|
||||
|
||||
128
ex-2_59-xx.scm
128
ex-2_59-xx.scm
|
|
@ -1,128 +0,0 @@
|
|||
(load "util.scm")
|
||||
|
||||
(display "example - set via unordered list\n")
|
||||
|
||||
(define (element-of-set? x set)
|
||||
(cond ((null? set) false)
|
||||
((equal? x (car set)) true)
|
||||
(else (element-of-set? x (cdr set)))))
|
||||
|
||||
(define (adjoin-set x set)
|
||||
(if (element-of-set? x set)
|
||||
set
|
||||
(cons x set)))
|
||||
|
||||
(define (intersection-set s1 s2)
|
||||
(cond
|
||||
((or (null? s1) (null? s2)) '())
|
||||
((element-of-set? (car s1) s2) (cons (car s1) (intersection-set (cdr s1) s2)))
|
||||
(else (intersection-set (cdr s1) s2))))
|
||||
|
||||
(define s '(3 1 5))
|
||||
(display (element-of-set? 3 s)) (newline)
|
||||
(display (element-of-set? 4 s)) (newline)
|
||||
(display (adjoin-set 3 s)) (newline)
|
||||
(display (adjoin-set 4 s)) (newline)
|
||||
(display (intersection-set s '(3 1))) (newline)
|
||||
|
||||
|
||||
(display "\nex-2.59 - union-set") (newline)
|
||||
|
||||
(define (union-set s1 s2)
|
||||
(cond
|
||||
((null? s1) s2)
|
||||
((element-of-set? (car s1) s2) (union-set (cdr s1) s2))
|
||||
(else (union-set (cdr s1) (cons (car s1) s2)))))
|
||||
|
||||
|
||||
(display (union-set '(3 2 1) '(5 3))) (newline)
|
||||
|
||||
|
||||
(display "\nex-2.60 - set via list with duplicates") (newline)
|
||||
|
||||
; Does not change, but runtime increases because we have to iterate over the
|
||||
; duplicates.
|
||||
(define element-of-set?-dup element-of-set?)
|
||||
|
||||
(define s '(3 1 3 5))
|
||||
(display (element-of-set?-dup 3 s)) (newline)
|
||||
(display (element-of-set?-dup 4 s)) (newline)
|
||||
|
||||
; Runtime is constant.
|
||||
(define (adjoin-set-dup x set) (cons x set))
|
||||
(display (adjoin-set 3 s)) (newline)
|
||||
(display (adjoin-set 4 s)) (newline)
|
||||
|
||||
; Also stays the same, but becomes more expensive because of duplicates.
|
||||
(define intersection-set-dup intersection-set)
|
||||
(display (intersection-set s '(3 1))) (newline)
|
||||
|
||||
; We could also implement a version that de-duplicates but becomes even more
|
||||
; expensive.
|
||||
(define (intersection-set-dup s1 s2)
|
||||
(if (or (null? s1) (null? s2))
|
||||
'()
|
||||
(let ((rest (intersection-set-dup (cdr s1) s2)))
|
||||
(if (and (element-of-set?-dup (car s1) s2)
|
||||
(not (element-of-set?-dup (car s1) rest)))
|
||||
(adjoin-set-dup (car s1) rest)
|
||||
rest))))
|
||||
(display (intersection-set-dup s '(3 1))) (newline)
|
||||
|
||||
(define union-set-dup append)
|
||||
(display (union-set-dup '(3 2 1) '(5 3))) (newline)
|
||||
|
||||
; Applications that do a lot of adjoin and union operations would benefit from
|
||||
; this representation because they run in O(1) and O(n) runtime respectively.
|
||||
|
||||
(display "\nex-2.61 - set via ordered list") (newline)
|
||||
|
||||
(define (element-of-set? x set)
|
||||
(cond ((null? set) false)
|
||||
((= x (car set)) true)
|
||||
((< x (car set)) false)
|
||||
(else (element-of-set? x (cdr set)))))
|
||||
|
||||
(define (intersection-set s1 s2)
|
||||
(if (or (null? s1) (null? s2))
|
||||
'()
|
||||
(let ((x1 (car s1)) (x2 (car s2)))
|
||||
(cond
|
||||
((= x1 x2) (cons x1 (intersection-set (cdr s1) (cdr s2))))
|
||||
((< x1 x2) (intersection-set (cdr s1) s2))
|
||||
((> x1 x2) (intersection-set s1 (cdr s2)))))))
|
||||
|
||||
(define (adjoin-set x set)
|
||||
(cond
|
||||
((null? set) (list x))
|
||||
((= x (car set)) set)
|
||||
((< x (car set)) (cons x set))
|
||||
(else (cons (car set) (adjoin-set x (cdr set))))))
|
||||
|
||||
(define s '(1 3 5))
|
||||
(display (element-of-set? 3 s)) (newline)
|
||||
(display (element-of-set? 4 s)) (newline)
|
||||
(display (adjoin-set 3 s)) (newline)
|
||||
(display (adjoin-set 4 s)) (newline)
|
||||
(display (adjoin-set 4 '())) (newline)
|
||||
(display (adjoin-set 8 s)) (newline)
|
||||
(display (intersection-set s '(1 3))) (newline)
|
||||
|
||||
(display "\nex-2.62") (newline)
|
||||
|
||||
(define (union-set s1 s2)
|
||||
(cond
|
||||
((null? s1) s2)
|
||||
((null? s2) s1)
|
||||
(else
|
||||
(let ((x1 (car s1)) (x2 (car s2)))
|
||||
(cond
|
||||
((= x1 x2) (cons x1 (union-set (cdr s1) (cdr s2))))
|
||||
((< x1 x2) (cons x1 (union-set (cdr s1) s2)))
|
||||
((> x1 x2) (cons x2 (union-set s1 (cdr s2)))))))))
|
||||
|
||||
(display (union-set '(1 3 5 6 7) '(2 3 4 10))) (newline)
|
||||
|
||||
(display "\nex-2.63") (newline)
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
(load "util.scm")
|
||||
|
||||
(display "\nex-2.66") (newline)
|
||||
|
||||
Loading…
Reference in New Issue