SHUFFLE on non-lists did not respect :START and :END

diff --git a/sequences.lisp b/sequences.lisp
index f1e3f50..e7f1925 100644 (file)
--- a/sequences.lisp
+++ b/sequences.lisp
@@ -83,8 +83,9 @@ share structure with it."
   "Returns a random permutation of SEQUENCE bounded by START and END.
 Permuted sequence may share storage with the original one. Signals an
 error if SEQUENCE is not a proper sequence."
-  (declare (fixnum start) (type (or fixnum null) end))
-  (typecase sequence
+  (declare (type fixnum start)
+           (type (or fixnum null) end))
+  (etypecase sequence
     (list
      (let* ((end (or end (proper-list-length sequence)))
             (n (- end start)))
@@ -94,12 +95,14 @@ error if SEQUENCE is not a proper sequence."
          (decf n))))
     (vector
      (let ((end (or end (length sequence))))
-       (loop for i from (- end 1) downto start
-             do (rotatef (aref sequence i) (aref sequence (random (+ i 1)))))))
+       (loop for i from start below end
+             do (rotatef (aref sequence i)
+                         (aref sequence (+ i (random (- end i))))))))
     (sequence
      (let ((end (or end (length sequence))))
        (loop for i from (- end 1) downto start
-             do (rotatef (elt sequence i) (elt sequence (random (+ i 1))))))))
+             do (rotatef (elt sequence i)
+                         (elt sequence (+ i (random (- end i)))))))))
   sequence)
 
 (defun random-elt (sequence &key (start 0) end)

diff --git a/tests.lisp b/tests.lisp
index 20caf8a..babe0f4 100644 (file)
--- a/tests.lisp
+++ b/tests.lisp
@@ -1128,6 +1128,14 @@
                    s)))
   (nil t t))
 
+(deftest shuffle.3
+    (let* ((orig (coerce (iota 21) 'vector))
+           (copy (copy-seq orig)))
+      (shuffle copy :start 10 :end 15)
+      (list (every #'eql (subseq copy 0 10) (subseq orig 0 10))
+            (every #'eql (subseq copy 15) (subseq orig 15))))
+  (t t))
+
 (deftest random-elt.1
     (let ((s1 #(1 2 3 4))
           (s2 '(1 2 3 4)))