Re: Efficiency and flexibility of hash-tables

[Joris van der Hoeven]

> The 'adaptive hash tables' are stored as a pair with a usual hashtable and
> its number of entries. I have tested the code a bit and it seems to work.
> If you find any bugs, then please let me know.

Here follows a slight improvement of the code for the case that
you want to use boolean values for the entries of the hash table.
Notice also that the hash value of the key is computed twice
whenever you want to assign a value to a key;
in a more low-level implementation, the second call can be avoided.

Best wishes, Joris


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; MODULE      : ahash-table.scm
;; DESCRIPTION : adaptive hash tables
;; COPYRIGHT   : (C) 2003  Joris van der Hoeven
;;
;; This software falls under the GNU general public license and comes WITHOUT
;; ANY WARRANTY WHATSOEVER. See the file $TEXMACS_PATH/LICENSE for details.
;; If you don't have this file, write to the Free Software Foundation, Inc.,
;; 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Adaptive hash tables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (make-ahash-table)
  (cons (make-hash-table 1) 0))

(define (ahash-ref h key)
  (hash-ref (car h) key))

(define (ahash-get-handle h key)
  (hash-get-handle (car h) key))

(define (ahash-size h)
  (cdr h))

(define (ahash-slots! h new-size)
  (let ((new-h (make-hash-table new-size)))
    (hash-fold (lambda (key value dummy) (hash-set! new-h key value))
               #f (car h))
    (set-car! h new-h)))

(define (ahash-set! h key value)
  (if (hash-get-handle (car h) key)
      (hash-set! (car h) key value)
      (begin
        (if (>= (cdr h) (vector-length (car h)))
            (ahash-slots! h (+ (* 2 (vector-length (car h))) 1)))
        (set-cdr! h (+ (cdr h) 1))
        (hash-set! (car h) key value))))

(define (ahash-remove! h key)
  (let ((removed (hash-remove! (car h) key)))
    (if removed
        (begin
          (set-cdr! h (- (cdr h) 1))
          (if (< (+ (* 4 (cdr h)) 1) (vector-length (car h)))
              (ahash-slots! h (quotient (vector-length (car h)) 2)))))
    removed))

(define (ahash-fold h)
  (hash-fold (car h)))