fork download
  1. ; hash tables with open addressing
  2.  
  3. (define (hash parm key)
  4. (let loop ((ks (string->list key)) (h 0))
  5. (if (null? ks) h
  6. (loop (cdr ks) (+ (* h parm) (char->integer (car ks)))))))
  7.  
  8. (display "linear probing") (newline)
  9.  
  10. (define m 7) ; small for testing
  11. (define ht (make-vector m 'empty))
  12.  
  13. (define (lookup ht eql? k)
  14. (let loop ((h (modulo (hash 31 k) m)))
  15. (let ((bucket (vector-ref ht h)))
  16. (cond ((eq? bucket 'empty) (list))
  17. ((and (pair? bucket)
  18. (eql? (car bucket) k)) bucket)
  19. (else (loop (modulo (+ h 1) m)))))))
  20.  
  21. (define (insert! ht eql? k v)
  22. (let loop ((h (modulo (hash 31 k) m)))
  23. (let ((bucket (vector-ref ht h)))
  24. (cond ((or (eq? bucket 'empty)
  25. (eq? bucket 'deleted)
  26. (eql? (car bucket) k))
  27. (vector-set! ht h (cons k v)) ht)
  28. (else (loop (modulo (+ h 1) m)))))))
  29.  
  30. (define (delete! ht eql? k)
  31. (let loop ((h (modulo (hash 31 k) m)))
  32. (let ((bucket (vector-ref ht h)))
  33. (cond ((eq? bucket 'empty) ht)
  34. ((and (pair? bucket)
  35. (eql? (car bucket) k))
  36. (vector-set! ht h 'deleted) ht)
  37. (else (loop (modulo (+ h 1) m)))))))
  38.  
  39. (define (enlist ht)
  40. (let loop ((h 0) (xs (list)))
  41. (if (= h m) xs
  42. (let ((bucket (vector-ref ht h)))
  43. (if (pair? bucket)
  44. (loop (+ h 1) (cons bucket xs))
  45. (loop (+ h 1) xs))))))
  46.  
  47. (set! ht (insert! ht string=? "a" 1))
  48. (set! ht (insert! ht string=? "c" 3))
  49. (set! ht (insert! ht string=? "e" 5))
  50. (set! ht (insert! ht string=? "f" 6))
  51. (set! ht (insert! ht string=? "g" 7))
  52. (set! ht (insert! ht string=? "h" 8))
  53. (display (length (enlist ht))) (newline)
  54. (set! ht (delete! ht string=? "c"))
  55. (set! ht (delete! ht string=? "g"))
  56. (display (lookup ht string=? "a")) (newline)
  57. (display (lookup ht string=? "c")) (newline)
  58. (display ht) (newline)
  59. (display (enlist ht)) (newline)
  60.  
  61. (newline) (display "double hashing") (newline)
  62.  
  63. (define m 7) ; small for testing
  64. (define ht (make-vector m 'empty))
  65.  
  66. (define (lookup ht eql? k)
  67. (let ((h2 (max (modulo (hash 37 k) m) 1)))
  68. (let loop ((h1 (modulo (hash 31 k) m)))
  69. (let ((bucket (vector-ref ht h1)))
  70. (cond ((eq? bucket 'empty) (list))
  71. ((and (pair? bucket)
  72. (eql? (car bucket) k))
  73. bucket)
  74. (else (loop (modulo (+ h1 h2) m))))))))
  75.  
  76. (define (insert! ht eql? k v)
  77. (let ((h2 (max (modulo (hash 37 k) m) 1)))
  78. (let loop ((h1 (modulo (hash 31 k) m)))
  79. (let ((bucket (vector-ref ht h1)))
  80. (cond ((or (eq? bucket 'empty)
  81. (eq? bucket 'deleted)
  82. (eql? (car bucket) k))
  83. (vector-set! ht h1 (cons k v)) ht)
  84. (else (loop (modulo (+ h1 h2) m))))))))
  85.  
  86. (define (delete! ht eql? k)
  87. (let ((h2 (max (modulo (hash 37 k) m) 1)))
  88. (let loop ((h1 (modulo (hash 31 k) m)))
  89. (let ((bucket (vector-ref ht h1)))
  90. (cond ((eq? bucket 'empty) ht)
  91. ((and (pair? bucket)
  92. (eql? (car bucket) k))
  93. (vector-set! ht h1 'deleted) ht)
  94. (else (loop (modulo (+ h1 h2) m))))))))
  95.  
  96. (define (enlist ht)
  97. (let loop ((h 0) (xs (list)))
  98. (if (= h m) xs
  99. (let ((bucket (vector-ref ht h)))
  100. (if (pair? bucket)
  101. (loop (+ h 1) (cons bucket xs))
  102. (loop (+ h 1) xs))))))
  103.  
  104. (set! ht (insert! ht string=? "a" 1))
  105. (set! ht (insert! ht string=? "c" 3))
  106. (set! ht (insert! ht string=? "e" 5))
  107. (set! ht (insert! ht string=? "f" 6))
  108. (set! ht (insert! ht string=? "g" 7))
  109. (set! ht (insert! ht string=? "h" 8))
  110. (display (length (enlist ht))) (newline)
  111. (set! ht (delete! ht string=? "c"))
  112. (set! ht (delete! ht string=? "g"))
  113. (display (lookup ht string=? "a")) (newline)
  114. (display (lookup ht string=? "c")) (newline)
  115. (display ht) (newline)
  116. (display (enlist ht)) (newline)
Success #stdin #stdout 0.02s 50592KB
stdin
Standard input is empty
stdout
linear probing
6
(a . 1)
()
#((h . 8) deleted empty (e . 5) (f . 6) deleted (a . 1))
((a . 1) (f . 6) (e . 5) (h . 8))

double hashing
6
(a . 1)
()
#(empty deleted (h . 8) (e . 5) (f . 6) deleted (a . 1))
((a . 1) (f . 6) (e . 5) (h . 8))