ht.clj

;; Singly-Linked List
(definterface INode
  (getCar [])
  (getCdr [])
  (setCar [x])
  (setCdr [x]))

(deftype Node
  [^:volatile-mutable car ^:volatile-mutable cdr]
  INode
  (getCar [_] car)
  (getCdr [_] cdr)
  (setCar [this x] (set! car x) this)
  (setCdr [this x] (set! cdr x) this)

  clojure.lang.Seqable
  (seq [this] (list this car cdr)))

(definterface ILinkedList
  (getHead [])
  (getNode [i])
  (findNode [pred])
  (delNode [i]))

(deftype LinkedList
  [^:volatile-mutable head]
  ILinkedList
  (getHead [_] head)
  (getNode [this i]
    (loop [prev nil cur head ith i]
      (if (zero? ith)
        [prev (first cur)]
        (recur (first cur) (last cur) (dec ith)))))
  (findNode [this pred]
    (loop [cur head i 0]
      (cond
        (not cur) nil
        (pred cur) i
        :else (recur (last cur) (inc i)))))
  (delNode [this i]
    (let [[prev n] (.getNode this i)]
      (when prev
        (.setCdr prev (.getCdr n)))))

  clojure.lang.IPersistentCollection
  (cons [this x] (set! head (Node. x head)) this)

  clojure.lang.Seqable
  (seq [this]
    (loop [cur head acc ()]
      (if-not cur
        acc
        (recur (.getCdr cur) (concat acc (list (seq cur)))))))

  clojure.lang.ISeq
  (first [_] (list head (.getCar head) (.getCdr head)))
  (next [this] (let [n (rest this)] (if (empty? n) nil n)))
  (more [this] (drop 1 this))

  clojure.lang.Reversible
  (rseq [this]
    (loop [new-head nil cur head nex (.getCdr cur)]
      (if-not cur
        (do (set! head new-head) this)
        (do (.setCdr cur new-head) (recur cur nex (if nex (.getCdr nex))))))))

(defn linked-list [& [cars]]
  (let [ll (LinkedList. (Node. (first cars) nil))]
    (reduce conj ll (rest cars))))


;; Hash Table
(definterface IHashTable
  (calcSize [])
  (maybeResize [])
  (setOccupancy [dir])
  (nodeKey [n])
  (nodeVal [n])
  (bucketIdx [k])
  (getBucket [k])
  (setBucket [k v occ])
  (delBucket [k])
  (getKey [k])
  (setKey [k v])
  (setKey [k v occ])
  (delKey [k]))

(deftype HashTable
  [^:volatile-mutable buckets
   ^:volatile-mutable occupancy
   ^:volatile-mutable size
   load-factor]
  IHashTable
  (calcSize [_]
    (when (-> occupancy zero? not)
      (cond
        (< occupancy (/ (* size load-factor) 2)) (/ size 2)  ;; shrink
        (> (/ occupancy size) load-factor) (* size 2))))     ;; grow
  (maybeResize [this]
    (when-let [new-size (.calcSize this)]
      (let [old-buckets buckets
            new-buckets (make-array LinkedList new-size)]
        (let [kvs (mapcat (fn [i]
                            (let [bucket (aget old-buckets i)]
                              (for [n bucket]
                                [(.nodeKey this n) (.nodeVal this n)])))
                          (range (alength old-buckets)))]
          (set! size new-size)
          (set! buckets new-buckets)
          (doseq [[k v] kvs] (.setKey this k v false))))))
  (setOccupancy [this dir]
    (when (= dir :inc)
      (set! occupancy (inc occupancy)))
    (when (= dir :dec)
      (set! occupancy (dec occupancy)))
    (when dir
      (.maybeResize this)))
  (nodeKey [_ n] (-> n first second first))
  (nodeVal [_ n] (-> n first second second))
  (bucketIdx [_ k] (mod (hash k) size))
  (getBucket [this k] (aget buckets (.bucketIdx this k)))
  (setBucket [this k v occ]
    (when occ (.setOccupancy this :inc))
    (aset buckets (.bucketIdx this k) v))
  (delBucket [this k]
    (.setOccupancy this :dec)
    (when-let [bucket (.getBucket this k)]
      (when-let [idx (.findNode bucket #(-> % second first (= k)))]
        (aset buckets (.bucketIdx this k) (.delNode bucket idx))))
    this)
  (getKey [this k]
    (let [bucket (.getBucket this k)]
      (loop [head (first bucket) more (next bucket)]
        (if (or (not head) (= (.nodeKey this head) k))
          (.nodeVal this head)
        (recur (first more) (next more))))))
  (setKey [this k v] (.setKey this k v true))
  (setKey [this k v occ]
    (if-let [bucket (.getBucket this k)]
      (loop [head (first bucket) more (next bucket)]
        (cond
          (not head) (.setBucket this k (conj bucket [k v]) occ)
          (= (.nodeKey this head) k) (.setCar (first head) [k v])
          :else (recur (first more) (next more))))
      (.setBucket this k (linked-list [[k v]]) occ))
    this)
  (delKey [this k] (.delBucket this k)))

(defn hash-table [& [size load-factor]]
  (let [size (or size 1)
        load-factor (or load-factor 7/10)]
  (HashTable. (make-array LinkedList size) 0 size load-factor)))