; hash tables with open addressing

(define (hash parm key)
  (let loop ((ks (string->list key)) (h 0))
    (if (null? ks) h
      (loop (cdr ks) (+ (* h parm) (char->integer (car ks)))))))

(display "linear probing") (newline)

(define m 7) ; small for testing
(define ht (make-vector m 'empty))

(define (lookup ht eql? k)
  (let loop ((h (modulo (hash 31 k) m)))
    (let ((bucket (vector-ref ht h)))
      (cond ((eq? bucket 'empty) (list))
            ((and (pair? bucket)
                  (eql? (car bucket) k)) bucket)
            (else (loop (modulo (+ h 1) m)))))))

(define (insert! ht eql? k v)
  (let loop ((h (modulo (hash 31 k) m)))
    (let ((bucket (vector-ref ht h)))
      (cond ((or (eq? bucket 'empty)
                 (eq? bucket 'deleted)
                 (eql? (car bucket) k))
              (vector-set! ht h (cons k v)) ht)
            (else (loop (modulo (+ h 1) m)))))))

(define (delete! ht eql? k)
  (let loop ((h (modulo (hash 31 k) m)))
    (let ((bucket (vector-ref ht h)))
      (cond ((eq? bucket 'empty) ht)
            ((and (pair? bucket)
                  (eql? (car bucket) k))
              (vector-set! ht h 'deleted) ht)
            (else (loop (modulo (+ h 1) m)))))))

(define (enlist ht)
  (let loop ((h 0) (xs (list)))
    (if (= h m) xs
      (let ((bucket (vector-ref ht h)))
        (if (pair? bucket)
            (loop (+ h 1) (cons bucket xs))
            (loop (+ h 1) xs))))))

(set! ht (insert! ht string=? "a" 1))
(set! ht (insert! ht string=? "c" 3))
(set! ht (insert! ht string=? "e" 5))
(set! ht (insert! ht string=? "f" 6))
(set! ht (insert! ht string=? "g" 7))
(set! ht (insert! ht string=? "h" 8))
(display (length (enlist ht))) (newline)
(set! ht (delete! ht string=? "c"))
(set! ht (delete! ht string=? "g"))
(display (lookup ht string=? "a")) (newline)
(display (lookup ht string=? "c")) (newline)
(display ht) (newline)
(display (enlist ht)) (newline)

(newline) (display "double hashing") (newline)

(define m 7) ; small for testing
(define ht (make-vector m 'empty))

(define (lookup ht eql? k)
  (let ((h2 (max (modulo (hash 37 k) m) 1)))
    (let loop ((h1 (modulo (hash 31 k) m)))
      (let ((bucket (vector-ref ht h1)))
        (cond ((eq? bucket 'empty) (list))
              ((and (pair? bucket)
                    (eql? (car bucket) k))
                bucket)
              (else (loop (modulo (+ h1 h2) m))))))))

(define (insert! ht eql? k v)
  (let ((h2 (max (modulo (hash 37 k) m) 1)))
    (let loop ((h1 (modulo (hash 31 k) m)))
      (let ((bucket (vector-ref ht h1)))
        (cond ((or (eq? bucket 'empty)
                   (eq? bucket 'deleted)
                   (eql? (car bucket) k))
                (vector-set! ht h1 (cons k v)) ht)
              (else (loop (modulo (+ h1 h2) m))))))))

(define (delete! ht eql? k)
  (let ((h2 (max (modulo (hash 37 k) m) 1)))
    (let loop ((h1 (modulo (hash 31 k) m)))
      (let ((bucket (vector-ref ht h1)))
        (cond ((eq? bucket 'empty) ht)
              ((and (pair? bucket)
                    (eql? (car bucket) k))
                (vector-set! ht h1 'deleted) ht)
              (else (loop (modulo (+ h1 h2) m))))))))

(define (enlist ht)
  (let loop ((h 0) (xs (list)))
    (if (= h m) xs
      (let ((bucket (vector-ref ht h)))
        (if (pair? bucket)
            (loop (+ h 1) (cons bucket xs))
            (loop (+ h 1) xs))))))

(set! ht (insert! ht string=? "a" 1))
(set! ht (insert! ht string=? "c" 3))
(set! ht (insert! ht string=? "e" 5))
(set! ht (insert! ht string=? "f" 6))
(set! ht (insert! ht string=? "g" 7))
(set! ht (insert! ht string=? "h" 8))
(display (length (enlist ht))) (newline)
(set! ht (delete! ht string=? "c"))
(set! ht (delete! ht string=? "g"))
(display (lookup ht string=? "a")) (newline)
(display (lookup ht string=? "c")) (newline)
(display ht) (newline)
(display (enlist ht)) (newline)