1 #lang racket 2 3 ;;;;;;;;;;;;;;;;;;;2.66 4 (define (lookup given-key set-of-records) 5 (cond ((null? set-of-records) false) 6 ((= given-key (key (car set-of-records))) 7 (car set-of-records)) 8 ((< given-key (key (car set-of-records))) 9 (lookup given-key (left-branch set-of-records))) 10 ((> given-key (key (car set-of-records))) 11 (lookup given-key (right-branch set-of-records))))) 12 13 ;;;;;;;;;;;;;;;;;;;; 14 (define (list->tree elements) 15 (car (partial-tree elements (length elements)))) 16 17 (define (partial-tree elts n) 18 (if (= n 0) 19 (cons '() elts) 20 (let ((left-size (quotient (- n 1) 2))) 21 (let ((left-result (partial-tree elts left-size))) 22 (let ((left-tree (car left-result)) 23 (non-left-elts (cdr left-result)) 24 (right-size (- n (+ left-size 1)))) 25 (let ((this-entry (car non-left-elts)) 26 (right-result (partial-tree (cdr non-left-elts) 27 right-size))) 28 (let ((right-tree (car right-result)) 29 (remaining-elts (cdr right-result))) 30 (cons (make-tree this-entry left-tree right-tree) 31 remaining-elts)))))))) 32 33 (define (key record) (car record)) 34 (define (data record) (cdr record)) 35 (define (make-record key data) (cons key data)) 36 ;;;;;;;;;;;;;;;;;;;; 37 (define (entry tree) (car tree)) 38 39 (define (left-branch tree) (cadr tree)) 40 41 (define (right-branch tree) (caddr tree)) 42 43 (define (make-tree entry left right) 44 (list entry left right)) 45 46 47 ;;;;;;;;;;;;;;;;;;;; 48 49 (define record1 (make-record 3 '(yosoro 18 2017))) 50 (define record2 (make-record 7 '(umi 12 2014))) 51 (define record3 (make-record 4 '(nico 15 2088))) 52 (define record4 (make-record 10 '(qika 11 2156))) 53 (define record5 (make-record 11 '(maki 12 1998))) 54 55 (define database 56 (list record1 record2 record3 record4 record5)) 57 58 (define tree-database (list->tree database)) 59 60 ;;;;;;;;;;;;;;;;;;;test 61 62 (lookup 3 tree-database) 63 64 (lookup 10 tree-database) 65 66 (lookup 6 tree-database)