datastructures.skip_list.clj

(ns datastructures.skip-list)

(defn lt [a b]
  (if (nil? a)
    false
    (case (compare a b)
      1 false
      0 false
      -1 true)))

(definterface INode
  (getKey [])
  (setKey [k])
  (getVal [])
  (setVal [v]))

(deftype Node
  [^:volatile-mutable key
   ^:volatile-mutable val
   ^objects           forward]
  INode
  (getKey [_] key)
  (setKey [_ k] (set! key k))
  (getVal [_] val)
  (setVal [_ v] (set! val v)))

(defn make-node [lvl k v] (Node. k v (make-array INode lvl)))

(defn forward-ith
  [^Node node i]
  (when node
    (when-let [^objects forward (.forward node)]
      (aget forward i))))

(defn forward-ith-key
  [node i]
  (when-let [^INode forward-node (forward-ith node i)]
    (.getKey forward-node)))

(definterface ISkipList
  (randomLevel [])
  (search [k])
  (insert [k v])
  (delete [k]))

(deftype SkipList
  [^:volatile-mutable ^INode   header
   ^:volatile-mutable ^Integer level
   ^:volatile-mutable ^Integer max-level
   ^:volatile-mutable ^float   p]

  ISkipList
  (randomLevel [_]
    (loop [lvl 1]
      (if (and (< (rand) p) (< lvl max-level))
        (recur (inc lvl))
        lvl)))

  (search [_ k]
    (let [^INode node (last (for [i (range level -1 -1)]
                   (loop [node header]
                     (if (lt (forward-ith-key node i) k)
                       (recur (forward-ith node i))
                       (forward-ith node 0)))))]
      (when (and node (= (.getKey node) k)) (.getVal node))))

  (insert [this k v]
    (let [^objects update (make-array INode max-level)

          ;; For the reversed range of our current level, max inclusive, we
          ;; need to look for a node containing a key that's strictly less than
          ;; our search key. Here we recursively search for such a node,
          ;; descending the current node's `forward`, beginning with `header`.
          ;; 
          ;; If the key we find in the current node is less than the search
          ;; key, we know we must move horizontally, to the ith `forward`. This
          ;; becomes our new node. When we find a node where the key is greater
          ;; than the search key, we exit the loop, setting ith of `update` to
          ;; the current node and returning the 0th `forward` or nil.
          ^INode node (last (for [i (range level -1 -1)]
                       (loop [node header]
                         (if (lt (forward-ith-key node i) k)
                            (recur (forward-ith node i))
                            (do (aset update i node)
                              (forward-ith node 0))))))]

      ;; Check for an exact match, if we find one, update the node's value and
      ;; be done. Otherwise we need to insert a new node at a random level and
      ;; update its neighbors' pointers.
      (if (and node (-> node .getKey (= k)))
        (.setVal node v)
        (let [lvl (.randomLevel this)]
          (when (> lvl level)
            (do (doseq [i (range level lvl)] (aset update i header))
                (set! level lvl)))

          ;; Insert a new node at the random level `lvl`. This entails
          ;; iterating over the update array we created earlier, extracting
          ;; each index for `lvl`. These indexes map to the right-most nodes
          ;; directly to the left of the node to be inserted. As such, their
          ;; forward pointers should become the forward pointers of the new
          ;; node, similarly these forward pointers should then point to the
          ;; new node.
          (let [^Node node (make-node lvl k v)]
            (doseq [i (range lvl)]
              (when-let [^Node update-node (aget update i)]
                (aset ^objects (.forward node) i (forward-ith update-node i))
                (aset ^objects (.forward update-node) i node))))))))

  (delete [_ k]
    (let [^objects update (make-array INode max-level)
          ^INode node (last (for [i (range level -1 -1)]
                       (loop [node header]
                         (if (lt (forward-ith-key node i) k)
                           (recur (forward-ith node i))
                           (do (aset update i node)
                               (forward-ith node 0))))))]
      (when (and node (-> node .getKey (= k)))
        (do (doseq [i (range level)]
          (when-let [^Node update-node (aget update i)]
            (when (-> update-node (forward-ith i) (= node))
              (aset ^objects (.forward update-node) i (forward-ith node i)))))
            (while (and (> level 0)
                        (nil? (aget ^objects (.forward ^Node header) level)))
                (set! level (dec level))))))))

(defn skip-list
  [& [max-level p]]
  (let [max-level (or max-level 32)]
    (SkipList. (make-node max-level nil nil) 0 max-level (or p 1/2))))

;; TODO: move to proper testing namespace
(require '[simple-check.core :as sc])
(require '[simple-check.generators :as gen])
(require '[simple-check.properties :as prop])

(def gkey (gen/choose 0 16))
(def gvalue gen/string-ascii)
(def gget-op (gen/fmap (fn [k] [:get k]) gkey))
(def gset-op (gen/bind gkey (fn [k] (gen/fmap (fn [v] [:set k v]) gvalue))))
(def gdel-op (gen/fmap (fn [k] [:delete k]) gkey))

(def ops (gen/list (gen/one-of [gget-op gset-op])))

(defn apply-op [m [t k v]]
  (if (instance? ISkipList m)
    (condp = t
      :get
      (.search ^ISkipList m k)
      :set
      (do (.insert ^ISkipList m k v) nil)
      :del
      (do (.delete ^ISkipList m k) nil)
      nil)
    (condp = t
      :get
      (get m k)
      :set
      (do (assoc! m k v) nil)
      :del
      (do (dissoc! m k) nil)
      nil)))

(def prop-basic-ops
  (prop/for-all [op ops]
                (let [a (apply-op (skip-list) op)
                      b (apply-op (transient (hash-map)) op)]
                  (if (= a b)
                    true
                    (print (prn-str a) " != " (prn-str b))))))

(sc/quick-check 1e2 prop-basic-ops)