mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-10 22:47:33 +02:00
fixing sorting with duplicates
This commit is contained in:
parent
14e1cd482f
commit
8869320e63
2 changed files with 24 additions and 6 deletions
|
@ -122,16 +122,24 @@ static sexp sexp_object_compare_op (sexp ctx, sexp self, sexp_sint_t n, sexp a,
|
|||
|
||||
/* fast path when using general object-cmp comparator with no key */
|
||||
static void sexp_qsort (sexp ctx, sexp *vec, sexp_sint_t lo, sexp_sint_t hi) {
|
||||
sexp_sint_t mid, i, j;
|
||||
sexp_sint_t mid, i, j, diff;
|
||||
sexp tmp, tmp2;
|
||||
loop:
|
||||
if (lo < hi) {
|
||||
mid = lo + (hi-lo)/2;
|
||||
swap(tmp, vec[mid], vec[hi]);
|
||||
for (i=j=lo; i < hi; i++)
|
||||
if (sexp_object_compare(ctx, vec[i], tmp) < 0)
|
||||
swap(tmp2, vec[i], vec[j]), j++;
|
||||
/* partition */
|
||||
for (i=j=lo; i < hi; i++) {
|
||||
diff = sexp_object_compare(ctx, vec[i], tmp);
|
||||
if (diff < 0) {
|
||||
swap(tmp2, vec[i], vec[j]);
|
||||
j++;
|
||||
} else if (diff == 0) {
|
||||
j++;
|
||||
}
|
||||
}
|
||||
swap(tmp, vec[j], vec[hi]);
|
||||
/* recurse */
|
||||
sexp_qsort(ctx, vec, lo, j-1);
|
||||
if (j < hi-1) {
|
||||
lo = j;
|
||||
|
@ -171,10 +179,16 @@ static sexp sexp_qsort_less (sexp ctx, sexp *vec,
|
|||
sexp_car(args2) = a;
|
||||
sexp_car(args1) = b;
|
||||
res = sexp_apply(ctx, less, args2);
|
||||
if (sexp_exceptionp(res))
|
||||
if (sexp_exceptionp(res)) {
|
||||
goto done;
|
||||
else if (sexp_truep(res))
|
||||
} else if (sexp_truep(res)) {
|
||||
swap(res, vec[i], vec[j]), j++;
|
||||
} else {
|
||||
sexp_car(args2) = b;
|
||||
sexp_car(args1) = a;
|
||||
res = sexp_apply(ctx, less, args2);
|
||||
if (sexp_not(res)) j++; /* equal */
|
||||
}
|
||||
}
|
||||
swap(tmp, vec[j], vec[hi]);
|
||||
res = sexp_qsort_less(ctx, vec, lo, j-1, less, key);
|
||||
|
|
|
@ -8,11 +8,15 @@
|
|||
(test "sort null" '() (sort '()))
|
||||
(test "sort null <" '() (sort '() <))
|
||||
(test "sort null < car" '() (sort '() < car))
|
||||
(test "sort equal list" '(0 0 0 0 0 0 0 0 0) (sort '(0 0 0 0 0 0 0 0 0)))
|
||||
(test "sort equal list cmp" '(0 0 0 0 0 0 0 0 0)
|
||||
(sort '(0 0 0 0 0 0 0 0 0) (lambda (a b) (< a b))))
|
||||
(test "sort ordered list" '(1 2 3 4 5 6 7 8 9) (sort '(1 2 3 4 5 6 7 8 9)))
|
||||
(test "sort reversed list" '(1 2 3 4 5 6 7 8 9) (sort '(9 8 7 6 5 4 3 2 1)))
|
||||
(test "sort random list 1" '(1 2 3 4 5 6 7 8 9) (sort '(7 5 2 8 1 6 4 9 3)))
|
||||
(test "sort random list 2" '(1 2 3 4 5 6 7 8) (sort '(5 3 4 1 7 6 8 2)))
|
||||
(test "sort random list 3" '(1 2 3 4 5 6 7 8 9) (sort '(5 3 4 1 7 9 6 8 2)))
|
||||
(test "sort short equal list" '(0 0 0) (sort '(0 0 0)))
|
||||
(test "sort short random list" '(1 2 3) (sort '(2 1 3)))
|
||||
(test "sort short random list cmp" '(1 2 3) (sort '(2 1 3) (lambda (a b) (< a b))))
|
||||
(test "sort numeric list <" '(1 2 3 4 5 6 7 8 9)
|
||||
|
|
Loading…
Add table
Reference in a new issue