diff --git a/sequence.ml b/sequence.ml index 91512f6..b68b474 100644 --- a/sequence.ml +++ b/sequence.ml @@ -698,6 +698,34 @@ let random_array a k = let random_list l = random_array (Array.of_list l) +(* See http://en.wikipedia.org/wiki/Fisher-Yates_shuffle *) +let shuffle_array a = + for k = Array.length a - 1 downto 0+1 do + let l = Random.int (k+1) in + let tmp = a.(l) in + a.(l) <- a.(k); + a.(k) <- tmp; + done + +let shuffle_buffer n seq k = + let seq_front = take n seq in + let a = to_array seq_front in + let l = Array.length a in + if l < n then begin + shuffle_array a ; + of_array a k + end + else begin + let seq = drop n seq in + let f x = + let i = Random.int n in + let y = a.(i) in + a.(i) <- x ; + k y + in + seq f + end + (** {2 Sampling} *) (** See https://en.wikipedia.org/wiki/Reservoir_sampling#Algorithm_R *) diff --git a/sequence.mli b/sequence.mli index 9ca0f7c..1393490 100644 --- a/sequence.mli +++ b/sequence.mli @@ -498,6 +498,14 @@ val random_list : 'a list -> 'a t (** Infinite sequence of random elements of the list. Basically the same as {!random_array}. *) +val shuffle_buffer : int -> 'a t -> 'a t +(** [shuffle_buffer n seq] returns a sequence of element of [seq] in random + order. The shuffling is *not* uniform. Uses O(n) memory. + + The first [n] elements of the sequence are consumed immediately. The + rest is consumed lazily. + @since NEXT_RELEASE *) + (** {2 Sampling} *) val sample : int -> 'a t -> 'a array diff --git a/sequenceLabels.mli b/sequenceLabels.mli index 6f5b25e..8ab7a59 100644 --- a/sequenceLabels.mli +++ b/sequenceLabels.mli @@ -446,6 +446,14 @@ val random_list : 'a list -> 'a t (** Infinite sequence of random elements of the list. Basically the same as {!random_array}. *) +val shuffle_buffer : n:int -> 'a t -> 'a t +(** [shuffle_buffer n seq] returns a sequence of element of [seq] in random + order. The shuffling is not uniform. Uses O(n) memory. + + The first [n] elements of the sequence are consumed immediately. The + rest is consumed lazily. + @since NEXT_RELEASE *) + (** {2 Sampling} *) val sample : n:int -> 'a t -> 'a array