[ create a new paste ] login | about

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

programmingpraxis - Scheme, pasted on Sep 2:
; hash tables with open addressing
; knuth aocp3 sec 6.4 algo L and R

(define (filter pred? xs)
  (let loop ((xs xs) (ys '()))
    (cond ((null? xs) (reverse ys))
          ((pred? (car xs))
            (loop (cdr xs) (cons (car xs) ys)))
          (else (loop (cdr xs) ys)))))

(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 len) (make-vector len (list)))

(define (lookup eql? hash table key)
  (let* ((len (vector-length table)) (n len))
    (let loop ((i (modulo (hash key) len)) (n n))
      (cond ((or (zero? n) (null? (vector-ref table i))) #f)
            ((eql? (car (vector-ref table i)) key) (vector-ref table i))
            (else (loop (modulo (- i 1) len) (- n 1)))))))

(define (insert eql? hash table key value)
  (let* ((len (vector-length table)) (n len))
    (let loop ((i (modulo (hash key) len)) (n n))
      (cond ((zero? n) (error 'insert "overflow"))
            ((or (null? (vector-ref table i))
                 (eql? (car (vector-ref table i)) key))
              (vector-set! table i (cons key value)) table)
            (else (loop (modulo (- i 1) len) (- n 1)))))))

(define (delete eql? hash table key)
  (let* ((len (vector-length table)) (n len))
    (let loop ((i (modulo (hash key) len)) (n n))
      (cond ((or (zero? n) (null? (vector-ref table i))) table)
            ((eql? (car (vector-ref table i)) key)
              (let loop1 ((i i))
                (vector-set! table i (list))
                (let ((j i))
                  (let loop2 ((i (modulo (- i 1) len)))
                    (if (null? (vector-ref table i)) table
                      (let ((r (modulo (hash (car (vector-ref table i))) len)))
                        (cond ((or (< (- i 1) r j) (< r j i) (< j i (+ r 1)))
                                (loop2 (modulo (- i 1) len)))
                        (else (vector-set! table j (vector-ref table i))
                              (loop1 i)))))))))
            (else (loop (modulo (- i 1) len) (- n 1)))))))

(define (enlist table) (filter pair? (vector->list table)))

(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)

; due to madscifi
(define t (make-hash 5))
(set! t (insert string=? (lambda (x) 1) t "aaa" 1))
(set! t (insert string=? (lambda (x) 1) t "bbb" 1))
(set! t (delete string=? (lambda (x) 1) t "aaa"))
(set! t (insert string=? (lambda (x) 1) t "bbb" 2))
(display t) (newline)


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


Create a new paste based on this one


Comments: