-
Notifications
You must be signed in to change notification settings - Fork 5
/
merge_sort.clj
55 lines (48 loc) · 1.7 KB
/
merge_sort.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
(ns parallel.merge-sort
(:refer-clojure :exclude [sort])
(:require [clojure.core.reducers :as r])
(:import
[java.util.concurrent Callable ForkJoinPool]
[java.util Arrays Comparator]))
(set! *warn-on-reflection* true)
(definterface IMergeSort
(merge [mid])
(sort []))
(deftype MergeSort [^objects a
^int lo
^int hi
^int threshold
^Comparator cmp]
Callable
(call [this] (.sort this))
IMergeSort
(merge [this mid]
(when (pos? (.compare cmp (aget a (dec mid)) (aget a mid)))
(let [size (- hi lo)
lsize (- mid lo)
^objects aux (object-array size)]
(System/arraycopy a lo aux 0 size)
(loop [k lo i 0 j lsize]
(when (< k hi)
(if (or (>= j size) (and (< i lsize) (neg? (.compare cmp (aget aux i) (aget aux j)))))
(do (aset a k (aget aux i)) (recur (inc k) (inc i) j))
(do (aset a k (aget aux j)) (recur (inc k) i (inc j)))))))))
(sort [this]
(let [size (- hi lo)]
(if (<= size threshold)
(Arrays/sort a lo hi cmp)
(let [mid (+ lo (bit-shift-right size 1))
l (MergeSort. a lo mid threshold cmp)
h (MergeSort. a mid hi threshold cmp)]
(let [fc (fn [^Callable child] #(.call child))]
(#'r/fjinvoke
#(let [f1 (fc l)
t2 (#'r/fjtask (fc h))]
(#'r/fjfork t2)
(f1)
(#'r/fjjoin t2)
(.merge this mid)))))))))
(defn sort [threshold cmp ^objects a]
(let [n (alength a)
^ForkJoinPool pool @r/pool]
(.join (.submit pool (MergeSort. a 0 n threshold cmp)))))