Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* Copyright (C) 2009,2017 Matthew Fluet. |
2 | * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh | |
3 | * Jagannathan, and Stephen Weeks. | |
4 | * | |
5 | * MLton is released under a BSD-style license. | |
6 | * See the file MLton-LICENSE for details. | |
7 | *) | |
8 | ||
9 | structure QuickSort: QUICK_SORT = | |
10 | struct | |
11 | ||
12 | open Array | |
13 | ||
14 | val rand = Word.toIntX o Random.word | |
15 | ||
16 | fun randInt (lo, hi) = lo + Int.mod (rand(), hi - lo + 1) | |
17 | ||
18 | (* quicksort based on section 10.2 of Programming Pearls, by Bentley. | |
19 | * It does repeated partitioning until the segment size is less than the cutoff. | |
20 | * Then, it does an insertion sort over the whole array to fix up the unsorted | |
21 | * segments. | |
22 | *) | |
23 | fun 'a sortArray (a: 'a array, op <= : 'a * 'a -> bool): unit = | |
24 | if 0 = Array.length a | |
25 | then () | |
26 | else | |
27 | let | |
28 | fun x i = sub (a, i) | |
29 | fun swap (i, j) = | |
30 | let | |
31 | val t = x i | |
32 | val () = update (a, i, x j) | |
33 | val () = update (a, j, t) | |
34 | in | |
35 | () | |
36 | end | |
37 | val cutoff = 20 | |
38 | fun qsort (l: int, u: int): unit = | |
39 | if Int.<= (u - l, cutoff) | |
40 | then () | |
41 | else | |
42 | let | |
43 | val () = swap (l, randInt (l, u)) | |
44 | val t = x l | |
45 | (* Partition based on page 115. *) | |
46 | fun loop (i, j) = | |
47 | let | |
48 | fun loopUp i = | |
49 | let | |
50 | val i = i + 1 | |
51 | in | |
52 | (* The sentinel guarantees that x i is OK. *) | |
53 | if t <= x i | |
54 | then i | |
55 | else loopUp i | |
56 | end | |
57 | val i = loopUp i | |
58 | fun loopDown j = | |
59 | let | |
60 | val j = j - 1 | |
61 | in | |
62 | if x j <= t | |
63 | then j | |
64 | else loopDown j | |
65 | end | |
66 | val j = loopDown j | |
67 | in | |
68 | if j < i | |
69 | then (i, j) | |
70 | else (swap (i, j); loop (i, j)) | |
71 | end | |
72 | val (i, j) = loop (l, u + 1) | |
73 | val () = swap (l, j) | |
74 | val () = qsort (l, j - 1) | |
75 | val () = qsort (i, u) | |
76 | in | |
77 | () | |
78 | end | |
79 | (* Put a maximal element at the end to use as a sentinel. *) | |
80 | val (m, _) = | |
81 | Array.foldi | |
82 | (a, (0, Array.sub (a, 0)), fn (i, xi, (m, xm)) => | |
83 | if xi <= xm | |
84 | then (m, xm) | |
85 | else (i, xi)) | |
86 | val last = length a - 1 | |
87 | val () = swap (m, last) | |
88 | val () = qsort (0, last - 1) | |
89 | val () = InsertionSort.sort (a, op <=) | |
90 | in | |
91 | () | |
92 | end | |
93 | ||
94 | local | |
95 | fun make (from, to) (l, f) = | |
96 | let | |
97 | val a = from l | |
98 | val () = sortArray (a, f) | |
99 | in | |
100 | to a | |
101 | end | |
102 | in | |
103 | val sortList = fn z => make (Array.fromList, Array.toList) z | |
104 | val sortVector = fn z => make (Array.fromVector, Array.toVector) z | |
105 | end | |
106 | ||
107 | end |