[ create a new paste ] login | about

Project: programmingpraxis
Link: http://programmingpraxis.codepad.org/bCRLwrVT    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Aug 24:
; hash tables with open addressing

(define (string-hash str)
  (let loop ((cs (string->list str)) (s 0))
    (if (null? cs) s
      (loop (cdr cs) (+ (* s 31)
        (char->integer (car cs)))))))

(define (make-hash m) (make-vector m #f))

(define (lookup eql? h t k)
  (let ((m (vector-length t)) (j (h k)))
    (let loop ((i 0))
      (let ((j+i (modulo (+ j i) m)))
        (cond ((= i m) #f)
              ((not (vector-ref t j+i)) #f)
              ((null? (vector-ref t j+i)) (loop (+ i 1)))
              ((eql? (car (vector-ref t j+i)) k)
                (vector-ref t j+i))
              (else (loop (+ i 1))))))))

(define (insert eql? h t k v)
  (let ((m (vector-length t)) (j (h k)))
    (let loop ((i 0))
      (let ((j+i (modulo (+ j i) m)))
        (cond ((= i m) (error 'insert "overflow"))
              ((not (vector-ref t j+i))
                (vector-set! t j+i (cons k v)) t)
              ((null? (vector-ref t j+i))
                (vector-set! t j+i (cons k v)) t)
              ((eql? (car (vector-ref t j+i)) k)
                (vector-set! t j+i (cons k v)) t)
              (else (loop (+ i 1))))))))

(define (delete eql? h t k)
  (let ((m (vector-length t)) (j (h k)))
    (let loop ((i 0))
      (let ((j+i (modulo (+ j i) m)))
        (cond ((= i m) t)
              ((not (vector-ref t j+i)) t)
              ((null? (vector-ref t j+i))
                (loop (+ i 1)))
              ((eql? (car (vector-ref t j+i)) k)
                (vector-set! t j+i (list)) t)
              (else (loop (+ i 1))))))))

(define (enlist t)
  (let loop ((m (vector-length t)) (kvs (list)))
    (cond ((zero? m) kvs)
          ((not (vector-ref t (- m 1))) (loop (- m 1) kvs))
          ((null? (vector-ref t (- m 1))) (loop (- m 1) kvs))
          (else (loop (- m 1) (cons (vector-ref t (- m 1)) kvs))))))

(define t (make-hash 20))
(set! t (insert string=? string-hash t "aaa" 1))
(set! t (insert string=? string-hash t "bbb" 2))
(set! t (insert string=? string-hash t "ccc" 3))
(set! t (insert string=? string-hash t "ddd" 4))
(set! t (insert string=? string-hash t "eee" 5))
(display t) (newline)
(set! t (insert string=? string-hash t "xxx" 24))
(set! t (delete string=? string-hash t "ccc"))
(display t) (newline)
(display (lookup string=? string-hash t "ddd")) (newline)
(display (lookup string=? string-hash t "ccc")) (newline)
(display (enlist t)) (newline)
(set! t (delete string=? string-hash t "xxx"))
(display t) (newline)


Output:
1
2
3
4
5
6
#((ddd . 4) (aaa . 1) #f #f #f #f #f (ccc . 3) #f #f #f #f #f (eee . 5) (bbb . 2) #f #f #f #f #f)
#((ddd . 4) (aaa . 1) (xxx . 24) #f #f #f #f () #f #f #f #f #f (eee . 5) (bbb . 2) #f #f #f #f #f)
(ddd . 4)
#f
((ddd . 4) (aaa . 1) (xxx . 24) (eee . 5) (bbb . 2))
#((ddd . 4) (aaa . 1) () #f #f #f #f () #f #f #f #f #f (eee . 5) (bbb . 2) #f #f #f #f #f)


Create a new paste based on this one


Comments: