Commit | Line | Data |
---|---|---|
9de6f5f1 MV |
1 | /* The routine quicksort was extracted from the GNU C Library qsort.c |
2 | written by Douglas C. Schmidt (schmidt@ics.uci.edu) | |
3 | and adapted to guile by adding an extra pointer less | |
4 | to quicksort by Roland Orre <orre@nada.kth.se>. | |
5 | ||
6 | The reason to do this instead of using the library function qsort | |
7 | was to avoid dependency of the ANSI-C extensions for local functions | |
8 | and also to avoid obscure pool based solutions. | |
9 | ||
10 | This sorting routine is not much more efficient than the stable | |
11 | version but doesn't consume extra memory. | |
12 | */ | |
13 | ||
14 | #define SWAP(a, b) do { const SCM _tmp = a; a = b; b = _tmp; } while (0) | |
15 | ||
16 | ||
17 | /* Order using quicksort. This implementation incorporates four | |
18 | optimizations discussed in Sedgewick: | |
19 | ||
20 | 1. Non-recursive, using an explicit stack of pointer that store the next | |
21 | array partition to sort. To save time, this maximum amount of space | |
22 | required to store an array of MAX_SIZE_T is allocated on the stack. | |
23 | Assuming a bit width of 32 bits for size_t, this needs only | |
24 | 32 * sizeof (stack_node) == 128 bytes. Pretty cheap, actually. | |
25 | ||
26 | 2. Chose the pivot element using a median-of-three decision tree. This | |
27 | reduces the probability of selecting a bad pivot value and eliminates | |
28 | certain extraneous comparisons. | |
29 | ||
30 | 3. Only quicksorts NR_ELEMS / MAX_THRESH partitions, leaving insertion sort | |
31 | to order the MAX_THRESH items within each partition. This is a big win, | |
32 | since insertion sort is faster for small, mostly sorted array segments. | |
33 | ||
34 | 4. The larger of the two sub-partitions is always pushed onto the | |
35 | stack first, with the algorithm then concentrating on the | |
36 | smaller partition. This *guarantees* no more than log (n) | |
37 | stack size is needed (actually O(1) in this case)! */ | |
38 | ||
39 | ||
40 | /* Discontinue quicksort algorithm when partition gets below this size. | |
41 | * This particular magic number was chosen to work best on a Sun 4/260. */ | |
42 | #define MAX_THRESH 4 | |
43 | ||
44 | ||
45 | /* Inline stack abstraction: The stack size for quicksorting at most as many | |
46 | * elements as can be given by a value of type size_t is, as described above, | |
47 | * log (MAX_SIZE_T), which is the number of bits of size_t. More accurately, | |
48 | * we would only need ceil (log (MAX_SIZE_T / MAX_THRESH)), but this is | |
49 | * ignored below. */ | |
50 | ||
51 | #define STACK_SIZE (8 * sizeof (size_t)) /* assume 8 bit char */ | |
52 | #define PUSH(low, high) ((void) ((top->lo = (low)), (top->hi = (high)), ++top)) | |
53 | #define POP(low, high) ((void) (--top, (low = top->lo), (high = top->hi))) | |
54 | #define STACK_NOT_EMPTY (stack < top) | |
55 | ||
56 | static void | |
57 | NAME (SCM *const base_ptr, size_t nr_elems, INC_PARAM | |
6c9e8a53 | 58 | SCM less) |
9de6f5f1 MV |
59 | { |
60 | /* Stack node declarations used to store unfulfilled partition obligations. */ | |
61 | typedef struct { | |
62 | size_t lo; | |
63 | size_t hi; | |
64 | } stack_node; | |
65 | ||
66 | static const char s_buggy_less[] = "buggy less predicate used when sorting"; | |
67 | ||
68 | #define ELT(i) base_ptr[(i)*INC] | |
69 | ||
70 | if (nr_elems == 0) | |
71 | /* Avoid lossage with unsigned arithmetic below. */ | |
72 | return; | |
73 | ||
74 | if (nr_elems > MAX_THRESH) | |
75 | { | |
76 | size_t lo = 0; | |
77 | size_t hi = nr_elems-1; | |
78 | ||
79 | stack_node stack[STACK_SIZE]; | |
80 | stack_node *top = stack + 1; | |
81 | ||
82 | while (STACK_NOT_EMPTY) | |
83 | { | |
84 | size_t left; | |
85 | size_t right; | |
86 | size_t mid = lo + (hi - lo) / 2; | |
87 | SCM pivot; | |
88 | ||
89 | /* Select median value from among LO, MID, and HI. Rearrange | |
90 | LO and HI so the three values are sorted. This lowers the | |
91 | probability of picking a pathological pivot value and | |
92 | skips a comparison for both the left and right. */ | |
93 | ||
94 | SCM_TICK; | |
95 | ||
6c9e8a53 | 96 | if (scm_is_true (scm_call_2 (less, ELT(mid), ELT(lo)))) |
9de6f5f1 | 97 | SWAP (ELT(mid), ELT(lo)); |
6c9e8a53 | 98 | if (scm_is_true (scm_call_2 (less, ELT(hi), ELT(mid)))) |
9de6f5f1 MV |
99 | SWAP (ELT(mid), ELT(hi)); |
100 | else | |
101 | goto jump_over; | |
6c9e8a53 | 102 | if (scm_is_true (scm_call_2 (less, ELT(mid), ELT(lo)))) |
9de6f5f1 MV |
103 | SWAP (ELT(mid), ELT(lo)); |
104 | jump_over:; | |
105 | ||
106 | pivot = ELT(mid); | |
107 | left = lo + 1; | |
108 | right = hi - 1; | |
109 | ||
110 | /* Here's the famous ``collapse the walls'' section of quicksort. | |
111 | Gotta like those tight inner loops! They are the main reason | |
112 | that this algorithm runs much faster than others. */ | |
113 | do | |
114 | { | |
6c9e8a53 | 115 | while (scm_is_true (scm_call_2 (less, ELT(left), pivot))) |
9de6f5f1 MV |
116 | { |
117 | left += 1; | |
118 | /* The comparison predicate may be buggy */ | |
119 | if (left > hi) | |
120 | scm_misc_error (NULL, s_buggy_less, SCM_EOL); | |
121 | } | |
122 | ||
6c9e8a53 | 123 | while (scm_is_true (scm_call_2 (less, pivot, ELT(right)))) |
9de6f5f1 MV |
124 | { |
125 | right -= 1; | |
126 | /* The comparison predicate may be buggy */ | |
127 | if (right < lo) | |
128 | scm_misc_error (NULL, s_buggy_less, SCM_EOL); | |
129 | } | |
130 | ||
131 | if (left < right) | |
132 | { | |
133 | SWAP (ELT(left), ELT(right)); | |
134 | left += 1; | |
135 | right -= 1; | |
136 | } | |
137 | else if (left == right) | |
138 | { | |
139 | left += 1; | |
140 | right -= 1; | |
141 | break; | |
142 | } | |
143 | } | |
144 | while (left <= right); | |
145 | ||
146 | /* Set up pointers for next iteration. First determine whether | |
147 | left and right partitions are below the threshold size. If so, | |
148 | ignore one or both. Otherwise, push the larger partition's | |
149 | bounds on the stack and continue sorting the smaller one. */ | |
150 | ||
151 | if ((size_t) (right - lo) <= MAX_THRESH) | |
152 | { | |
153 | if ((size_t) (hi - left) <= MAX_THRESH) | |
154 | /* Ignore both small partitions. */ | |
155 | POP (lo, hi); | |
156 | else | |
157 | /* Ignore small left partition. */ | |
158 | lo = left; | |
159 | } | |
160 | else if ((size_t) (hi - left) <= MAX_THRESH) | |
161 | /* Ignore small right partition. */ | |
162 | hi = right; | |
163 | else if ((right - lo) > (hi - left)) | |
164 | { | |
165 | /* Push larger left partition indices. */ | |
166 | PUSH (lo, right); | |
167 | lo = left; | |
168 | } | |
169 | else | |
170 | { | |
171 | /* Push larger right partition indices. */ | |
172 | PUSH (left, hi); | |
173 | hi = right; | |
174 | } | |
175 | } | |
176 | } | |
177 | ||
178 | /* Once the BASE_PTR array is partially sorted by quicksort the rest is | |
179 | completely sorted using insertion sort, since this is efficient for | |
180 | partitions below MAX_THRESH size. BASE_PTR points to the beginning of the | |
181 | array to sort, and END idexes the very last element in the array (*not* | |
182 | one beyond it!). */ | |
183 | ||
184 | { | |
185 | size_t tmp = 0; | |
186 | size_t end = nr_elems-1; | |
187 | size_t thresh = min (end, MAX_THRESH); | |
188 | size_t run; | |
189 | ||
190 | /* Find smallest element in first threshold and place it at the | |
191 | array's beginning. This is the smallest array element, | |
192 | and the operation speeds up insertion sort's inner loop. */ | |
193 | ||
194 | for (run = tmp + 1; run <= thresh; run += 1) | |
6c9e8a53 | 195 | if (scm_is_true (scm_call_2 (less, ELT(run), ELT(tmp)))) |
9de6f5f1 MV |
196 | tmp = run; |
197 | ||
198 | if (tmp != 0) | |
199 | SWAP (ELT(tmp), ELT(0)); | |
200 | ||
201 | /* Insertion sort, running from left-hand-side up to right-hand-side. */ | |
202 | ||
203 | run = 1; | |
204 | while (++run <= end) | |
205 | { | |
206 | SCM_TICK; | |
207 | ||
208 | tmp = run - 1; | |
6c9e8a53 | 209 | while (scm_is_true (scm_call_2 (less, ELT(run), ELT(tmp)))) |
9de6f5f1 MV |
210 | { |
211 | /* The comparison predicate may be buggy */ | |
212 | if (tmp == 0) | |
213 | scm_misc_error (NULL, s_buggy_less, SCM_EOL); | |
214 | ||
215 | tmp -= 1; | |
216 | } | |
217 | ||
218 | tmp += 1; | |
219 | if (tmp != run) | |
220 | { | |
221 | SCM to_insert = ELT(run); | |
222 | size_t hi, lo; | |
223 | ||
224 | for (hi = lo = run; --lo >= tmp; hi = lo) | |
225 | ELT(hi) = ELT(lo); | |
226 | ELT(hi) = to_insert; | |
227 | } | |
228 | } | |
229 | } | |
230 | } | |
231 | ||
232 | #undef SWAP | |
233 | #undef MAX_THRESH | |
234 | #undef STACK_SIZE | |
235 | #undef PUSH | |
236 | #undef POP | |
237 | #undef STACK_NOT_EMPTY | |
238 | #undef ELT | |
239 | ||
240 | #undef NAME | |
241 | #undef INC_PARAM | |
242 | #undef INC | |
243 |