exercise-2.66-binary-tree-lookup.rkt 4.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130
  1. #lang racket
  2. (require rackunit)
  3. (define (Mb-to-B n) (* n 1024 1024))
  4. (define MAX-BYTES (Mb-to-B 64))
  5. (define nil '())
  6. (custodian-limit-memory (current-custodian) MAX-BYTES)
  7. ; racket -l errortrace -t exercise-...
  8. (provide (all-defined-out))
  9. ;; gets the entry along a tree
  10. ;; (the root of the subbranches)
  11. (define (entry tree)
  12. (car tree))
  13. (define (left-branch tree)
  14. (cadr tree))
  15. (define (right-branch tree)
  16. (caddr tree))
  17. ;; creates a tree, given its right and left branch
  18. (define (make-tree entry left right)
  19. (list entry left right))
  20. ;; checks whether an element is in a binary tree or not
  21. (define (element-of-set-binary-tree? x myset)
  22. (cond
  23. [(empty? myset) (false)]
  24. [(= x (entry myset)) true]
  25. [(< x (entry myset)) (element-of-set-binary-tree? x (left-branch myset))]
  26. [(> x (entry myset)) (element-of-set-binary-tree? x (right-branch myset))]))
  27. ;; adds an element to a binary tree
  28. ;(define (adjoin-set x myset)
  29. ; (cond
  30. ; ;; if we do not have any elements yet, simply make a new tree with the given x
  31. ; [(empty? myset) (make-tree x nil nil)]
  32. ; ;; if we find the element x in the tree, we do not need to add it again (set logic)
  33. ; [(= x (entry myset)) myset]
  34. ; ;; if x is smaller than the current root of subbranches
  35. ; ;; we make a new tree with the x inserted somewhere in the left subbranch
  36. ; ;; this might eventually lead to an empty subtree, where we can simply insert the element or
  37. ; ;; to a root of subbranches, which is equal to the element x, in which case we do not add it at all
  38. ; [(< x (entry myset))
  39. ; (make-tree
  40. ; (entry myset)
  41. ; (adjoin-set x (left-branch myset))
  42. ; (right-branch myset))]
  43. ; ;; same as for the < case but for >
  44. ; [(> x (entry myset))
  45. ; (make-tree
  46. ; (entry myset)
  47. ; (left-branch myset)
  48. ; (adjoin-set x (right-branch myset)))]))
  49. ;; NEW IN EXERCISE 2.66
  50. ;; EXAMPLE CODE
  51. ;; for sets kept as unordered lists
  52. ;(define (lookup given-key set-of-records)
  53. ; (cond
  54. ; [(empty? set-of-records) false]
  55. ; [(equal? given-key (key (car set-of-records)))]
  56. ; [else (lookup given-key (cdr set-of-records))]))
  57. (define (list->tree elements)
  58. (car (partial-tree elements (length elements)))) ; calculating the length of a list is in O(n)
  59. (define (partial-tree elements total-size)
  60. (if
  61. (= total-size 0)
  62. (cons nil elements)
  63. (let
  64. [(left-size (quotient (- total-size 1) 2))]
  65. [let
  66. [(left-result (partial-tree elements left-size))]
  67. [let
  68. [(left-tree (car left-result))
  69. (non-left-elements (cdr left-result))
  70. (right-size (- total-size (+ left-size 1)))]
  71. [let
  72. [(this-entry (car non-left-elements))
  73. (right-result (partial-tree (cdr non-left-elements) right-size))]
  74. [let
  75. [(right-tree (car right-result))
  76. (remaining-elements (cdr right-result))]
  77. [cons (make-tree this-entry left-tree right-tree) remaining-elements]]]]])))
  78. ;; NEW IN EXERCISE 2.66
  79. ;; model a record as a list of two strings and a key
  80. (define (make-record key str1 str2)
  81. (list key (list str1 str2)))
  82. (define (key a-record)
  83. (first a-record))
  84. (define (record-data a-record)
  85. (rest a-record))
  86. ;; procedure for finding a record given a key in a binary tree
  87. (define (lookup-binary-tree given-key bin-tree-set-of-records)
  88. (display "LOOKING UP ") (display given-key) (newline)
  89. (if (not (empty? bin-tree-set-of-records))
  90. (begin (display "TREE IS ") (display bin-tree-set-of-records) (newline)
  91. (display "ENTRY IS ") (display (entry bin-tree-set-of-records)) (newline)
  92. (display "ENTRY KEY IS ") (display (key (entry bin-tree-set-of-records))) (newline)
  93. (display "LEFT IS ") (display (left-branch bin-tree-set-of-records)) (newline)
  94. (display "RIGHT IS ") (display (right-branch bin-tree-set-of-records)) (newline))
  95. (begin (display "TREE WAS EMPTY") (newline)))
  96. (cond
  97. [(empty? bin-tree-set-of-records)
  98. (display "TREE WAS EMPTY. return false") (newline)
  99. false]
  100. [(= given-key (key (entry bin-tree-set-of-records)))
  101. (display (string-append "SEARCHING FOR " (number->string given-key) " FOUND KEY")) (newline)
  102. (entry bin-tree-set-of-records)]
  103. [(< given-key (key (entry bin-tree-set-of-records)))
  104. (display (string-append "SEARCHING FOR " (number->string given-key) " given-key is smaller")) (newline)
  105. (lookup-binary-tree given-key (left-branch bin-tree-set-of-records))]
  106. [(> given-key (key (entry bin-tree-set-of-records)))
  107. (display (string-append "SEARCHING FOR " (number->string given-key) " given-key is greater")) (newline)
  108. (lookup-binary-tree given-key (right-branch bin-tree-set-of-records))]
  109. [else
  110. (display "strange case") (newline)]))