diff --git a/sequences.lisp b/sequences.lisp index f1e3f506f3e40cbd3d4392f6d623e4afe6efdb00..e7f192538f6faebc000ca0ff713e8923474070ff 100644 --- 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 20caf8a43c749ae7e4c513ed4bd7a1c974bb32bf..babe0f4814ec18be84089aad032f1fcce40c7eab 100644 --- 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)))