sorted vector fingertree

sortedlist.clj

(ns net.djpowell.fingertree.sortedlist
  (:gen-class)
  (:use clojure.data.finger-tree))

(defrecord SortedListMeter [^long lcount lmax])

(def ^:private not-an-object (gensym "not-an-object"))

(defn- make-object
  [x]
  (SortedListMeter. 1 x))

(def ^:private zero-object (SortedListMeter. 0 not-an-object))

(defn- combine-objects
  [cmpr ^SortedListMeter x ^SortedListMeter y]
  (cond
   (identical? zero-object x) y
   (identical? zero-object y) x
   :else (SortedListMeter.
          (+ (:lcount x) (:lcount y))
          (if (neg? (cmpr (:lmax x) (:lmax y))) (:lmax y) (:lmax x)))))

(defn- make-empty-sorted-list-tree
  ([]
     (make-empty-sorted-list-tree compare))
  ([cmpr]
     (finger-tree (meter make-object zero-object (partial combine-objects cmpr)))))

(defn- find-at
  [tree i not-found-fn]
  (if (and (> i 0) (< i (count tree)))
    (second
     (split-tree tree
                 (fn [{:keys [lcount lmax]}] (> lcount i))))
    (not-found-fn)))

(defn- insert-val
  [tree cmpr x]
  (let [lmax (:lmax (measured tree))]
    (cond
     (identical? lmax not-an-object) (conjr tree x)
     (<= (cmpr lmax x) 0) (conjr tree x)
     :else (let [[f n r] (split-tree tree
                                     (fn [{:keys [lcount lmax]}] (> 0 (cmpr x lmax))))]
             (ft-concat (conjr (conjr f x) n) r)
             ))))

(deftype SortedList [cmpr tree]
  clojure.lang.Counted
  clojure.lang.Sequential
  clojure.lang.Seqable
    (seq [this] (seq tree))
  clojure.lang.IPersistentCollection
    (count [this] (:lcount (measured tree)))
    (cons [this x] (SortedList. cmpr (insert-val tree cmpr x)))
    (empty [this] (SortedList. cmpr (make-empty-sorted-list-tree cmpr)))
    (equiv [this x] false) ; TODO ??
  clojure.lang.ISeq
    (first [_] (first tree))
    (more [_] (SortedList. cmpr (rest tree)))
    (next [_] (when-let [t (next tree)] (SortedList. cmpr t)))
  clojure.lang.Reversible
    (rseq [this] (rseq tree))
  clojure.lang.ILookup
    (valAt [this i] (find-at tree i #(constantly nil)))
    (valAt [this i default] (find-at tree i #(constantly default)))
  clojure.lang.Associative
    (containsKey [this i] (if (and (> i 0) (< i (count this))) true false))
    (assoc [this i x] (throw (UnsupportedOperationException. "Positional assoc not supported")))
    (entryAt [this i] (when-let [v (.valAt this i)] [i v]))
  clojure.lang.Indexed
    (nth [this i] (find-at tree i #(throw (IndexOutOfBoundsException. (str "Index " i " out of bounds; max length: " (count this))))))
    (nth [this i default] (find-at tree i #(constantly default)))
  clojure.lang.IPersistentStack
    (pop [this] (pop tree))
    (peek [this] (peek tree)))

(defn sorted-list
  ([]
     (sorted-list compare))
  ([cmpr]
     (SortedList. cmpr (make-empty-sorted-list-tree cmpr))))

(defn bad-into
  [base xs]
  (reduce (fn [ret x] (conj ret x)) base xs))

(defn -main
  []
  (Thread/sleep 10000)
  (bad-into (sorted-list) (repeatedly 1000000 #(rand-int 10000000))))