Commit 77b219a8 authored by Jianshi Huang's avatar Jianshi Huang Committed by Nikodemus Siivola
Browse files

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

parent c1644dfb
...@@ -83,8 +83,9 @@ share structure with it." ...@@ -83,8 +83,9 @@ share structure with it."
"Returns a random permutation of SEQUENCE bounded by START and END. "Returns a random permutation of SEQUENCE bounded by START and END.
Permuted sequence may share storage with the original one. Signals an Permuted sequence may share storage with the original one. Signals an
error if SEQUENCE is not a proper sequence." error if SEQUENCE is not a proper sequence."
(declare (fixnum start) (type (or fixnum null) end)) (declare (type fixnum start)
(typecase sequence (type (or fixnum null) end))
(etypecase sequence
(list (list
(let* ((end (or end (proper-list-length sequence))) (let* ((end (or end (proper-list-length sequence)))
(n (- end start))) (n (- end start)))
...@@ -94,12 +95,14 @@ error if SEQUENCE is not a proper sequence." ...@@ -94,12 +95,14 @@ error if SEQUENCE is not a proper sequence."
(decf n)))) (decf n))))
(vector (vector
(let ((end (or end (length sequence)))) (let ((end (or end (length sequence))))
(loop for i from (- end 1) downto start (loop for i from start below end
do (rotatef (aref sequence i) (aref sequence (random (+ i 1))))))) do (rotatef (aref sequence i)
(aref sequence (+ i (random (- end i))))))))
(sequence (sequence
(let ((end (or end (length sequence)))) (let ((end (or end (length sequence))))
(loop for i from (- end 1) downto start (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) sequence)
(defun random-elt (sequence &key (start 0) end) (defun random-elt (sequence &key (start 0) end)
......
...@@ -1128,6 +1128,14 @@ ...@@ -1128,6 +1128,14 @@
s))) s)))
(nil t t)) (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 (deftest random-elt.1
(let ((s1 #(1 2 3 4)) (let ((s1 #(1 2 3 4))
(s2 '(1 2 3 4))) (s2 '(1 2 3 4)))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment