Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 56 lines (44 sloc) 1.275 kB
692ddc0 @purcell Add heapsort solution, translated from the bad-ass OCaml solution
authored
1 ;; http://rosettacode.org/wiki/Heapsort#Clojure
2
3 (defn- swap [a i j]
4 (assoc a i (nth a j) j (nth a i)))
5
6 (defn- sift [a pred k l]
7 (loop [a a x k y (inc (* 2 k))]
8 (if (< (inc (* 2 x)) l)
9 (let [ch (if (and (< y (dec l)) (pred (nth a y) (nth a (inc y))))
10 (inc y)
11 y)]
12 (if (pred (nth a x) (nth a ch))
13 (recur (swap a x ch) ch (inc (* 2 ch)))
14 a))
15 a)))
16
17 (defn heapsort
18 ([a pred]
19 (let [len (count a)]
20 (reduce (fn [c term] (sift (swap c term 0) pred 0 term))
21 (reduce (fn [c i] (sift c pred i len))
22 (vec a)
23 (range (dec (int (/ len 2))) -1 -1))
24 (range (dec len) 0 -1))))
25 ([a]
26 (heapsort a <)))
27
28
29 (comment "
30 --- OCAML ORIGINAL ---
31
32 let heapsort a =
33
34 let swap i j =
35 let t = a.(i) in a.(i) <- a.(j); a.(j) <- t in
36
37 let sift k l =
38 let rec check x y =
39 if 2*x+1 < l then
40 let ch =
41 if y < l-1 && a.(y) < a.(y+1) then y+1 else y in
42 if a.(x) < a.(ch) then (swap x ch; check ch (2*ch+1)) in
43 check k (2*k+1) in
44
45 let len = Array.length a in
46
47 for start = (len/2)-1 downto 0 do
48 sift start len;
49 done;
50
51 for term = len-1 downto 1 do
52 swap term 0;
53 sift 0 term;
54 done;;
55 ")
Something went wrong with that request. Please try again.