diff options
| -rw-r--r-- | doc/ref/api-data.texi | 32 | ||||
| -rw-r--r-- | libguile/quicksort.i.c | 48 | ||||
| -rw-r--r-- | libguile/sort.c | 68 | ||||
| -rw-r--r-- | module/Makefile.am | 1 | ||||
| -rw-r--r-- | module/ice-9/arrays.scm | 50 | ||||
| -rw-r--r-- | test-suite/tests/sort.test | 149 |
6 files changed, 208 insertions, 140 deletions
diff --git a/doc/ref/api-data.texi b/doc/ref/api-data.texi index 05b70838a..ac743ea1f 100644 --- a/doc/ref/api-data.texi +++ b/doc/ref/api-data.texi @@ -7498,10 +7498,6 @@ same type, and have corresponding elements which are either @code{equal?} (@pxref{Equality}) in that all arguments must be arrays. @end deffn -@c FIXME: array-map! accepts no source arrays at all, and in that -@c case makes calls "(proc)". Is that meant to be a documented -@c feature? -@c @c FIXME: array-for-each doesn't say what happens if the sources have @c different index ranges. The code currently iterates over the @c indices of the first and expects the others to cover those. That @@ -7509,14 +7505,15 @@ same type, and have corresponding elements which are either @c documented feature? @deffn {Scheme Procedure} array-map! dst proc src @dots{} -@deffnx {Scheme Procedure} array-map-in-order! dst proc src1 @dots{} srcN +@deffnx {Scheme Procedure} array-map-in-order! dst proc src @dots{} @deffnx {C Function} scm_array_map_x (dst, proc, srclist) -Set each element of the @var{dst} array to values obtained from calls -to @var{proc}. The value returned is unspecified. +Set each element of the @var{dst} array to values obtained from calls to +@var{proc}. The list of @var{src} arguments may be empty. The value +returned is unspecified. -Each call is @code{(@var{proc} @var{elem1} @dots{} @var{elemN})}, -where each @var{elem} is from the corresponding @var{src} array, at -the @var{dst} index. @code{array-map-in-order!} makes the calls in +Each call is @code{(@var{proc} @var{elem} @dots{})}, where each +@var{elem} is from the corresponding @var{src} array, at the +@var{dst} index. @code{array-map-in-order!} makes the calls in row-major order, @code{array-map!} makes them in an unspecified order. The @var{src} arrays must have the same number of dimensions as @@ -7568,6 +7565,21 @@ $\left(\matrix{% @end example @end deffn +An additional array function is available in the module +@code{(ice-9 arrays)}. It can be used with: + +@example +(use-modules (ice-9 arrays)) +@end example + +@deffn {Scheme Procedure} array-copy src +Return a new array with the same elements, type and shape as +@var{src}. However, the array increments may not be the same as those of +@var{src}. In the current implementation, the returned array will be in +row-major order, but that might change in the future. Use +@code{array-copy!} on an array of known order if that is a concern. +@end deffn + @node Shared Arrays @subsubsection Shared Arrays diff --git a/libguile/quicksort.i.c b/libguile/quicksort.i.c index cf1742efa..598267268 100644 --- a/libguile/quicksort.i.c +++ b/libguile/quicksort.i.c @@ -27,7 +27,7 @@ reduces the probability of selecting a bad pivot value and eliminates certain extraneous comparisons. - 3. Only quicksorts NR_ELEMS / MAX_THRESH partitions, leaving insertion sort + 3. Only quicksorts (UBND-LBND+1) / MAX_THRESH partitions, leaving insertion sort to order the MAX_THRESH items within each partition. This is a big win, since insertion sort is faster for small, mostly sorted array segments. @@ -54,33 +54,29 @@ #define STACK_NOT_EMPTY (stack < top) static void -NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less) +NAME (VEC_PARAM ssize_t lbnd, ssize_t ubnd, INC_PARAM SCM less) { /* Stack node declarations used to store unfulfilled partition obligations. */ typedef struct { - size_t lo; - size_t hi; + ssize_t lo; + ssize_t hi; } stack_node; static const char s_buggy_less[] = "buggy less predicate used when sorting"; - if (nr_elems == 0) - /* Avoid lossage with unsigned arithmetic below. */ - return; - - if (nr_elems > MAX_THRESH) + if (ubnd-lbnd+1 > MAX_THRESH) { - size_t lo = 0; - size_t hi = nr_elems-1; + ssize_t lo = lbnd; + ssize_t hi = ubnd; stack_node stack[STACK_SIZE]; stack_node *top = stack + 1; while (STACK_NOT_EMPTY) { - size_t left; - size_t right; - size_t mid = lo + (hi - lo) / 2; + ssize_t left; + ssize_t right; + ssize_t mid = lo + (hi - lo) / 2; SCM pivot; /* Select median value from among LO, MID, and HI. Rearrange @@ -145,16 +141,16 @@ NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less) ignore one or both. Otherwise, push the larger partition's bounds on the stack and continue sorting the smaller one. */ - if ((size_t) (right - lo) <= MAX_THRESH) + if ((right - lo) <= MAX_THRESH) { - if ((size_t) (hi - left) <= MAX_THRESH) + if ((hi - left) <= MAX_THRESH) /* Ignore both small partitions. */ POP (lo, hi); else /* Ignore small left partition. */ lo = left; } - else if ((size_t) (hi - left) <= MAX_THRESH) + else if ((hi - left) <= MAX_THRESH) /* Ignore small right partition. */ hi = right; else if ((right - lo) > (hi - left)) @@ -179,10 +175,10 @@ NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less) one beyond it!). */ { - size_t tmp = 0; - size_t end = nr_elems-1; - size_t thresh = min (end, MAX_THRESH); - size_t run; + ssize_t tmp = lbnd; + ssize_t end = ubnd; + ssize_t thresh = min (end, MAX_THRESH); + ssize_t run; /* Find smallest element in first threshold and place it at the array's beginning. This is the smallest array element, @@ -192,12 +188,12 @@ NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less) if (scm_is_true (scm_call_2 (less, GET(run), GET(tmp)))) tmp = run; - if (tmp != 0) - SWAP (tmp, 0); + if (tmp != lbnd) + SWAP (tmp, lbnd); /* Insertion sort, running from left-hand-side up to right-hand-side. */ - run = 1; + run = lbnd + 1; while (++run <= end) { SCM_TICK; @@ -206,7 +202,7 @@ NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less) while (scm_is_true (scm_call_2 (less, GET(run), GET(tmp)))) { /* The comparison predicate may be buggy */ - if (tmp == 0) + if (tmp == lbnd) scm_misc_error (NULL, s_buggy_less, SCM_EOL); tmp -= 1; @@ -216,7 +212,7 @@ NAME (VEC_PARAM size_t nr_elems, INC_PARAM SCM less) if (tmp != run) { SCM to_insert = GET(run); - size_t hi, lo; + ssize_t hi, lo; for (hi = lo = run; --lo >= tmp; hi = lo) SET(hi, GET(lo)); diff --git a/libguile/sort.c b/libguile/sort.c index 81ef3ff27..ff7d6634d 100644 --- a/libguile/sort.c +++ b/libguile/sort.c @@ -69,7 +69,7 @@ #define SET(i, val) scm_array_handle_set (ra, scm_array_handle_pos_1 (ra, i), val) #include "libguile/quicksort.i.c" -SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0, +SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0, (SCM vec, SCM less, SCM startpos, SCM endpos), "Sort the vector @var{vec}, using @var{less} for comparing\n" "the vector elements. @var{startpos} (inclusively) and\n" @@ -79,7 +79,7 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0, #define FUNC_NAME s_scm_restricted_vector_sort_x { ssize_t spos = scm_to_ssize_t (startpos); - size_t epos = scm_to_ssize_t (endpos); + ssize_t epos = scm_to_ssize_t (endpos)-1; scm_t_array_handle handle; scm_t_array_dim const * dims; @@ -89,26 +89,25 @@ SCM_DEFINE (scm_restricted_vector_sort_x, "restricted-vector-sort!", 4, 0, 0, if (scm_array_handle_rank(&handle) != 1) { scm_array_handle_release (&handle); - scm_error (scm_misc_error_key, FUNC_NAME, "rank must be 1", vec, SCM_EOL); + scm_misc_error (FUNC_NAME, "rank must be 1", scm_list_1 (vec)); } if (spos < dims[0].lbnd) { scm_array_handle_release (&handle); - scm_error (scm_out_of_range_key, FUNC_NAME, "startpos out of range", - vec, scm_list_1(startpos)); + scm_error (scm_out_of_range_key, FUNC_NAME, "startpos ~s out of range of ~s", + scm_list_2 (startpos, vec), scm_list_1 (startpos)); } - if (epos > dims[0].ubnd+1) + if (epos > dims[0].ubnd) { scm_array_handle_release (&handle); - scm_error (scm_out_of_range_key, FUNC_NAME, "endpos out of range", - vec, scm_list_1(endpos)); + scm_error (scm_out_of_range_key, FUNC_NAME, "endpos ~s out of range of ~s", + scm_list_2 (endpos, vec), scm_list_1 (endpos)); } - if (handle.element_type == SCM_ARRAY_ELEMENT_TYPE_SCM) - quicksort (scm_array_handle_writable_elements (&handle) + (spos-dims[0].lbnd) * dims[0].inc, - epos-spos, dims[0].inc, less); + quicksort (scm_array_handle_writable_elements (&handle) - dims[0].lbnd * dims[0].inc, + spos, epos, dims[0].inc, less); else - quicksorta (&handle, epos-spos, less); + quicksorta (&handle, spos, epos, less); scm_array_handle_release (&handle); return SCM_UNSPECIFIED; @@ -187,11 +186,11 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0, } else { - for (i = dims[0].lbnd+1, end = dims[0].ubnd+1; i < end; ++i) + for (i = 1, end = dims[0].ubnd-dims[0].lbnd+1; i < end; ++i) { if (scm_is_true (scm_call_2 (less, - scm_array_handle_ref (&handle, scm_array_handle_pos_1 (&handle, i)), - scm_array_handle_ref (&handle, scm_array_handle_pos_1 (&handle, i-1))))) + scm_array_handle_ref (&handle, i*dims[0].inc), + scm_array_handle_ref (&handle, (i-1)*dims[0].inc)))) { result = SCM_BOOL_F; break; @@ -211,7 +210,7 @@ SCM_DEFINE (scm_sorted_p, "sorted?", 2, 0, 0, and returns a new list in which the elements of a and b have been stably interleaved so that (sorted? (merge a b less?) less?). Note: this does _not_ accept vectors. */ -SCM_DEFINE (scm_merge, "merge", 3, 0, 0, +SCM_DEFINE (scm_merge, "merge", 3, 0, 0, (SCM alist, SCM blist, SCM less), "Merge two already sorted lists into one.\n" "Given two lists @var{alist} and @var{blist}, such that\n" @@ -275,7 +274,7 @@ SCM_DEFINE (scm_merge, "merge", 3, 0, 0, #undef FUNC_NAME -static SCM +static SCM scm_merge_list_x (SCM alist, SCM blist, long alen, long blen, SCM less) @@ -327,7 +326,7 @@ scm_merge_list_x (SCM alist, SCM blist, } /* scm_merge_list_x */ -SCM_DEFINE (scm_merge_x, "merge!", 3, 0, 0, +SCM_DEFINE (scm_merge_x, "merge!", 3, 0, 0, (SCM alist, SCM blist, SCM less), "Takes two lists @var{alist} and @var{blist} such that\n" "@code{(sorted? alist less?)} and @code{(sorted? blist less?)} and\n" @@ -358,7 +357,7 @@ SCM_DEFINE (scm_merge_x, "merge!", 3, 0, 0, scsh's merge-sort but that algorithm showed to not be stable, even though it claimed to be. */ -static SCM +static SCM scm_merge_list_step (SCM * seq, SCM less, long n) { SCM a, b; @@ -406,7 +405,7 @@ scm_merge_list_step (SCM * seq, SCM less, long n) } while (0) -SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0, +SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0, (SCM items, SCM less), "Sort the sequence @var{items}, which may be a list or a\n" "vector. @var{less} is used for comparing the sequence\n" @@ -427,10 +426,23 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0, } else if (scm_is_array (items) && scm_c_array_rank (items) == 1) { + scm_t_array_handle handle; + scm_t_array_dim const * dims; + scm_array_get_handle (items, &handle); + dims = scm_array_handle_dims (&handle); + + if (scm_array_handle_rank (&handle) != 1) + { + scm_array_handle_release (&handle); + scm_misc_error (FUNC_NAME, "rank must be 1", scm_list_1 (items)); + } + scm_restricted_vector_sort_x (items, less, - scm_from_int (0), - scm_array_length (items)); + scm_from_ssize_t (dims[0].lbnd), + scm_from_ssize_t (dims[0].ubnd+1)); + + scm_array_handle_release (&handle); return items; } else @@ -439,7 +451,7 @@ SCM_DEFINE (scm_sort_x, "sort!", 2, 0, 0, #undef FUNC_NAME -SCM_DEFINE (scm_sort, "sort", 2, 0, 0, +SCM_DEFINE (scm_sort, "sort", 2, 0, 0, (SCM items, SCM less), "Sort the sequence @var{items}, which may be a list or a\n" "vector. @var{less} is used for comparing the sequence\n" @@ -525,7 +537,7 @@ scm_merge_vector_step (SCM *vec, } /* scm_merge_vector_step */ -SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, +SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, (SCM items, SCM less), "Sort the sequence @var{items}, which may be a list or a\n" "vector. @var{less} is used for comparing the sequence elements.\n" @@ -551,7 +563,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, SCM temp, *temp_elts, *vec_elts; size_t len; ssize_t inc; - + vec_elts = scm_vector_writable_elements (items, &vec_handle, &len, &inc); if (len == 0) @@ -559,7 +571,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, scm_array_handle_release (&vec_handle); return items; } - + temp = scm_c_make_vector (len, SCM_UNDEFINED); temp_elts = scm_vector_writable_elements (temp, &temp_handle, NULL, NULL); @@ -577,7 +589,7 @@ SCM_DEFINE (scm_stable_sort_x, "stable-sort!", 2, 0, 0, #undef FUNC_NAME -SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, +SCM_DEFINE (scm_stable_sort, "stable-sort", 2, 0, 0, (SCM items, SCM less), "Sort the sequence @var{items}, which may be a list or a\n" "vector. @var{less} is used for comparing the sequence elements.\n" @@ -613,7 +625,7 @@ SCM_DEFINE (scm_sort_list_x, "sort-list!", 2, 0, 0, #undef FUNC_NAME -SCM_DEFINE (scm_sort_list, "sort-list", 2, 0, 0, +SCM_DEFINE (scm_sort_list, "sort-list", 2, 0, 0, (SCM items, SCM less), "Sort the list @var{items}, using @var{less} for comparing the\n" "list elements. This is a stable sort.") diff --git a/module/Makefile.am b/module/Makefile.am index d5896bdd8..ec01b456e 100644 --- a/module/Makefile.am +++ b/module/Makefile.am @@ -44,6 +44,7 @@ ice-9/psyntax-pp.go: ice-9/psyntax.scm ice-9/psyntax-pp.scm SOURCES = \ ice-9/and-let-star.scm \ + ice-9/arrays.scm \ ice-9/atomic.scm \ ice-9/binary-ports.scm \ ice-9/boot-9.scm \ diff --git a/module/ice-9/arrays.scm b/module/ice-9/arrays.scm index f7f9e5eed..2c04b2ef8 100644 --- a/module/ice-9/arrays.scm +++ b/module/ice-9/arrays.scm @@ -1,22 +1,32 @@ -;;; installed-scm-file +;;; -*- mode: scheme; coding: utf-8; -*- +;;; +;;; Copyright (C) 1999, 2001, 2004, 2006, 2017 Free Software Foundation, Inc. +;;; +;;; This library is free software; you can redistribute it and/or +;;; modify it under the terms of the GNU Lesser General Public +;;; License as published by the Free Software Foundation; either +;;; version 3 of the License, or (at your option) any later version. +;;; +;;; This library is distributed in the hope that it will be useful, +;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; Lesser General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with this library; if not, write to the Free Software +;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -;;;; Copyright (C) 1999, 2001, 2004, 2006 Free Software Foundation, Inc. -;;;; -;;;; This library is free software; you can redistribute it and/or -;;;; modify it under the terms of the GNU Lesser General Public -;;;; License as published by the Free Software Foundation; either -;;;; version 3 of the License, or (at your option) any later version. -;;;; -;;;; This library is distributed in the hope that it will be useful, -;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;;;; Lesser General Public License for more details. -;;;; -;;;; You should have received a copy of the GNU Lesser General Public -;;;; License along with this library; if not, write to the Free Software -;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -;;;; +(define-module (ice-9 arrays) + #:export (array-copy)) + +; This is actually defined in boot-9.scm, apparently for b.c. +;; (define (array-shape a) +;; (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind)) +;; (array-dimensions a))) + +; FIXME writes over the array twice if (array-type) is #t +(define (array-copy a) + (let ((b (apply make-typed-array (array-type a) *unspecified* (array-shape a)))) + (array-copy! a b) + b)) -(define (array-shape a) - (map (lambda (ind) (if (number? ind) (list 0 (+ -1 ind)) ind)) - (array-dimensions a))) diff --git a/test-suite/tests/sort.test b/test-suite/tests/sort.test index fa1ffd0b6..dbb43c966 100644 --- a/test-suite/tests/sort.test +++ b/test-suite/tests/sort.test @@ -1,25 +1,57 @@ ;;;; sort.test --- tests Guile's sort functions -*- scheme -*- -;;;; Copyright (C) 2003, 2006, 2007, 2009, 2011 Free Software Foundation, Inc. -;;;; +;;;; Copyright (C) 2003, 2006, 2007, 2009, 2011, 2017 +;;;; Free Software Foundation, Inc. +;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. -;;;; +;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. -;;;; +;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA -(use-modules (test-suite lib)) +(use-modules (test-suite lib) + (ice-9 arrays)) + +(set! *random-state* (seed->random-state 2017)) + +; Randomly shuffle u in place, using Fisher-Yates algorithm. +(define (array-shuffle! v) + (unless (= 1 (array-rank v)) (throw 'bad-rank (array-rank v))) + (let* ((dims (car (array-shape v))) + (lo (car dims))) + (let loop ((i (cadr dims))) + (if (> i lo) + (let* ((j (+ lo (random (- (1+ i) lo)))) + (t (array-ref v j))) + (array-set! v (array-ref v i) j) + (array-set! v t i) + (loop (- i 1))) + v)))) + +(define* (test-sort! v #:optional (sort sort)) + (array-index-map! v (lambda (i) i)) + (let ((before (array-copy v))) + (array-shuffle! v) + (let ((after (array-copy v))) + (and + (equal? before (sort v <)) + (equal? after v))))) + +(define* (test-sort-inplace! v #:optional (sort! sort!)) + (array-index-map! v (lambda (i) i)) + (let ((before (array-copy v))) + (array-shuffle! v) + (and (equal? before (sort! v <)) + (equal? before v) + (sorted? v <)))) -(define (randomize-vector! v n) - (array-index-map! v (lambda (i) (random n))) - v) (with-test-prefix "sort" @@ -32,67 +64,72 @@ (sort '(1 2) (lambda (x y z) z))) (pass-if "sort of vector" - (let* ((v (randomize-vector! (make-vector 1000) 1000)) - (w (vector-copy v))) - (and (sorted? (sort v <) <) - (equal? w v)))) - - (pass-if "sort of typed array" - (let* ((v (randomize-vector! (make-typed-array 'f64 *unspecified* 99) 99)) - (w (make-typed-array 'f64 *unspecified* 99))) - (array-copy! v w) - (and (sorted? (sort v <) <) - (equal? w v)))) - - (pass-if "sort! of vector" - (let ((v (randomize-vector! (make-vector 1000) 1000))) - (sorted? (sort! v <) <))) - - (pass-if "sort! of typed array" - (let ((v (randomize-vector! (make-typed-array 'f64 *unspecified* 99) 99))) - (sorted? (sort! v <) <))) - - (pass-if "sort! of non-contigous vector" - (let* ((a (make-array 0 1000 3)) - (v (make-shared-array a (lambda (i) (list i 0)) 1000))) - (randomize-vector! v 1000) - (sorted? (sort! v <) <))) + (test-sort! (make-vector 100))) + + (pass-if "sort of typed vector" + (test-sort! (make-f64vector 100)))) + + +(with-test-prefix "sort!" + + (pass-if "sort of empty vector" + (test-sort-inplace! (vector))) + + (pass-if "sort of vector" + (test-sort-inplace! (make-vector 100))) + + (pass-if "sort of empty typed vector" + (test-sort-inplace! (f64vector))) + + (pass-if "sort! of typed vector" + (test-sort-inplace! (make-f64vector 100))) + + (pass-if "sort! of non-contigous array" + (let* ((a (make-array 0 100 3)) + (v (make-shared-array a (lambda (i) (list i 0)) 100))) + (test-sort-inplace! v))) (pass-if "sort! of non-contigous typed array" (let* ((a (make-typed-array 'f64 0 99 3)) (v (make-shared-array a (lambda (i) (list i 0)) 99))) - (randomize-vector! v 99) - (sorted? (sort! v <) <))) + (test-sort-inplace! v))) + + (pass-if "sort! of negative-increment array" + (let* ((a (make-array 0 100 3)) + (v (make-shared-array a (lambda (i) (list (- 99 i) 0)) 100))) + (test-sort-inplace! v))) - (pass-if "sort! of negative-increment vector" - (let* ((a (make-array 0 1000 3)) - (v (make-shared-array a (lambda (i) (list (- 999 i) 0)) 1000))) - (randomize-vector! v 1000) - (sorted? (sort! v <) <))) + (pass-if "sort! of non-zero base index array" + (test-sort-inplace! (make-array 0 '(-99 0)))) + + (pass-if "sort! of non-zero base index typed array" + (test-sort-inplace! (make-typed-array 'f64 0 '(-99 0)))) (pass-if "sort! of negative-increment typed array" (let* ((a (make-typed-array 'f64 0 99 3)) (v (make-shared-array a (lambda (i) (list (- 98 i) 0)) 99))) - (randomize-vector! v 99) - (sorted? (sort! v <) <)))) + (test-sort-inplace! v)))) + (with-test-prefix "stable-sort!" (pass-if "stable-sort!" - (let ((v (randomize-vector! (make-vector 1000) 1000))) - (sorted? (stable-sort! v <) <))) - - (pass-if "stable-sort! of non-contigous vector" - (let* ((a (make-array 0 1000 3)) - (v (make-shared-array a (lambda (i) (list i 0)) 1000))) - (randomize-vector! v 1000) - (sorted? (stable-sort! v <) <))) - - (pass-if "stable-sort! of negative-increment vector" - (let* ((a (make-array 0 1000 3)) - (v (make-shared-array a (lambda (i) (list (- 999 i) 0)) 1000))) - (randomize-vector! v 1000) - (sorted? (stable-sort! v <) <)))) + (let ((v (make-vector 100))) + (test-sort-inplace! v stable-sort!))) + + (pass-if "stable-sort! of non-contigous array" + (let* ((a (make-array 0 100 3)) + (v (make-shared-array a (lambda (i) (list i 0)) 100))) + (test-sort-inplace! v stable-sort!))) + + (pass-if "stable-sort! of negative-increment array" + (let* ((a (make-array 0 100 3)) + (v (make-shared-array a (lambda (i) (list (- 99 i) 0)) 100))) + (test-sort-inplace! v stable-sort!))) + + (pass-if "stable-sort! of non-zero base index array" + (test-sort-inplace! (make-array 0 '(-99 0)) stable-sort!))) + (with-test-prefix "stable-sort" |