fork(1) download
copy 
  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
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
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))
https://ideone.com/6xFGsc
language:
Scheme (guile 2.2.4)
created:
4 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!