;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;                             CLOSED HASHING
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define closed-hash-table
  (make-record-type "closed-hash-table" '(size vect hash member? retries)))
;;;
;;; Similar to open hashing, but here the bucket contains the actual 
;;; element (one man one bucket, that's what I say brother :)
;;; I have assumed that we are using a re-hashing strategy that may be
;;; linear. That is, retries is a list of values that are in turn added
;;; to the hash value to resolve collisions. To do linear re-hashing
;;; retries would be a list of length n, values 1 through to n.
;;; Consequently there will be (length (retries table)) rehashings
;;; on a collision. Alternatively we might "randomise" the list retries
;;; (and see misc.scm for a radomise function)
;;;

(define create-closed-hash-table
  (record-constructor closed-hash-table '(size vect hash member? retries)))

(define (make-closed-hash-table size hash member? retries)
  (create-closed-hash-table size (make-vector size '()) hash member? retries))

(define closed-hash-table? (record-predicate closed-hash-table))

(define size (record-accessor closed-hash-table 'size))
(define vect (record-accessor closed-hash-table 'vect))
(define hash  (record-accessor closed-hash-table 'hash))
(define member?  (record-accessor closed-hash-table 'member?))
(define retries  (record-accessor closed-hash-table 'retries))

(define (empty? locn)
  (null? locn))
;;;
;;; Given a location from a closed hash table, is it empty?
;;;

;~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

(define (hash-1 str buckets)
  (let ((hash 0)
	(l (string->list str)))
    (do ((l' l (cdr l')))
	((null? l') (modulo hash buckets))
      (let ((ch (car l')))
	(set! hash (+ hash (char->integer ch)))))))
;;;
;;; Straight copy from hash-open.scm See that file for comment
;;;

(define (insert e table)
  (let* ((h (hash table))
	 (v (vect table))
	 (s (size table))
	 (member? (member? table))
	 (h.of.e (h e s))                                   ; (1)
	 (locn h.of.e)
	 (free (or (empty? (vector-ref v locn))
		   (member? e (vector-ref v locn)))))       ; (2) 
    (do ((l (retries table) (cdr l)))                       ; (3)
	((or free (null? l)))
      (set! locn (modulo (+ h.of.e (car l)) s))             ; (4)
      (set! free (or (empty? (vector-ref v locn))           ; (5)
		     (member? e (vector-ref v locn)))))     ; (6) 
    (cond (free (vector-set! v locn e))                     ; (7)
	  (t 'table-full))))                                ; (8)
;;;
;;; Insert e in the closed hash table.
;;; (1) Get the hash value of e (h.of.e).
;;; (2) A rehashing search through the table until ...
;;; (3) until a free element has been found or the retries have been exhausted
;;; (4) the location to be probed will be h.of.e plus next retrie in l
;;; (5) the table entry is free at that location (ie. locn) if
;;;     the location is empty or ...
;;; (6) if the location is already occupied by a value the same as e 
;;;     (so we just over-write it with the same value :)
;;; (7) We've finished the search (do loop of (2->6) and have a free 
;;;     location, so we upd8 the location to have the value e, otherwise ...
;;; (8) didn't find a location that was free, so table's full folks!
;;; 
;;; 

(define (present? e table)
  (let* ((h (hash table))
	 (v (vect table))
	 (s (size table))
	 (member? (member? table))
	 (h.of.e (h e s))                                           ; (1)
         (locn h.of.e)
	 (found (and (not (empty? (vector-ref v locn)))
		     (member? e (vector-ref v locn)))))             ; (2)
    (do ((l (retries table) (cdr l)))                               ; (3)
	((or found (null? l) (empty? (vector-ref v locn))) found)   ; (4)
      (set! locn (modulo (+ h.of.e (car l)) s))                     ; (5)
      (set! found (member? e (vector-ref v locn))))))               ; (6)
;;;
;;; Is e in the hash table?
;;;
;;; (1) get the hash value of e (h.of.e)
;;; (2) Did the first probe find it?
;;; (3) Starting at the h.of.e do a rehash search through the table until ...
;;; (4) until e has been found or a maximum number of retries have been done
;;;     or (re)hashed to an empty location (so cant be there ???)
;;;     On finishing the loop deliver found as a result of the function
;;; (5) About to look at location h.of.e plus a retry value
;;; (6) We've found it if e is in the location
;;;

(define (file->table fname table)
  (let ((fin (open-input-file fname)))
    (do ((w (read-word fin) (read-word fin)))
	((eof-object? w) (close-input-port fin))
      (insert w table))))
;;;
;;; (file->table "/usr/dict/words" *t26000*)
;;;


(define (dictionary->table table)
  (let ((fin (open-input-file "/home/s7/pat/scheme/pub/dictionary.tex")))
    (do ((w (read fin) (read fin)))
	((eof-object? w))
      (insert (symbol->string w) table))))
;;;
;;; Reads into an open hash-table the 25,104 words in the above dictionary.
;;; The dictionary originated from /usr/dict/words but has
;;; all duplicates removed, and all sorted with respect to string<?
;;;

(define (show table)
  (do ((i 0 (+ i 1)))
      ((= i (size table)))
    (display (list i (vector-ref (vect table) i))) (newline)))
;;;
;;; Shameless copying ... for a living (what was my last original act?
;;; or have I never had one? ... sob)
;;;

    
(define *t26000* '())

(define (init)
  (let ((l '()))
    (do ((i 0 (+ i 1))) ((= i 20))
      (set! l (cons i l)))
    (set! l (randomise l))
    (set! *t26000* (make-closed-hash-table 26000 hash-1 string=? l))
    (dictionary->table *t26000*))
  'done)
;;;
;;; Creating a large closed hash table for experimentation
;;;