Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-22 07:09:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Partition needs to split on <= to handle dups properly.

Browse source
This commit is contained in:
Alex Shinn 2013-05-11 13:39:36 +09:00
parent 908be71b17
commit 59c3171c39
2 changed files with 15 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
lib/srfi/95/qsort.c
View file

@ -144,7 +144,7 @@ static void sexp_qsort (sexp ctx, sexp *vec, sexp_sint_t lo, sexp_sint_t hi) {
/* partition */ /* partition */
for (i=j=lo; i < hi; i++) { for (i=j=lo; i < hi; i++) {
diff = sexp_object_compare(ctx, vec[i], tmp); diff = sexp_object_compare(ctx, vec[i], tmp);
if (diff < 0) { if (diff <= 0) {
swap(tmp2, vec[i], vec[j]); swap(tmp2, vec[i], vec[j]);
j++; j++;
} else if (diff == 0) { } else if (diff == 0) {
@ -182,6 +182,7 @@ static sexp sexp_qsort_less (sexp ctx, sexp *vec,
} else { } else {
b = tmp; b = tmp;
} }
/* partition */
for (i=j=lo; i < hi; i++) { for (i=j=lo; i < hi; i++) {
if (sexp_truep(key)) { if (sexp_truep(key)) {
sexp_car(args1) = vec[i]; sexp_car(args1) = vec[i];
@ -204,6 +205,7 @@ static sexp sexp_qsort_less (sexp ctx, sexp *vec,
} }
} }
swap(tmp, vec[j], vec[hi]); swap(tmp, vec[j], vec[hi]);
/* recurse */
res = sexp_qsort_less(ctx, vec, lo, j-1, less, key); res = sexp_qsort_less(ctx, vec, lo, j-1, less, key);
if (sexp_exceptionp(res)) if (sexp_exceptionp(res))
goto done; goto done;

12
tests/sort-tests.scm
View file

@ -87,6 +87,18 @@
0.0066999999999986) 0.0066999999999986)
<)) <))
(test "sort watson no dups"
'#(-0.3096 -0.307000000000002 -0.303800000000003 -0.301600000000001
-0.300599999999999 -0.3003 -0.3002 -0.2942)
(sort '#(-0.3096 -0.307000000000002 -0.303800000000003 -0.301600000000001
-0.300599999999999 -0.2942 -0.3003 -0.3002)))
(test "sort watson"
'#(-0.3096 -0.307000000000002 -0.303800000000003 -0.301600000000001
-0.300599999999999 -0.3003 -0.3003 -0.3002 -0.2942)
(sort '#(-0.3096 -0.307000000000002 -0.303800000000003 -0.301600000000001
-0.300599999999999 -0.2942 -0.3003 -0.3003 -0.3002)))
(test "sort ratios" '(1/5 1/4 1/3 2/5 1/2 3/5 2/3 3/4 4/5) (test "sort ratios" '(1/5 1/4 1/3 2/5 1/2 3/5 2/3 3/4 4/5)
(sort '(1/2 1/3 1/4 1/5 2/3 3/4 2/5 3/5 4/5))) (sort '(1/2 1/3 1/4 1/5 2/3 3/4 2/5 3/5 4/5)))