merge_sort.clj

(ns us.chouser.merge-sort
  "Experiments in parallel folding of vectors"
  (:require [clojure.core.reducers :as r]
            [criterium.core :as c]
            [dom-top.core :refer [loopr]]))

(set! *warn-on-reflection* true)

(defn array-type
  "Return a string representing the type of an array with dims
  dimentions and an element of type klass.
  For primitives, use a klass like Integer/TYPE
  Useful for type hints of the form: ^#=(array-type String) my-str-array"
  ([klass] (array-type klass 1))
  ([klass dims]
   (.getName (class
              (apply make-array
                     (if (symbol? klass) (eval klass) klass)
                     (repeat dims 0))))))

(defprotocol Insertable
  (insert-at! [coll i x] "Mutate collection by inserting value x at index i"))

(deftype PreAllocArray [^:volatile-mutable ^long len,
                        ^#=(array-type Long) a]
  clojure.lang.Seqable (seq [_] (take len a))
  clojure.lang.ILookup (valAt [_ i] (aget a i))
  clojure.lang.Counted (count [_] len)

  Insertable
  (insert-at! [this i x]
    (when (<= (alength a) len)
      (throw (ex-info "Overflowed pre-alloc size" {:size (alength a)})))
    (when (< len i)
      (throw (ex-info "Can't insert past end" {:i i :len len})))
    (set! len (inc len))
    (System/arraycopy a i a (inc i) (- len i))
    (aset a i x)
    this))

(defn ^PreAllocArray pre-alloc-array [size]
  (PreAllocArray. 0 (make-array Long size)))

(defn ^PreAllocArray join [^PreAllocArray p1, ^PreAllocArray p2]
  (let [len (+ (count p1) (count p2))
        p3 (PreAllocArray. len (make-array Long len))]
    (System/arraycopy (.a p1) 0 (.a p3) 0 (count p1))
    (System/arraycopy (.a p2) 0 (.a p3) (count p1) (count p2))
    p3))

(defn append! [paa item]
  (insert-at! paa (count paa) item))

(defn p [& args]
  (print (str (apply pr-str args) "\n"))
  (flush))

(defn find-i [a, ^long x]
  (loop [min-i 0, max-i (count a)]
    (if (<= max-i min-i)
      max-i
      (let [split (quot (+ min-i max-i) 2)]
        (if (< x (get a split))
          (recur min-i split)
          (recur (if (= split min-i)
                   (inc split)
                   split)
                 max-i))))))

(defn sorted-insert [coll x]
  (insert-at! coll (find-i coll x) x))

(defn insert-sort [coll]
  (reduce sorted-insert
          (pre-alloc-array (inc (count coll)))
          coll))

(defn merge-sort [coll]
  (let [fold-size 10000]
    (r/fold fold-size
            (fn combine
              ([] (pre-alloc-array fold-size))
              ([a b]
               (persistent!
                (loop [out (transient []), a (seq a), b (seq b)]
                  (let [[ax] a, [bx] b]
                    (cond
                      (nil? a) (reduce conj! out b)
                      (nil? b) (reduce conj! out a)
                      (< ax bx) (recur (conj! out ax) (next a) b)
                      :else (recur (conj! out bx) a (next b))))))))
            sorted-insert
            coll)))

(defn sort-transient [v]
  (if (not (instance? clojure.lang.ITransientCollection v))
    v
    (sort (persistent! v))))

(defn merge-sort2 [coll]
  (let [fold-size 6000]
    (r/fold fold-size
            (fn combine
              ([] (transient []))
              ([a b]
               (persistent!
                (loop [out (transient []), a (sort-transient a), b (sort-transient b)]
                  (let [[ax] a, [bx] b]
                    (cond
                      (nil? a) (reduce conj! out b)
                      (nil? b) (reduce conj! out a)
                      (< ax bx) (recur (conj! out ax) (next a) b)
                      :else (recur (conj! out bx) a (next b))))))))
            conj!
            coll)))

(defn merge-sort3 [coll]
  (let [fold-size 5000]
    (r/fold fold-size
            (fn combine
              ([] (pre-alloc-array (+ 5 fold-size)))
              ([a b] (let [p (join a b)]
                       (java.util.Arrays/sort ^#=(array-type Long) (.a p))
                       p)))
            append!
            coll)))

(defn check
  [orig sorted]
  (assert (= (count orig) (count sorted)))
  (assert (every? (fn [[a b]] (<= a b)) (partition 2 1 sorted)))
  (assert (= (set orig) (set sorted)))
  {:sorted (count sorted)})

(def nums (into [] (repeatedly 1000000 #(long (rand-int 100000)))))

(comment

  (time (dotimes [_ 3] (sort nums)))

  (time (dotimes [_ 3] (merge-sort nums)))

  (time (dotimes [_ 3] (merge-sort2 nums)))

  (time (dotimes [_ 3] (merge-sort3 nums)))

  )