diff --git a/src/FsCheck/FSharp.Gen.fs b/src/FsCheck/FSharp.Gen.fs index 3df825c4..d8419ed9 100644 --- a/src/FsCheck/FSharp.Gen.fs +++ b/src/FsCheck/FSharp.Gen.fs @@ -400,6 +400,35 @@ module Gen = [] let filter (predicate:'T->bool) generator = where predicate generator + ///Tries to apply the given chooser function to successive values generated by the given generator, + ///returning the first result where the function returns Some(x). This function 'gives up' by generating None + ///if the given original generator did not generate any values for which the chooser function returned Some(x), + ///after trying to get values by increasing its size. + //[category: Creating generators from generators] + [] + let tryPick (chooser:'T->option<'U>) generator = + let rec tryValue k s = + match (k,s) with + | (_,0) -> constant None + // Resize with 2*k+s to progressively increase size with each retry attempt + | (k,s) -> (resize (2*k+s) generator) |> bind (fun x -> + match chooser x with + | Some v -> constant (Some v) + | None -> tryValue (k+1) (s-1)) + sized (max 1 >> tryValue 0) + + ///Applies the given chooser function to successive values generated by the given generator, + ///returning the first result where the function returns Some(x). Contrary to tryPick, this function + ///keeps re-trying by increasing the size of the original generator ad infinitum. Make sure there is + ///a high probability that the chooser function returns Some for some values. + //[category: Creating generators from generators] + [] + let rec pick (chooser:'T->option<'U>) generator = + tryPick chooser generator |> bind (fun mx -> + match mx with + | Some x -> constant x + | None -> sized (fun n -> resize (n+1) (pick chooser generator))) + let inline private shuffleInPlace (arr: array<_>) = // https://en.wikipedia.org/wiki/Fisher%E2%80%93Yates_shuffle let inline swap (arr : array<_>) i j = diff --git a/src/FsCheck/Fluent.Gen.fs b/src/FsCheck/Fluent.Gen.fs index 409f652d..80665e4e 100644 --- a/src/FsCheck/Fluent.Gen.fs +++ b/src/FsCheck/Fluent.Gen.fs @@ -266,6 +266,31 @@ type Gen = if isNull predicate then nullArg "predicate" source |> Gen.where predicate.Invoke + /// Tries to apply the given chooser function to successive values generated by the source generator, + /// returning the first result where the function returns a value. This function 'gives up' by generating null + /// if the source generator did not generate any values for which the chooser function returned a value, + /// after trying to get values by increasing its size. + [] + static member TryPick(source:Gen<'T>, chooser : Func<'T, 'U>) = + if isNull chooser then nullArg "chooser" + source |> Gen.tryPick (fun x -> + let result = chooser.Invoke(x) + // Boxing allows null checking for both reference and value types + if isNull (box result) then None else Some result) + |> Gen.map (function Some v -> v | None -> Unchecked.defaultof<'U>) + + /// Applies the given chooser function to successive values generated by the source generator, + /// returning the first result where the function returns a non-null value. Contrary to TryPick, + /// this function keeps re-trying by increasing the size of the original generator ad infinitum. + /// Make sure there is a high probability that the chooser function returns a non-null value for some values. + [] + static member Pick(source:Gen<'T>, chooser : Func<'T, 'U>) = + if isNull chooser then nullArg "chooser" + source |> Gen.pick (fun x -> + let result = chooser.Invoke(x) + // Boxing allows null checking for both reference and value types + if isNull (box result) then None else Some result) + ///Generates a list of given length, containing values generated by the given generator. //[category: Creating generators from generators] [] diff --git a/tests/FsCheck.Test/Gen.fs b/tests/FsCheck.Test/Gen.fs index 36670fcd..c3833c57 100644 --- a/tests/FsCheck.Test/Gen.fs +++ b/tests/FsCheck.Test/Gen.fs @@ -241,6 +241,20 @@ module Gen = |> sample1 |> ((=) (abs v)) ) + [] + let TryPick (v:int) (chooser:int -> option) = + let expected = chooser v + assertTrue ( Gen.tryPick chooser (Gen.constant v) + |> sample1 + |> ((=) expected) ) + + [] + let Pick (v:int) = + let chooser x = if x >= 0 then Some (string x) else None + assertTrue ( Gen.pick chooser (Gen.elements [v;abs v]) + |> sample1 + |> ((=) (string (abs v))) ) + [] let ListOf (NonNegativeInt size) (v:char) = assertTrue ( Gen.resize size (Gen.listOf <| Gen.constant v)