[ create a new paste ] login | about

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

programmingpraxis - Scheme, pasted on Aug 23:
; 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 t))))))

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


Create a new paste based on this one


Comments: