diff --git a/CHANGELOG.md b/CHANGELOG.md index a7d6d007..8373ad55 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -26,6 +26,10 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 change the builder return it. `replace` and `replaceWith` leave the builder as it is when no element equals the old value, as `ImmutableArray<'T>.Builder.Replace` does, where `FlatList.replace` throws `ArgumentException`. * `flatList { }` builds a flat list. +* `FlatList.Parallel` has every function of the FSharp.Core `Array.Parallel` module except the in-place sorts, with its + semantics and exceptions. Its `tryFind`, `tryFindIndex` and `tryPick` return `voption`, `choose` and `tryPick` take + functions that return `voption`, and `groupBy`, `partition`, `partitionWith` and `zip` return struct tuples; the + `Parallel` modules of the `Option` and `Tuple` namespaces repeat them with options and reference tuples. ### Changed diff --git a/src/FSharp.Collections.Immutable/FSharp.Collections.Immutable.fsproj b/src/FSharp.Collections.Immutable/FSharp.Collections.Immutable.fsproj index e7284ad8..293de773 100644 --- a/src/FSharp.Collections.Immutable/FSharp.Collections.Immutable.fsproj +++ b/src/FSharp.Collections.Immutable/FSharp.Collections.Immutable.fsproj @@ -32,6 +32,7 @@ + diff --git a/src/FSharp.Collections.Immutable/FlatList/FlatList.fs b/src/FSharp.Collections.Immutable/FlatList/FlatList.fs index 9ac7375d..54a4f7fa 100644 --- a/src/FSharp.Collections.Immutable/FlatList/FlatList.fs +++ b/src/FSharp.Collections.Immutable/FlatList/FlatList.fs @@ -1006,3 +1006,201 @@ let isDefault (array : FlatList<'T>) = array.IsDefault [] let isDefaultOrEmpty (array : FlatList<'T>) = array.IsDefaultOrEmpty + +// Most functions unwrap the underlying array without a copy, call the Array.Parallel function, and wrap its fresh result +// without a copy (ADR 0001, D11), so that they have the semantics and the exceptions of Array.Parallel. Where the +// Array.Parallel function takes or returns options or builds a tuple per element or per group (choose, tryFind, +// tryFindIndex, tryPick, zip, groupBy), an algorithm of ParallelArrays with value options and struct tuples runs instead. +// Array.Parallel sorts a copy of its input, so the shared array is never changed. +[] +module Parallel = + + // ---- Creation ---- + + [] + let init count (initializer : int -> 'T) = Array.Parallel.init count initializer |> wrapArray + + // ---- Search ---- + + [] + let exists predicate (array : FlatList<'T>) = Array.Parallel.exists predicate (unwrapArray (nameof array) array) + + [] + let forall predicate (array : FlatList<'T>) = Array.Parallel.forall predicate (unwrapArray (nameof array) array) + + [] + let tryFind predicate (array : FlatList<'T>) = + let source = unwrapArray (nameof array) array + + match ParallelArrays.tryFindIndex predicate source with + | ValueSome index -> ValueSome source[index] + | ValueNone -> ValueNone + + [] + let tryFindIndex predicate (array : FlatList<'T>) = ParallelArrays.tryFindIndex predicate (unwrapArray (nameof array) array) + + [] + let tryPick (chooser : 'T -> 'U voption) (array : FlatList<'T>) = + ParallelArrays.tryPick chooser (unwrapArray (nameof array) array) + + // ---- Transformation ---- + + [] + let choose (chooser : 'T -> 'U voption) (array : FlatList<'T>) = + ParallelArrays.choose chooser (unwrapArray (nameof array) array) + |> wrapArray + + [] + let collect (mapping : 'T -> FlatList<'U>) (array : FlatList<'T>) = + // As in Array.Parallel.collect, the mapping runs in parallel, and the results are copied in their order into one + // array of their total length. Array.Parallel.collect dereferences a null result; a default flat list from the + // mapping throws ArgumentNullException instead, as in the sequential collect (ADR 0001, D6). + let results = Array.Parallel.map mapping (unwrapArray (nameof array) array) + let mutable length = 0 + + for result in results do + checkNotDefault (nameof mapping) result + length <- length + result.Length + + let builder = ImmutableArray.CreateBuilder<'U> length + + for result in results do + builder.AddRange result + + builder.MoveToImmutable () + + [] + let filter predicate (array : FlatList<'T>) = + Array.Parallel.filter predicate (unwrapArray (nameof array) array) + |> wrapArray + + [] + let map (mapping : 'T -> 'U) (array : FlatList<'T>) = + Array.Parallel.map mapping (unwrapArray (nameof array) array) + |> wrapArray + + [] + let mapi (mapping : int -> 'T -> 'U) (array : FlatList<'T>) = + Array.Parallel.mapi mapping (unwrapArray (nameof array) array) + |> wrapArray + + [] + let zip (array1 : FlatList<'T1>) (array2 : FlatList<'T2>) = + let source1 = unwrapArray (nameof array1) array1 + let source2 = unwrapArray (nameof array2) array2 + ArrayChecks.sameLengths (nameof array1) source1 (nameof array2) source2 + ParallelArrays.zip structPair source1 source2 |> wrapArray + + // ---- Folding ---- + + // The inline functions can use public members only, so they check and unwrap the array themselves + [] + let inline average (array : FlatList< ^T >) : ^T = + if array.IsDefault then + nullArg (nameof array) + + Array.Parallel.average ( + ImmutableCollectionsMarshal.AsArray array + |> Unchecked.nonNull + ) + + [] + let inline averageBy ([] projection : 'T -> ^U) (array : FlatList<'T>) : ^U = + if array.IsDefault then + nullArg (nameof array) + + Array.Parallel.averageBy + projection + (ImmutableCollectionsMarshal.AsArray array + |> Unchecked.nonNull) + + [] + let iter action (array : FlatList<'T>) = Array.Parallel.iter action (unwrapArray (nameof array) array) + + [] + let iteri action (array : FlatList<'T>) = Array.Parallel.iteri action (unwrapArray (nameof array) array) + + [] + let max (array : FlatList<'T>) = Array.Parallel.max (unwrapArray (nameof array) array) + + [] + let maxBy (projection : 'T -> 'U) (array : FlatList<'T>) = Array.Parallel.maxBy projection (unwrapArray (nameof array) array) + + [] + let min (array : FlatList<'T>) = Array.Parallel.min (unwrapArray (nameof array) array) + + [] + let minBy (projection : 'T -> 'U) (array : FlatList<'T>) = Array.Parallel.minBy projection (unwrapArray (nameof array) array) + + [] + let reduce reduction (array : FlatList<'T>) = Array.Parallel.reduce reduction (unwrapArray (nameof array) array) + + [] + let reduceBy (projection : 'T -> 'U) reduction (array : FlatList<'T>) = + Array.Parallel.reduceBy projection reduction (unwrapArray (nameof array) array) + + // Array.Parallel.sum dereferences a null array without a check; a default flat list throws ArgumentNullException, + // which its documentation promises + [] + let inline sum (array : FlatList< ^T >) : ^T = + if array.IsDefault then + nullArg (nameof array) + + Array.Parallel.sum ( + ImmutableCollectionsMarshal.AsArray array + |> Unchecked.nonNull + ) + + [] + let inline sumBy ([] projection : 'T -> ^U) (array : FlatList<'T>) : ^U = + if array.IsDefault then + nullArg (nameof array) + + Array.Parallel.sumBy + projection + (ImmutableCollectionsMarshal.AsArray array + |> Unchecked.nonNull) + + // ---- Partitioning and grouping ---- + + [] + let groupBy (projection : 'T -> 'Key) (array : FlatList<'T>) = + ParallelArrays.groupBy (fun key items -> struct (key, wrapArray items)) projection (unwrapArray (nameof array) array) + |> wrapArray + + [] + let partition predicate (array : FlatList<'T>) = + let accepted, rejected = Array.Parallel.partition predicate (unwrapArray (nameof array) array) + struct (wrapArray accepted, wrapArray rejected) + + [] + let partitionWith (partitioner : 'T -> Choice<'T1, 'T2>) (array : FlatList<'T>) = + let first, second = Array.Parallel.partitionWith partitioner (unwrapArray (nameof array) array) + struct (wrapArray first, wrapArray second) + + // ---- Sorting ---- + + [] + let sort (array : FlatList<'T>) = + Array.Parallel.sort (unwrapArray (nameof array) array) + |> wrapArray + + [] + let sortBy (projection : 'T -> 'Key) (array : FlatList<'T>) = + Array.Parallel.sortBy projection (unwrapArray (nameof array) array) + |> wrapArray + + [] + let sortByDescending (projection : 'T -> 'Key) (array : FlatList<'T>) = + Array.Parallel.sortByDescending projection (unwrapArray (nameof array) array) + |> wrapArray + + [] + let sortDescending (array : FlatList<'T>) = + Array.Parallel.sortDescending (unwrapArray (nameof array) array) + |> wrapArray + + [] + let sortWith comparer (array : FlatList<'T>) = + Array.Parallel.sortWith comparer (unwrapArray (nameof array) array) + |> wrapArray diff --git a/src/FSharp.Collections.Immutable/FlatList/FlatList.fsi b/src/FSharp.Collections.Immutable/FlatList/FlatList.fsi index 72a7904f..4f746557 100644 --- a/src/FSharp.Collections.Immutable/FlatList/FlatList.fsi +++ b/src/FSharp.Collections.Immutable/FlatList/FlatList.fsi @@ -2073,3 +2073,419 @@ val isDefault : array : FlatList<'T> -> bool /// [] val isDefaultOrEmpty : array : FlatList<'T> -> bool + +/// +/// Functions that process the elements of a flat list in parallel. +/// +/// +/// +/// The module mirrors : each function has the semantics, +/// the argument checks and the exceptions of the function with the same name in that module (ADR 0001, D11). The functions +/// read the underlying array without a copy and never change it; the in-place sorts of that module have no counterpart. +/// +/// +/// The functions call their function arguments on several threads at once and in an unspecified order, so the function +/// arguments must be thread-safe. An exception that a function argument throws can reach the caller wrapped in an +/// . +/// +/// +/// A default immutable array throws , as +/// does for a array. +/// +/// +/// Functions that return an optional value return a , and +/// functions that return tuples return struct tuples. The namespaces +/// and contain a module with the same name whose functions use options +/// and reference tuples instead. +/// +/// +[] +module Parallel = + + // ---- Creation ---- + + /// + /// Creates a flat list from a function of the index, in parallel. + /// + /// The length of the flat list. + /// The function that computes the element at each index, called in parallel. + /// The created flat list. + /// Thrown when is negative. + /// + /// O(n). A negative count throws , as in + /// , + /// where the sequential function throws . + /// + [] + val init : count : int -> initializer : (int -> 'T) -> FlatList<'T> + + // ---- Search ---- + + /// + /// Returns whether any element satisfies the predicate. + /// + /// The function to test the elements, called in parallel. + /// The input flat list. + /// when an element satisfies the predicate. + /// + /// O(n). An element that satisfies the predicate stops the tests of the other elements as soon as possible. + /// + [] + val exists : predicate : ('T -> bool) -> array : FlatList<'T> -> bool + + /// + /// Returns whether all elements satisfy the predicate. + /// + /// The function to test the elements, called in parallel. + /// The input flat list. + /// when every element satisfies the predicate. + /// + /// O(n). An element that does not satisfy the predicate stops the tests of the other elements as soon as possible. + /// + [] + val forall : predicate : ('T -> bool) -> array : FlatList<'T> -> bool + + /// + /// Returns the first element that satisfies the predicate, or ValueNone. + /// + /// The function to test the elements, called in parallel. + /// The input flat list. + /// The first element that satisfies the predicate, or ValueNone. + /// + /// O(n). The predicate can also run for elements after the first one that satisfies it. + /// + [] + val tryFind : predicate : ('T -> bool) -> array : FlatList<'T> -> 'T voption + + /// + /// Returns the index of the first element that satisfies the predicate, or ValueNone. + /// + /// The function to test the elements, called in parallel. + /// The input flat list. + /// The index of the first element that satisfies the predicate, or ValueNone. + /// + /// O(n). The predicate can also run for elements after the first one that satisfies it. + /// + [] + val tryFindIndex : predicate : ('T -> bool) -> array : FlatList<'T> -> int voption + + /// + /// Returns the first value that the chooser returns for the elements, or ValueNone. + /// + /// The function that returns a value, or ValueNone to go on, called in parallel. + /// The input flat list. + /// The value for the first element that the chooser returns a value for, or ValueNone. + /// + /// O(n). The chooser can also run for elements after the first one that it returns a value for. + /// + [] + val tryPick : chooser : ('T -> 'U voption) -> array : FlatList<'T> -> 'U voption + + // ---- Transformation ---- + + /// + /// Returns the values that the chooser returns for the elements. + /// + /// + /// The function that returns a value, or ValueNone to skip the element, called in parallel. + /// + /// The input flat list. + /// The chosen values, in the order of their elements. + /// + /// O(n). + /// + [] + val choose : chooser : ('T -> 'U voption) -> array : FlatList<'T> -> FlatList<'U> + + /// + /// Concatenates the flat lists that a function returns for the elements. + /// + /// The function that returns a flat list for each element, called in parallel. + /// The input flat list. + /// The concatenation of the returned flat lists, in the order of the elements. + /// Thrown when the mapping returns a default flat list. + /// + /// O(n + the total length of the returned flat lists). + /// + [] + val collect : mapping : ('T -> FlatList<'U>) -> array : FlatList<'T> -> FlatList<'U> + + /// Returns the elements that satisfy the predicate. + /// The function to test the elements, called in parallel. + /// The input flat list. + /// The elements that satisfy the predicate, in their order. + /// O(n). + [] + val filter : predicate : ('T -> bool) -> array : FlatList<'T> -> FlatList<'T> + + /// Returns the results of a function applied to each element. + /// The function to transform the elements, called in parallel. + /// The input flat list. + /// The results, in the order of the elements. + /// O(n). + [] + val map : mapping : ('T -> 'U) -> array : FlatList<'T> -> FlatList<'U> + + /// + /// Returns the results of a function applied to each element and its index. + /// + /// The function to transform the elements, called in parallel. + /// The input flat list. + /// The results, in the order of the elements. + /// + /// O(n). + /// + [] + val mapi : mapping : (int -> 'T -> 'U) -> array : FlatList<'T> -> FlatList<'U> + + /// + /// Combines two flat lists into a flat list of pairs, in parallel. + /// + /// The first flat list. + /// The second flat list. + /// The pairs of elements at the same index. + /// Thrown when the flat lists have different lengths. + /// + /// O(n). + /// + [] + val zip : array1 : FlatList<'T1> -> array2 : FlatList<'T2> -> FlatList + + // ---- Folding ---- + + /// + /// Returns the average of the elements, which are added in parallel. + /// + /// The input flat list. + /// The average. + /// Thrown when the flat list is empty. + /// + /// O(n). The elements are added in chunks, so a floating-point average can differ in its last digits from the + /// sequential one. + /// + [] + val inline average : + array : FlatList< ^T > -> ^T + when ^T : (static member (+) : ^T * ^T -> ^T) and ^T : (static member DivideByInt : ^T * int -> ^T) + + /// + /// Returns the average of the results of a function applied to each element. + /// + /// The function to transform the elements, called in parallel. + /// The input flat list. + /// The average of the results. + /// Thrown when the flat list is empty. + /// + /// O(n). The results are added in chunks, so a floating-point average can differ in its last digits from the + /// sequential one. + /// + [] + val inline averageBy : + projection : ('T -> ^U) -> array : FlatList<'T> -> ^U + when ^U : (static member (+) : ^U * ^U -> ^U) and ^U : (static member DivideByInt : ^U * int -> ^U) + + /// Applies an action to each element, in parallel. + /// The action, called in parallel. + /// The input flat list. + /// O(n). + [] + val iter : action : ('T -> unit) -> array : FlatList<'T> -> unit + + /// + /// Applies an action to each element and its index, in parallel. + /// + /// The action, called in parallel. + /// The input flat list. + /// + /// O(n). + /// + [] + val iteri : action : (int -> 'T -> unit) -> array : FlatList<'T> -> unit + + /// Returns the greatest element, in F# generic comparison. + /// The input flat list. + /// The greatest element. + /// Thrown when the flat list is empty. + /// O(n). The elements are compared in parallel chunks. + [] + val max : array : FlatList<'T> -> 'T when 'T : comparison + + /// Returns an element with the greatest result of a projection. + /// The function to transform the elements for the comparison, called in parallel. + /// The input flat list. + /// An element with the greatest result; which one of several such elements is not specified. + /// Thrown when the flat list is empty. + /// O(n). + [] + val maxBy : projection : ('T -> 'U) -> array : FlatList<'T> -> 'T when 'U : comparison + + /// Returns the smallest element, in F# generic comparison. + /// The input flat list. + /// The smallest element. + /// Thrown when the flat list is empty. + /// O(n). The elements are compared in parallel chunks. + [] + val min : array : FlatList<'T> -> 'T when 'T : comparison + + /// Returns an element with the smallest result of a projection. + /// The function to transform the elements for the comparison, called in parallel. + /// The input flat list. + /// An element with the smallest result; which one of several such elements is not specified. + /// Thrown when the flat list is empty. + /// O(n). + [] + val minBy : projection : ('T -> 'U) -> array : FlatList<'T> -> 'T when 'U : comparison + + /// Combines the elements with a function, in parallel. + /// + /// The function that combines two values. It combines the elements in parallel chunks and then the results of the + /// chunks, so it must be associative and commutative for a result that does not depend on the chunks. + /// + /// The input flat list. + /// The combined value. + /// Thrown when the flat list is empty. + /// O(n). + [] + val reduce : reduction : ('T -> 'T -> 'T) -> array : FlatList<'T> -> 'T + + /// + /// Combines the results of a function applied to each element with another function, in parallel. + /// + /// The function to transform the elements, called in parallel. + /// + /// The function that combines two results. It combines the results in parallel chunks and then the results of the + /// chunks, so it must be associative and commutative for a result that does not depend on the chunks. + /// + /// The input flat list. + /// The combined value. + /// Thrown when the flat list is empty. + /// + /// O(n). The sequential module has no counterpart: the value is the reduction of the mapped elements. + /// + [] + val reduceBy : projection : ('T -> 'U) -> reduction : ('U -> 'U -> 'U) -> array : FlatList<'T> -> 'U + + /// + /// Returns the sum of the elements, which are added in parallel. + /// + /// The input flat list. + /// The sum; zero for an empty flat list. + /// + /// O(n). The elements are added in chunks, so a floating-point sum can differ in its last digits from the sequential + /// one. + /// + [] + val inline sum : array : FlatList< ^T > -> ^T when ^T : (static member (+) : ^T * ^T -> ^T) and ^T : (static member Zero : ^T) + + /// + /// Returns the sum of the results of a function applied to each element. + /// + /// The function to transform the elements, called in parallel. + /// The input flat list. + /// The sum of the results; zero for an empty flat list. + /// + /// O(n). The results are added in chunks, so a floating-point sum can differ in its last digits from the sequential + /// one. + /// + [] + val inline sumBy : + projection : ('T -> ^U) -> array : FlatList<'T> -> ^U + when ^U : (static member (+) : ^U * ^U -> ^U) and ^U : (static member Zero : ^U) + + // ---- Partitioning and grouping ---- + + /// + /// Groups the elements by the key of a projection. + /// + /// The function that returns the key of an element, called in parallel. + /// The input flat list. + /// + /// The keys with their elements. The order of the keys and the order of the elements of a key are not specified. + /// + /// + /// O(n). The keys compare in F# structural equality, except that keys of type and + /// compare as in + /// , + /// which puts all NaN keys in one group. + /// + [] + val groupBy : projection : ('T -> 'Key) -> array : FlatList<'T> -> FlatList)> when 'Key : equality + + /// Splits the elements by a predicate. + /// The function to test the elements, called in parallel. + /// The input flat list. + /// The elements that satisfy the predicate and the other ones, both in their order. + /// O(n). + [] + val partition : predicate : ('T -> bool) -> array : FlatList<'T> -> struct (FlatList<'T> * FlatList<'T>) + + /// + /// Splits the elements by the choice that a function returns for them. + /// + /// + /// The function that returns Choice1Of2 or Choice2Of2 for an element, called in parallel. + /// + /// The input flat list. + /// The values of the first choices and of the second choices, both in the order of the elements. + /// + /// O(n). + /// + [] + val partitionWith : partitioner : ('T -> Choice<'T1, 'T2>) -> array : FlatList<'T> -> struct (FlatList<'T1> * FlatList<'T2>) + + // ---- Sorting ---- + + /// + /// Sorts the elements in parallel, in the order of F# generic comparison. + /// + /// The input flat list. + /// The sorted flat list. + /// + /// O(n log n). This is not a stable sort, as + /// . + /// + [] + val sort : array : FlatList<'T> -> FlatList<'T> when 'T : comparison + + /// + /// Sorts the elements in parallel by the result of a projection, in the order of F# generic comparison. + /// + /// The function that returns the key of an element, called in parallel. + /// The input flat list. + /// The sorted flat list. + /// + /// O(n log n). This is not a stable sort. + /// + [] + val sortBy : projection : ('T -> 'Key) -> array : FlatList<'T> -> FlatList<'T> when 'Key : comparison + + /// + /// Sorts the elements in parallel by the result of a projection, in descending order. + /// + /// The function that returns the key of an element, called in parallel. + /// The input flat list. + /// The sorted flat list. + /// + /// O(n log n). This is not a stable sort. + /// + [] + val sortByDescending : projection : ('T -> 'Key) -> array : FlatList<'T> -> FlatList<'T> when 'Key : comparison + + /// + /// Sorts the elements in parallel, in descending order of F# generic comparison. + /// + /// The input flat list. + /// The sorted flat list. + /// + /// O(n log n). This is not a stable sort. + /// + [] + val sortDescending : array : FlatList<'T> -> FlatList<'T> when 'T : comparison + + /// Sorts the elements in parallel with a comparison function. + /// The function that compares two elements, called in parallel. + /// The input flat list. + /// The sorted flat list. + /// O(n log n). This is not a stable sort. + [] + val sortWith : comparer : ('T -> 'T -> int) -> array : FlatList<'T> -> FlatList<'T> diff --git a/src/FSharp.Collections.Immutable/FlatList/FlatListOption.fs b/src/FSharp.Collections.Immutable/FlatList/FlatListOption.fs index b510cf8b..7307fb3a 100644 --- a/src/FSharp.Collections.Immutable/FlatList/FlatListOption.fs +++ b/src/FSharp.Collections.Immutable/FlatList/FlatListOption.fs @@ -56,3 +56,26 @@ let tryPick (chooser : 'T -> 'U option) (array : FlatList<'T>) = Array.tryPick c let choose (chooser : 'T -> 'U option) (array : FlatList<'T>) = Array.choose chooser (unwrapArray (nameof array) array) |> wrapArray + +// The functions call the Array.Parallel functions, which take and return options, over the underlying array +[] +module Parallel = + + // ---- Search ---- + + [] + let tryFind predicate (array : FlatList<'T>) = Array.Parallel.tryFind predicate (unwrapArray (nameof array) array) + + [] + let tryFindIndex predicate (array : FlatList<'T>) = Array.Parallel.tryFindIndex predicate (unwrapArray (nameof array) array) + + [] + let tryPick (chooser : 'T -> 'U option) (array : FlatList<'T>) = + Array.Parallel.tryPick chooser (unwrapArray (nameof array) array) + + // ---- Transformation ---- + + [] + let choose (chooser : 'T -> 'U option) (array : FlatList<'T>) = + Array.Parallel.choose chooser (unwrapArray (nameof array) array) + |> wrapArray diff --git a/src/FSharp.Collections.Immutable/FlatList/FlatListOption.fsi b/src/FSharp.Collections.Immutable/FlatList/FlatListOption.fsi index 33a1a000..e4b88802 100644 --- a/src/FSharp.Collections.Immutable/FlatList/FlatListOption.fsi +++ b/src/FSharp.Collections.Immutable/FlatList/FlatListOption.fsi @@ -173,3 +173,70 @@ val tryPick : chooser : ('T -> 'U option) -> array : FlatList<'T> -> 'U option /// [] val choose : chooser : ('T -> 'U option) -> array : FlatList<'T> -> FlatList<'U> + +/// +/// The functions of that take or return an optional +/// value, with instead of +/// . +/// +/// +/// The other functions of the default module stay available after open FSharp.Collections.Immutable.Option. Each +/// function has the signature of the function with the same name in +/// . +/// +[] +module Parallel = + + // ---- Search ---- + + /// + /// Returns the first element that satisfies the predicate, or None. + /// + /// The function to test the elements, called in parallel. + /// The input flat list. + /// The first element that satisfies the predicate, or None. + /// + /// O(n). The predicate can also run for elements after the first one that satisfies it. + /// + [] + val tryFind : predicate : ('T -> bool) -> array : FlatList<'T> -> 'T option + + /// + /// Returns the index of the first element that satisfies the predicate, or None. + /// + /// The function to test the elements, called in parallel. + /// The input flat list. + /// The index of the first element that satisfies the predicate, or None. + /// + /// O(n). The predicate can also run for elements after the first one that satisfies it. + /// + [] + val tryFindIndex : predicate : ('T -> bool) -> array : FlatList<'T> -> int option + + /// + /// Returns the first value that the chooser returns for the elements, or None. + /// + /// The function that returns a value, or None to go on, called in parallel. + /// The input flat list. + /// The value for the first element that the chooser returns a value for, or None. + /// + /// O(n). The chooser can also run for elements after the first one that it returns a value for. + /// + [] + val tryPick : chooser : ('T -> 'U option) -> array : FlatList<'T> -> 'U option + + // ---- Transformation ---- + + /// + /// Returns the values that the chooser returns for the elements. + /// + /// + /// The function that returns a value, or None to skip the element, called in parallel. + /// + /// The input flat list. + /// The chosen values, in the order of their elements. + /// + /// O(n). + /// + [] + val choose : chooser : ('T -> 'U option) -> array : FlatList<'T> -> FlatList<'U> diff --git a/src/FSharp.Collections.Immutable/FlatList/FlatListTuple.fs b/src/FSharp.Collections.Immutable/FlatList/FlatListTuple.fs index 7425d044..3cc458b3 100644 --- a/src/FSharp.Collections.Immutable/FlatList/FlatListTuple.fs +++ b/src/FSharp.Collections.Immutable/FlatList/FlatListTuple.fs @@ -110,3 +110,40 @@ let partitionWith (partitioner : 'T -> Choice<'T1, 'T2>) (array : FlatList<'T>) let splitAt index (array : FlatList<'T>) = let struct (before, after) = FSharp.Collections.Immutable.FlatList.splitAt index array before, after + +// As in the module above: the functions that build a tuple per element share their algorithm with the default module, +// and the others delegate to it and repack the tuples +[] +module Parallel = + + // ---- Transformation ---- + + [] + let zip (array1 : FlatList<'T1>) (array2 : FlatList<'T2>) = + let source1 = unwrapArray (nameof array1) array1 + let source2 = unwrapArray (nameof array2) array2 + ArrayChecks.sameLengths (nameof array1) source1 (nameof array2) source2 + + ParallelArrays.zip referencePair source1 source2 + |> wrapArray + + // ---- Partitioning and grouping ---- + + [] + let groupBy (projection : 'T -> 'Key) (array : FlatList<'T>) = + ParallelArrays.groupBy (fun key items -> key, wrapArray items) projection (unwrapArray (nameof array) array) + |> wrapArray + + [] + let partition predicate (array : FlatList<'T>) = + let struct (accepted, rejected) = + FSharp.Collections.Immutable.FlatList.Parallel.partition predicate array + + accepted, rejected + + [] + let partitionWith (partitioner : 'T -> Choice<'T1, 'T2>) (array : FlatList<'T>) = + let struct (first, second) = + FSharp.Collections.Immutable.FlatList.Parallel.partitionWith partitioner array + + first, second diff --git a/src/FSharp.Collections.Immutable/FlatList/FlatListTuple.fsi b/src/FSharp.Collections.Immutable/FlatList/FlatListTuple.fsi index 6000cc94..de5ce621 100644 --- a/src/FSharp.Collections.Immutable/FlatList/FlatListTuple.fsi +++ b/src/FSharp.Collections.Immutable/FlatList/FlatListTuple.fsi @@ -169,3 +169,71 @@ val partitionWith : partitioner : ('T -> Choice<'T1, 'T2>) -> array : FlatList<' /// [] val splitAt : index : int -> array : FlatList<'T> -> FlatList<'T> * FlatList<'T> + +/// +/// The functions of that take or return tuples, with +/// reference tuples instead of struct tuples. +/// +/// +/// The other functions of the default module stay available after open FSharp.Collections.Immutable.Tuple. Each +/// function has the signature of the function with the same name in +/// . +/// +[] +module Parallel = + + // ---- Transformation ---- + + /// + /// Combines two flat lists into a flat list of pairs, in parallel. + /// + /// The first flat list. + /// The second flat list. + /// The pairs of elements at the same index. + /// Thrown when the flat lists have different lengths. + /// + /// O(n). + /// + [] + val zip : array1 : FlatList<'T1> -> array2 : FlatList<'T2> -> FlatList<'T1 * 'T2> + + // ---- Partitioning and grouping ---- + + /// + /// Groups the elements by the key of a projection. + /// + /// The function that returns the key of an element, called in parallel. + /// The input flat list. + /// + /// The keys with their elements. The order of the keys and the order of the elements of a key are not specified. + /// + /// + /// O(n). The keys compare in F# structural equality, except that keys of type and + /// compare as in + /// , + /// which puts all NaN keys in one group. + /// + [] + val groupBy : projection : ('T -> 'Key) -> array : FlatList<'T> -> FlatList<'Key * FlatList<'T>> when 'Key : equality + + /// Splits the elements by a predicate. + /// The function to test the elements, called in parallel. + /// The input flat list. + /// The elements that satisfy the predicate and the other ones, both in their order. + /// O(n). + [] + val partition : predicate : ('T -> bool) -> array : FlatList<'T> -> FlatList<'T> * FlatList<'T> + + /// + /// Splits the elements by the choice that a function returns for them. + /// + /// + /// The function that returns Choice1Of2 or Choice2Of2 for an element, called in parallel. + /// + /// The input flat list. + /// The values of the first choices and of the second choices, both in the order of the elements. + /// + /// O(n). + /// + [] + val partitionWith : partitioner : ('T -> Choice<'T1, 'T2>) -> array : FlatList<'T> -> FlatList<'T1> * FlatList<'T2> diff --git a/src/FSharp.Collections.Immutable/Helper/ParallelArrays.fs b/src/FSharp.Collections.Immutable/Helper/ParallelArrays.fs new file mode 100644 index 00000000..12ca9ff3 --- /dev/null +++ b/src/FSharp.Collections.Immutable/Helper/ParallelArrays.fs @@ -0,0 +1,345 @@ +/// +/// Parallel algorithms over arrays for the functions of +/// that take or return options or reference tuples +/// (ADR 0001, D3 and D11). +/// +/// +/// +/// The default functions of take and return value options and struct +/// tuples, and the functions of the module return reference +/// tuples, where the FSharp.Core functions take and return options and return reference tuples. Calling the FSharp.Core +/// function and converting would allocate for every element. The algorithms here take value options and tuple constructors +/// instead, so that the default modules and the modules of the namespace +/// share them and nothing is allocated per element. +/// +/// +/// The callers check their arguments first, with the exceptions of +/// , so the algorithms check nothing and document no +/// exceptions. +/// +/// +/// The summary of each function that mirrors a function of the FSharp.Core +/// module is the summary of that function word for word +/// (FSharp.Core 10.1), with ValueSome and ValueNone where it says Some and None, and so are the +/// descriptions of the parameters and of the result where the signatures agree. The remarks say what differs and why the +/// function exists. +/// +/// +module internal FSharp.Collections.Immutable.ParallelArrays + +open System +open System.Collections.Generic +open System.Linq +open System.Threading.Tasks + +/// +/// The chunks of a chunked parallel loop over elements on +/// processors, each as its first index and the index after its last one. +/// +/// The number of processors. +/// The number of elements. +/// The chunks, each as a struct tuple of its first index and the index after its last one. +/// +/// +/// The chunks are those of the chunked loops of : one chunk +/// per processor, and a single chunk for fewer than 256 elements, which are not worth a second thread. +/// +/// +/// The arithmetic stays in the range of for every array length. The count divides the length +/// minus one, because the length plus the chunk length overflows for arrays of more than half the maximum length. The end +/// of a chunk adds only the elements that remain to its first index, because the first index plus the full chunk length +/// can overflow for arrays near the maximum length on machines with more than 56 processors. +/// +/// +/// FSharp.Core has no such function in its public API. It is a function of its own, so that +/// +/// and the tests share it, and the tests can check the arithmetic for lengths that no array can have. +/// +/// +let chunks (processors : int) (length : int) : struct (int * int) array = + let chunk = + if length < 256 then length + elif length % processors = 0 then length / processors + else length / processors + 1 + + let count = if chunk = 0 then 0 else (length - 1) / chunk + 1 + + Array.init + count + (fun index -> + let first = index * chunk + struct (first, first + min chunk (length - first)) + ) + +/// +/// Runs an action on the chunks of the indices from 0 to in parallel. +/// +/// The number of elements. +/// The action, which takes the first index of its chunk and the index after its last one. +/// +/// +/// A loop per chunk calls no delegate per element. +/// +/// +/// FSharp.Core has no such function in its public API. It exists because a +/// over the +/// indices calls a delegate for every element, where the action of a chunk is inlined and loops over its indices. +/// +/// +let inline forEachChunk (length : int) ([] action : int -> int -> unit) = + let bounds = chunks Environment.ProcessorCount length + + Parallel.For ( + 0, + bounds.Length, + fun index -> + let struct (first, last) = bounds[index] + action first last + ) + |> ignore + +/// +/// Apply the given function to each element of the array. Return the array comprised of the results x for each +/// element where the function returns ValueSome x. +/// +/// The function to generate value options from the elements. +/// The input array. +/// The array of results. +/// +/// +/// Performs the operation in parallel using . The order in which the +/// given function is applied to elements of the input array is not specified. This is an O(n) operation, where n is the +/// length of the array. +/// +/// +/// It exists because +/// +/// takes a chooser that returns options, and would convert every value option to an option. The chooser runs in parallel +/// into an array of value options, which a sequential pass compacts. +/// +/// +/// +let choose (chooser : 'T -> 'U voption) (array : 'T array) : 'U array = + let chosen = Array.Parallel.map chooser array + let mutable count = 0 + + for value in chosen do + if value.IsSome then + count <- count + 1 + + let result = Array.zeroCreate count + let mutable index = 0 + + for value in chosen do + match value with + | ValueSome item -> + result[index] <- item + index <- index + 1 + | ValueNone -> () + + result + +/// +/// The comparer of the keys of a parallel grouping. +/// +/// +/// The comparer of F# structural equality, except that the keys of the types and +/// compare with . +/// +/// +/// +/// Keys of type and compare as in +/// : +/// with , so that all NaN keys are in +/// one group. Other keys compare in F# structural equality, in which NaN is not equal to itself. +/// +/// +/// A key that contains NaN, such as a tuple, therefore makes a group of its own, as in +/// . +/// The function of FSharp.Core throws for such a key: its second pass cannot find +/// the key that its first pass added. That failure is not mirrored. +/// +/// +/// FSharp.Core has no such function in its public API. It exists because the grouping here runs over the keys with +/// , +/// which takes the comparer of the keys, and the comparer has to be that of FSharp.Core. +/// +/// +let groupingComparer<'Key when 'Key : equality> () : IEqualityComparer<'Key> = + if + Type.(=) (typeof<'Key>, typeof) + || Type.(=) (typeof<'Key>, typeof) + then + HashIdentity.FromFunctions<'Key> LanguagePrimitives.GenericHash LanguagePrimitives.GenericEqualityER + else + HashIdentity.Structural<'Key> + +/// +/// Applies a key-generating function to each element of an array in parallel and yields an array of unique keys. Each +/// unique key contains an array of all elements that match to this key. +/// +/// The function that builds an element of the result from a key and the array of its elements. +/// A function that transforms an element of the array into a comparable key. +/// The input array. +/// The result array. +/// +/// +/// Performs the operation in parallel using . The order in which the +/// given function is applied to elements of the input array is not specified. The order of the keys and values in the +/// result is also not specified. This is an O(n) operation, where n is the length of the array. +/// +/// +/// It exists because +/// +/// returns reference tuples. The projection, the work of the caller, runs in parallel. The grouping then runs over the +/// computed keys with +/// +/// and the comparer of , so that a +/// key is a key like any other. The result has the order of +/// , +/// one of the orders that +/// +/// allows. +/// +/// +/// +/// +let inline groupBy + ([] tuple : 'Key -> 'T array -> 'R) + (projection : 'T -> 'Key) + (array : 'T array) + : 'R array when 'Key : equality = + let keys = Array.Parallel.map projection array + + let lookup = + Enumerable + .Range(0, array.Length) + .ToLookup((fun index -> keys[index]), (fun index -> array[index]), groupingComparer<'Key>()) + + let result = Array.zeroCreate lookup.Count + let mutable index = 0 + + for grouping in lookup do + result[index] <- tuple grouping.Key (grouping.ToArray ()) + index <- index + 1 + + result + +/// +/// Returns the index of the first element in the array that satisfies the given predicate. Returns ValueNone if no +/// such element exists. +/// +/// The function to test the input elements. +/// The input array. +/// The index of the first element that satisfies the predicate, or ValueNone. +/// +/// +/// This is an O(n) operation in the worst case, where n is the length of the array. +/// +/// +/// It exists because +/// +/// returns an option, where the default functions return a value option. The predicate runs in parallel. A match breaks the +/// loop, which then starts only the elements before it, and the lowest index that broke the loop wins, as in the function +/// of FSharp.Core. +/// +/// +/// +/// +let tryFindIndex (predicate : 'T -> bool) (array : 'T array) : int voption = + let result = + Parallel.For ( + 0, + array.Length, + fun index (state : ParallelLoopState) -> + if predicate array[index] then + state.Break () + ) + + let lowest = result.LowestBreakIteration + + if lowest.HasValue then + ValueSome (int lowest.Value) + else + ValueNone + +/// +/// Applies the given function to successive elements, returning the first result where the function returns +/// ValueSome x for some x. If the function never returns ValueSome x then ValueNone is +/// returned. +/// +/// The function to transform the array elements into value options. +/// The input array. +/// The first transformed element that is ValueSome x. +/// +/// +/// This is an O(n) operation in the worst case, where n is the length of the array. +/// +/// +/// It exists because +/// +/// takes a chooser that returns options, where the default functions use value options. The chooser runs in parallel. A +/// value breaks the loop, which then starts only the elements before it, and the value of the lowest index wins. The +/// function of FSharp.Core keeps every value in a concurrent dictionary by index; here a lock guards the value of the +/// lowest index so far, and only the elements that have a value take it. +/// +/// +/// +let tryPick (chooser : 'T -> 'U voption) (array : 'T array) : 'U voption = + let gate = obj () + let lowest = ref Int32.MaxValue + let chosen = ref ValueNone + + Parallel.For ( + 0, + array.Length, + fun index (state : ParallelLoopState) -> + match chooser array[index] with + | ValueSome _ as value -> + lock + gate + (fun () -> + if index < lowest.Value then + lowest.Value <- index + chosen.Value <- value + ) + + state.Break () + | ValueNone -> () + ) + |> ignore + + chosen.Value + +/// +/// Combines the two arrays into an array of pairs. The two arrays must have equal lengths, otherwise an +/// is raised. +/// +/// The function that builds an element of the result from the elements at the same index. +/// The first input array. +/// The second input array. +/// The array of tupled elements. +/// +/// +/// This is an O(n) operation, where n is the length of the arrays. The chunks are those of +/// . The callers check the lengths first +/// and raise its exception. +/// +/// +/// It exists because that function returns reference tuples, which allocate for every element, where the default function +/// returns struct tuples. +/// +/// +/// +/// +let inline zip ([] tuple : 'T1 -> 'T2 -> 'R) (array1 : 'T1 array) (array2 : 'T2 array) : 'R array = + let result = Array.zeroCreate array1.Length + + forEachChunk + result.Length + (fun first last -> + for index = first to last - 1 do + result[index] <- tuple array1[index] array2[index] + ) + + result diff --git a/tests/FSharp.Collections.Immutable.Tests/FSharp.Collections.Immutable.Tests.fsproj b/tests/FSharp.Collections.Immutable.Tests/FSharp.Collections.Immutable.Tests.fsproj index be217625..42889292 100644 --- a/tests/FSharp.Collections.Immutable.Tests/FSharp.Collections.Immutable.Tests.fsproj +++ b/tests/FSharp.Collections.Immutable.Tests/FSharp.Collections.Immutable.Tests.fsproj @@ -58,6 +58,9 @@ + + + diff --git a/tests/FSharp.Collections.Immutable.Tests/FlatList/FlatListParallelOptionTests.fs b/tests/FSharp.Collections.Immutable.Tests/FlatList/FlatListParallelOptionTests.fs new file mode 100644 index 00000000..7e7d327d --- /dev/null +++ b/tests/FSharp.Collections.Immutable.Tests/FlatList/FlatListParallelOptionTests.fs @@ -0,0 +1,134 @@ +namespace FSharp.Collections.Immutable.Tests + +open FSharp.Collections.Immutable +open FSharp.Collections.Immutable.Tuple +open FSharp.Collections.Immutable.Option +open Microsoft.VisualStudio.TestTools.UnitTesting + +// The namespaces are opened in the order that gives the shapes of FSharp.Core: Tuple first, Option last. +// The type annotations of the results are the proof that the functions of the Option namespace shadow the default ones, +// also in the nested Parallel module. + +/// The `FlatList.Parallel` module of the `Option` namespace. +[] +type FlatListParallelOptionTests () = + + static let array = FlatList.ofArray Inputs.Several + + /// The elements of a flat list long enough for the functions to split their work among several threads. + static let large () = Array.init 10_000 (fun index -> index % 1_000 - 500) + + static let defaultArray = Unchecked.defaultof> + + static let nullArray = Unchecked.defaultof + + static let isAbove (limit : int) (item : int) = item > limit + + static let negatedIfNegative (item : int) = if item < 0 then Some (-item) else None + + /// The flat list of the elements of an input. + static let flatListOf (input : ParallelInput) = FlatList.ofArray (input.Elements large) + + /// The functions that mirror an Array.Parallel function, by name, with that function on a null array and the function + /// on a default flat list. The rows of the test are the names: a function has no readable name in a row. + static let arrayRejections = + [| + struct (nameof FlatList.Parallel.choose, + (fun () -> Array.Parallel.choose negatedIfNegative nullArray |> ignore), + (fun () -> + FlatList.Parallel.choose negatedIfNegative defaultArray + |> ignore + )) + struct (nameof FlatList.Parallel.tryFind, + (fun () -> Array.Parallel.tryFind (isAbove 6) nullArray |> ignore), + (fun () -> FlatList.Parallel.tryFind (isAbove 6) defaultArray |> ignore)) + struct (nameof FlatList.Parallel.tryFindIndex, + (fun () -> Array.Parallel.tryFindIndex (isAbove 6) nullArray |> ignore), + (fun () -> + FlatList.Parallel.tryFindIndex (isAbove 6) defaultArray + |> ignore + )) + struct (nameof FlatList.Parallel.tryPick, + (fun () -> Array.Parallel.tryPick negatedIfNegative nullArray |> ignore), + (fun () -> + FlatList.Parallel.tryPick negatedIfNegative defaultArray + |> ignore + )) + |] + |> Array.map (fun struct (name, oracle, actual) -> name, struct (oracle, actual)) + |> Map.ofArray + + /// The input with several elements of the contracts and the larger input. + static member Sources = seq { + ParallelInput.Several + ParallelInput.Large + } + + /// The names of the functions that mirror an Array.Parallel function, as the rows of their test. + static member ArrayRejections = arrayRejections.Keys + + [] + member _.``tryFind returns an option`` (input : ParallelInput) = + let source = flatListOf input + let found : int option = FlatList.Parallel.tryFind (isAbove 6) source + + OverrideAssert.OptionMatches ( + FSharp.Collections.Immutable.FlatList.Parallel.tryFind (isAbove 6) source, + found, + "Option.FlatList.Parallel.tryFind must match the default" + ) + + [] + member _.``tryFindIndex returns an option`` (input : ParallelInput) = + let source = flatListOf input + let found : int option = FlatList.Parallel.tryFindIndex (isAbove 6) source + + OverrideAssert.OptionMatches ( + FSharp.Collections.Immutable.FlatList.Parallel.tryFindIndex (isAbove 6) source, + found, + "Option.FlatList.Parallel.tryFindIndex must match the default" + ) + + [] + member _.``tryPick takes a chooser of options and returns an option`` (input : ParallelInput) = + let source = flatListOf input + let found : int option = FlatList.Parallel.tryPick negatedIfNegative source + + Assert.AreEqual( + Array.tryPick negatedIfNegative (FlatList.toArray source), + found, + "Option.FlatList.Parallel.tryPick must pick as Array.tryPick does" + ) + + [] + member _.``choose takes a chooser of options`` (input : ParallelInput) = + let source = flatListOf input + let chosen : FlatList = FlatList.Parallel.choose negatedIfNegative source + + CollectionAssert.AreEqual ( + Array.choose negatedIfNegative (FlatList.toArray source), + FlatList.toArray chosen, + "Option.FlatList.Parallel.choose must choose as Array.choose does" + ) + + [] + member _.``the functions reject a default flat list as Array.Parallel rejects a null array`` (name : string) = + let struct (oracle, actual) = arrayRejections[name] + ExceptionAssert.Same (id, oracle, actual, $"Option.FlatList.Parallel.%s{name} must reject a default flat list") + + [] + member _.``the functions without an option keep resolving to the default module`` () = + let mapped : FlatList = FlatList.Parallel.map (fun item -> item * 2) array + let zipped : FlatList = FlatList.Parallel.zip array array + + CollectionAssert.AreEqual ( + Array.map (fun item -> item * 2) Inputs.Several, + FlatList.toArray mapped, + "FlatList.Parallel.map must resolve to the default module" + ) + + CollectionAssert.AreEqual ( + Array.zip Inputs.Several Inputs.Several, + FlatList.toArray zipped, + "FlatList.Parallel.zip must resolve to the Tuple module" + ) diff --git a/tests/FSharp.Collections.Immutable.Tests/FlatList/FlatListParallelTests.fs b/tests/FSharp.Collections.Immutable.Tests/FlatList/FlatListParallelTests.fs new file mode 100644 index 00000000..f901e7f6 --- /dev/null +++ b/tests/FSharp.Collections.Immutable.Tests/FlatList/FlatListParallelTests.fs @@ -0,0 +1,931 @@ +namespace FSharp.Collections.Immutable.Tests + +open System +open System.Collections.Concurrent +open FSharp.Collections.Immutable +open Microsoft.VisualStudio.TestTools.UnitTesting + +/// +/// The inputs of the tests of FlatList.Parallel, as the cases of their rows. +/// +/// +/// MSTest names a row after its values, and the larger input would write ten thousand numbers into the name of each of +/// its rows, so a row holds a case and the test takes the elements of the case. +/// +[] +type ParallelInput = + /// The input without elements of the contracts. + | Empty + /// The input with one element of the contracts. + | Singleton + /// The input with several elements of the contracts. + | Several + /// An input long enough for the functions to split their work among several threads. + | Large + + /// The elements of the input; the test class builds the elements of the larger input. + member this.Elements (large : unit -> int array) = + match this with + | ParallelInput.Empty -> Inputs.Empty + | ParallelInput.Singleton -> Inputs.Singleton + | ParallelInput.Several -> Inputs.Several + | ParallelInput.Large -> large () + +/// +/// The predicates of the tests of FlatList.Parallel, with the choosers that return a value for the same elements, +/// as the cases of their rows: matches at the start, matches late and rare in the larger input, and no match. +/// +/// +/// MSTest names a row after its values, and a function has no readable name, so a row holds a case and the test takes +/// the function of the case. +/// +[] +type ParallelPredicate = + /// The even elements. + | IsEven + /// The negative elements. + | IsNegative + /// The elements above 900, which come late and rarely in the larger input. + | IsAboveNineHundred + /// No element. + | Never + + /// Tells whether an element satisfies the predicate. + member this.Matches (item : int) = + match this with + | ParallelPredicate.IsEven -> item % 2 = 0 + | ParallelPredicate.IsNegative -> item < 0 + | ParallelPredicate.IsAboveNineHundred -> item > 900 + | ParallelPredicate.Never -> false + + /// A chooser that returns a value for the elements that satisfy the predicate. + member this.Choose (item : int) = + match this with + | ParallelPredicate.IsEven -> if item % 2 = 0 then ValueSome (item / 2) else ValueNone + | ParallelPredicate.IsNegative -> if item < 0 then ValueSome (-item) else ValueNone + | ParallelPredicate.IsAboveNineHundred -> if item > 900 then ValueSome (item * 2) else ValueNone + | ParallelPredicate.Never -> ValueNone + +/// The `FlatList.Parallel` module, compared with the sequential functions of `FlatList` (ADR 0001, D11). +/// Every function runs on the inputs of the contracts and on a larger input, which is long enough for the functions to split +/// their work among several threads. Results whose order the module leaves open are compared after sorting, and exceptions +/// are compared with those of `Array.Parallel`, which the module mirrors. +[] +type FlatListParallelTests () = + + static let defaultArray = Unchecked.defaultof> + + static let nullArray = Unchecked.defaultof + + /// Numbers from -1000 to 999 in a scrambled order, each about five times. 7919 and 10 007 are primes, so the products + /// modulo 10 007 do not repeat before the last remainder folds them onto 2000 values. + static let large () = Array.init 10_000 (fun index -> index * 7_919 % 10_007 % 2_000 - 1_000) + + /// The inputs of the contracts and the larger input. + static let allInputs = [| ParallelInput.Empty; ParallelInput.Singleton; ParallelInput.Several; ParallelInput.Large |] + + /// The predicates of the tests. + static let predicates = [| + ParallelPredicate.IsEven + ParallelPredicate.IsNegative + ParallelPredicate.IsAboveNineHundred + ParallelPredicate.Never + |] + + /// The flat list of the elements of an input. + static let flatListOf (input : ParallelInput) = FlatList.ofArray (input.Elements large) + + /// Negation is injective, so only equal elements share a key, and the result of a sort does not depend on its stability. + static let negate (item : int) = -item + + /// The keys of the groups and the elements of every key, sorted, for the comparison of groupings whose order is open. + static let normalized (groups : FlatList)>) = + let sorted = + groups + |> Seq.map (fun struct (key, items) -> struct (key, items |> Seq.sort |> Seq.toArray)) + |> Seq.sortBy (fun struct (key, _) -> key) + |> Seq.toArray + + struct (sorted |> Array.map (fun struct (key, _) -> key), sorted |> Array.map (fun struct (_, items) -> items)) + + static let firstChoice (item : int) : Choice = Choice1Of2 item + + /// The functions that mirror an Array.Parallel function, by name, with that function on a null array and the function + /// on a default flat list. The rows of the test are the names: a function has no readable name in a row. + static let arrayRejections = + [| + struct (nameof FlatList.Parallel.average, + (fun () -> + Array.Parallel.average (Unchecked.defaultof) + |> ignore + ), + (fun () -> + FlatList.Parallel.average (Unchecked.defaultof>) + |> ignore + )) + struct (nameof FlatList.Parallel.averageBy, + (fun () -> Array.Parallel.averageBy float nullArray |> ignore), + (fun () -> FlatList.Parallel.averageBy float defaultArray |> ignore)) + struct (nameof FlatList.Parallel.choose, + (fun () -> Array.Parallel.choose Some nullArray |> ignore), + (fun () -> FlatList.Parallel.choose ValueSome defaultArray |> ignore)) + struct (nameof FlatList.Parallel.collect, + (fun () -> Array.Parallel.collect Array.singleton nullArray |> ignore), + (fun () -> + FlatList.Parallel.collect FlatList.singleton defaultArray + |> ignore + )) + struct (nameof FlatList.Parallel.exists, + (fun () -> Array.Parallel.exists ((=) 1) nullArray |> ignore), + (fun () -> FlatList.Parallel.exists ((=) 1) defaultArray |> ignore)) + struct (nameof FlatList.Parallel.filter, + (fun () -> Array.Parallel.filter ((=) 1) nullArray |> ignore), + (fun () -> FlatList.Parallel.filter ((=) 1) defaultArray |> ignore)) + struct (nameof FlatList.Parallel.forall, + (fun () -> Array.Parallel.forall ((=) 1) nullArray |> ignore), + (fun () -> FlatList.Parallel.forall ((=) 1) defaultArray |> ignore)) + struct (nameof FlatList.Parallel.groupBy, + (fun () -> Array.Parallel.groupBy id nullArray |> ignore), + (fun () -> FlatList.Parallel.groupBy id defaultArray |> ignore)) + struct (nameof FlatList.Parallel.iter, + (fun () -> Array.Parallel.iter ignore nullArray), + (fun () -> FlatList.Parallel.iter ignore defaultArray)) + struct (nameof FlatList.Parallel.iteri, + (fun () -> Array.Parallel.iteri (fun _ _ -> ()) nullArray), + (fun () -> FlatList.Parallel.iteri (fun _ _ -> ()) defaultArray)) + struct (nameof FlatList.Parallel.map, + (fun () -> Array.Parallel.map id nullArray |> ignore), + (fun () -> FlatList.Parallel.map id defaultArray |> ignore)) + struct (nameof FlatList.Parallel.mapi, + (fun () -> Array.Parallel.mapi (fun _ item -> item) nullArray |> ignore), + (fun () -> + FlatList.Parallel.mapi (fun _ item -> item) defaultArray + |> ignore + )) + struct (nameof FlatList.Parallel.max, + (fun () -> Array.Parallel.max nullArray |> ignore), + (fun () -> FlatList.Parallel.max defaultArray |> ignore)) + struct (nameof FlatList.Parallel.maxBy, + (fun () -> Array.Parallel.maxBy abs nullArray |> ignore), + (fun () -> FlatList.Parallel.maxBy abs defaultArray |> ignore)) + struct (nameof FlatList.Parallel.min, + (fun () -> Array.Parallel.min nullArray |> ignore), + (fun () -> FlatList.Parallel.min defaultArray |> ignore)) + struct (nameof FlatList.Parallel.minBy, + (fun () -> Array.Parallel.minBy abs nullArray |> ignore), + (fun () -> FlatList.Parallel.minBy abs defaultArray |> ignore)) + struct (nameof FlatList.Parallel.partition, + (fun () -> Array.Parallel.partition ((=) 1) nullArray |> ignore), + (fun () -> FlatList.Parallel.partition ((=) 1) defaultArray |> ignore)) + struct (nameof FlatList.Parallel.partitionWith, + (fun () -> Array.Parallel.partitionWith firstChoice nullArray |> ignore), + (fun () -> + FlatList.Parallel.partitionWith firstChoice defaultArray + |> ignore + )) + struct (nameof FlatList.Parallel.reduce, + (fun () -> Array.Parallel.reduce (+) nullArray |> ignore), + (fun () -> FlatList.Parallel.reduce (+) defaultArray |> ignore)) + struct (nameof FlatList.Parallel.reduceBy, + (fun () -> Array.Parallel.reduceBy abs (+) nullArray |> ignore), + (fun () -> FlatList.Parallel.reduceBy abs (+) defaultArray |> ignore)) + struct (nameof FlatList.Parallel.sort, + (fun () -> Array.Parallel.sort nullArray |> ignore), + (fun () -> FlatList.Parallel.sort defaultArray |> ignore)) + struct (nameof FlatList.Parallel.sortBy, + (fun () -> Array.Parallel.sortBy negate nullArray |> ignore), + (fun () -> FlatList.Parallel.sortBy negate defaultArray |> ignore)) + struct (nameof FlatList.Parallel.sortByDescending, + (fun () -> Array.Parallel.sortByDescending negate nullArray |> ignore), + (fun () -> + FlatList.Parallel.sortByDescending negate defaultArray + |> ignore + )) + struct (nameof FlatList.Parallel.sortDescending, + (fun () -> Array.Parallel.sortDescending nullArray |> ignore), + (fun () -> FlatList.Parallel.sortDescending defaultArray |> ignore)) + struct (nameof FlatList.Parallel.sortWith, + (fun () -> Array.Parallel.sortWith compare nullArray |> ignore), + (fun () -> FlatList.Parallel.sortWith compare defaultArray |> ignore)) + struct (nameof FlatList.Parallel.tryFind, + (fun () -> Array.Parallel.tryFind ((=) 1) nullArray |> ignore), + (fun () -> FlatList.Parallel.tryFind ((=) 1) defaultArray |> ignore)) + struct (nameof FlatList.Parallel.tryFindIndex, + (fun () -> Array.Parallel.tryFindIndex ((=) 1) nullArray |> ignore), + (fun () -> + FlatList.Parallel.tryFindIndex ((=) 1) defaultArray + |> ignore + )) + struct (nameof FlatList.Parallel.tryPick, + (fun () -> Array.Parallel.tryPick Some nullArray |> ignore), + (fun () -> FlatList.Parallel.tryPick ValueSome defaultArray |> ignore)) + // zip takes two flat lists; each of them is a case of its own, named after the parameter that is default + struct ($"%s{nameof FlatList.Parallel.zip} (array1)", + (fun () -> Array.Parallel.zip nullArray [| 1 |] |> ignore), + (fun () -> + FlatList.Parallel.zip defaultArray (FlatList.singleton 1) + |> ignore + )) + struct ($"%s{nameof FlatList.Parallel.zip} (array2)", + (fun () -> Array.Parallel.zip [| 1 |] nullArray |> ignore), + (fun () -> + FlatList.Parallel.zip (FlatList.singleton 1) defaultArray + |> ignore + )) + |] + |> Array.map (fun struct (name, oracle, actual) -> name, struct (oracle, actual)) + |> Map.ofArray + + /// The functions that reject a default flat list where Array.Parallel dereferences a null array, by name. + static let dereferences : Map unit> = + Map.ofArray [| + nameof FlatList.Parallel.sum, (fun () -> FlatList.Parallel.sum defaultArray |> ignore) + nameof FlatList.Parallel.sumBy, (fun () -> FlatList.Parallel.sumBy abs defaultArray |> ignore) + |] + + /// The inputs of the contracts and the larger input. + static member AllInputs = Seq.ofArray allInputs + + /// The inputs with at least one element. + static member NonEmptyInputs = + allInputs + |> Seq.filter (fun input -> input <> ParallelInput.Empty) + + /// Every input with each predicate. + static member InputsAndPredicates = seq { + for input in allInputs do + for predicate in predicates do + struct (input, predicate) + } + + /// Every input with each predicate, as it is and negated. + static member InputsAndForallPredicates = seq { + for input in allInputs do + for predicate in predicates do + for negated in [| false; true |] do + struct (input, predicate, negated) + } + + /// The counts of init: none, one, the length of the input with several elements and the length of the larger input. + static member InitCounts = seq { + 0 + 1 + Inputs.Several.Length + (large ()).Length + } + + /// Two inputs of different lengths, in both orders. + static member DifferentLengths = seq { + struct (Inputs.Singleton, Inputs.Several) + struct (Inputs.Several, Inputs.Singleton) + } + + /// The number of processors, the length of the arrays and the chunks of the parallel loop of zip. + static member ZipChunks = seq { + struct (4, 0, Array.empty) + struct (4, 255, [| struct (0, 255) |]) + struct (3, 1_000, [| struct (0, 334); struct (334, 668); struct (668, 1_000) |]) + struct (2, 1_500_000_000, [| struct (0, 750_000_000); struct (750_000_000, 1_500_000_000) |]) + } + + /// The names of the functions that mirror an Array.Parallel function, as the rows of their test. + static member ArrayRejections = arrayRejections.Keys + + /// The names of the functions that reject a default flat list where Array.Parallel dereferences a null array. + static member Dereferences = dereferences.Keys + + // ---- Creation ---- + + [] + member _.``init creates the elements as the sequential init does`` (count : int) = + CollectionAssert.AreEqual ( + FlatList.toArray (FlatList.init count (fun index -> index * 3)), + FlatList.toArray (FlatList.Parallel.init count (fun index -> index * 3)), + "FlatList.Parallel.init must create the elements as the sequential init does" + ) + + [] + member _.``init throws for a negative count as Array.Parallel does`` () = + ExceptionAssert.Same ( + id, + (fun () -> Array.Parallel.init -1 id |> ignore), + (fun () -> FlatList.Parallel.init -1 id |> ignore), + "FlatList.Parallel.init -1 must throw as Array.Parallel.init does" + ) + + // ---- Search ---- + + [] + member _.``exists answers as the sequential exists does`` (input : ParallelInput, predicate : ParallelPredicate) = + let array = flatListOf input + + Assert.AreEqual( + FlatList.exists predicate.Matches array, + FlatList.Parallel.exists predicate.Matches array, + "FlatList.Parallel.exists must answer as the sequential exists does" + ) + + [] + member _.``forall answers as the sequential forall does`` + (input : ParallelInput, predicate : ParallelPredicate, negated : bool) + = + let array = flatListOf input + let test item = + if negated then + not (predicate.Matches item) + else + predicate.Matches item + + Assert.AreEqual( + FlatList.forall test array, + FlatList.Parallel.forall test array, + "FlatList.Parallel.forall must answer as the sequential forall does" + ) + + [] + member _.``tryFind returns the first element that satisfies the predicate`` + (input : ParallelInput, predicate : ParallelPredicate) + = + let array = flatListOf input + + Assert.AreEqual( + FlatList.tryFind predicate.Matches array, + FlatList.Parallel.tryFind predicate.Matches array, + "FlatList.Parallel.tryFind must return the first element that satisfies the predicate" + ) + + [] + member _.``tryFindIndex returns the index of the first element that satisfies the predicate`` + (input : ParallelInput, predicate : ParallelPredicate) + = + let array = flatListOf input + + Assert.AreEqual( + FlatList.tryFindIndex predicate.Matches array, + FlatList.Parallel.tryFindIndex predicate.Matches array, + "FlatList.Parallel.tryFindIndex must return the index of the first element that satisfies the predicate" + ) + + [] + member _.``tryPick returns the value for the first element that the chooser returns a value for`` + (input : ParallelInput, predicate : ParallelPredicate) + = + let array = flatListOf input + + Assert.AreEqual( + FlatList.tryPick predicate.Choose array, + FlatList.Parallel.tryPick predicate.Choose array, + "FlatList.Parallel.tryPick must return the value for the first element that the chooser returns a value for" + ) + + // ---- Transformation ---- + + [] + member _.``choose keeps the chosen values in the order of their elements`` + (input : ParallelInput, predicate : ParallelPredicate) + = + let array = flatListOf input + + CollectionAssert.AreEqual ( + FlatList.toArray (FlatList.choose predicate.Choose array), + FlatList.toArray (FlatList.Parallel.choose predicate.Choose array), + "FlatList.Parallel.choose must keep the chosen values in the order of their elements" + ) + + [] + member _.``collect concatenates the flat lists in the order of the elements`` (input : ParallelInput) = + let array = flatListOf input + // The flat lists of the mapping have zero, one or two elements + let mapping (item : int) = FlatList.replicate (abs item % 3) item + + CollectionAssert.AreEqual ( + FlatList.toArray (FlatList.collect mapping array), + FlatList.toArray (FlatList.Parallel.collect mapping array), + "FlatList.Parallel.collect must concatenate the flat lists in the order of the elements" + ) + + [] + member _.``collect throws ArgumentNullException for a default flat list of the mapping`` () = + // Array.Parallel.collect dereferences a null result; a default flat list is rejected as in the sequential collect + let ex = + Assert.ThrowsExactly( + Action (fun () -> + FlatList.Parallel.collect (fun _ -> defaultArray) (FlatList.singleton 1) + |> ignore + ), + "FlatList.Parallel.collect must reject a default flat list of the mapping" + ) + + Assert.AreEqual( + "mapping", + ex.ParamName, + "FlatList.Parallel.collect must name the mapping as the source of the default flat list" + ) + + [] + member _.``filter keeps the elements that satisfy the predicate in their order`` + (input : ParallelInput, predicate : ParallelPredicate) + = + let array = flatListOf input + + CollectionAssert.AreEqual ( + FlatList.toArray (FlatList.filter predicate.Matches array), + FlatList.toArray (FlatList.Parallel.filter predicate.Matches array), + "FlatList.Parallel.filter must keep the elements that satisfy the predicate in their order" + ) + + [] + member _.``map transforms every element in its order`` (input : ParallelInput) = + let array = flatListOf input + + CollectionAssert.AreEqual ( + FlatList.toArray (FlatList.map string array), + FlatList.toArray (FlatList.Parallel.map string array), + "FlatList.Parallel.map must transform every element in its order" + ) + + [] + member _.``mapi transforms every element with its index`` (input : ParallelInput) = + let array = flatListOf input + let mapping (index : int) (item : int) = struct (index, item * 3) + + CollectionAssert.AreEqual ( + FlatList.toArray (FlatList.mapi mapping array), + FlatList.toArray (FlatList.Parallel.mapi mapping array), + "FlatList.Parallel.mapi must transform every element with its index" + ) + + [] + member _.``zip pairs the elements at the same index`` (input : ParallelInput) = + let array = flatListOf input + let other = FlatList.rev array + + CollectionAssert.AreEqual ( + FlatList.toArray (FlatList.zip array other), + FlatList.toArray (FlatList.Parallel.zip array other), + "FlatList.Parallel.zip must pair the elements at the same index" + ) + + [] + member _.``zip throws for different lengths as Array.Parallel does`` (first : int array, second : int array) = + ExceptionAssert.Same ( + id, + (fun () -> Array.Parallel.zip first second |> ignore), + (fun () -> + FlatList.Parallel.zip (FlatList.ofArray first) (FlatList.ofArray second) + |> ignore + ), + "FlatList.Parallel.zip of flat lists of different lengths must throw as Array.Parallel.zip does" + ) + + [] + member _.``zip divides every array length into chunks without overflow`` + (processors : int, length : int, expected : struct (int * int) array) + = + // The chunks of the parallel loop of zip are checked directly: arrays of these lengths do not fit into the memory of + // a test run. The length plus the chunk length overflowed for 1.5 billion elements, so the loop did nothing. + CollectionAssert.AreEqual ( + expected, + ParallelArrays.chunks processors length, + "The chunks must divide the length among the processors without overflow" + ) + + [] + member _.``zip divides the longest array into adjacent chunks that end at its length`` () = + // On 64 processors, the first index plus the chunk length of the last chunk of the longest array is more than + // Int32.MaxValue, so the chunk must be cut to the length before the addition + let bounds = ParallelArrays.chunks 64 Array.MaxLength + Assert.HasCount (64, bounds, "The longest array on 64 processors must have one chunk per processor") + + Assert.AreEqual( + struct (2_113_929_216, Array.MaxLength), + Array.last bounds, + "The last chunk of the longest array must end at its length" + ) + + for index = 1 to bounds.Length - 1 do + let struct (_, previousEnd) = bounds[index - 1] + let struct (first, _) = bounds[index] + Assert.AreEqual( + previousEnd, + first, + $"Chunk %d{index} of the longest array must start where the chunk before it ends" + ) + + // ---- Folding ---- + + [] + member _.``average returns the average of the elements`` (input : ParallelInput) = + // Whole numbers add up exactly in any order, so the parallel sum is the sequential one + let floats = FlatList.map float (flatListOf input) + + Assert.AreEqual( + FlatList.average floats, + FlatList.Parallel.average floats, + "FlatList.Parallel.average must return the average of the elements" + ) + + [] + member _.``average throws for an empty flat list as Array.Parallel does`` () = + ExceptionAssert.Same ( + id, + (fun () -> Array.Parallel.average Array.empty |> ignore), + (fun () -> FlatList.Parallel.average FlatList.empty |> ignore), + "FlatList.Parallel.average of an empty flat list must throw as Array.Parallel.average does" + ) + + [] + member _.``averageBy returns the average of the projections`` (input : ParallelInput) = + let array = flatListOf input + + Assert.AreEqual( + FlatList.averageBy float array, + FlatList.Parallel.averageBy float array, + "FlatList.Parallel.averageBy must return the average of the projections" + ) + + [] + member _.``averageBy throws for an empty flat list as Array.Parallel does`` () = + ExceptionAssert.Same ( + id, + (fun () -> Array.Parallel.averageBy float Array.empty |> ignore), + (fun () -> + FlatList.Parallel.averageBy float FlatList.empty + |> ignore + ), + "FlatList.Parallel.averageBy of an empty flat list must throw as Array.Parallel.averageBy does" + ) + + [] + member _.``iter visits every element once`` (input : ParallelInput) = + let array = flatListOf input + let visited = ConcurrentQueue() + FlatList.Parallel.iter visited.Enqueue array + + CollectionAssert.AreEqual ( + array |> Seq.sort |> Seq.toArray, + visited |> Seq.sort |> Seq.toArray, + "FlatList.Parallel.iter must visit every element once" + ) + + [] + member _.``iteri visits every element once with its index`` (input : ParallelInput) = + let array = flatListOf input + let visited = ConcurrentQueue() + FlatList.Parallel.iteri (fun index item -> visited.Enqueue (struct (index, item))) array + + CollectionAssert.AreEqual ( + FlatList.toArray (FlatList.indexed array), + visited + |> Seq.sortBy (fun struct (index, _) -> index) + |> Seq.toArray, + "FlatList.Parallel.iteri must visit every element once with its index" + ) + + [] + member _.``max returns the greatest element`` (input : ParallelInput) = + let array = flatListOf input + Assert.AreEqual( + FlatList.max array, + FlatList.Parallel.max array, + "FlatList.Parallel.max must return the greatest element" + ) + + [] + member _.``max throws for an empty flat list as Array.Parallel does`` () = + ExceptionAssert.Same ( + id, + (fun () -> Array.Parallel.max Array.empty |> ignore), + (fun () -> FlatList.Parallel.max FlatList.empty |> ignore), + "FlatList.Parallel.max of an empty flat list must throw as Array.Parallel.max does" + ) + + [] + member _.``maxBy returns the element with the greatest projection`` (input : ParallelInput) = + // In every input, only equal elements share the greatest absolute value, so any of them is the expected one + let array = flatListOf input + + Assert.AreEqual( + FlatList.maxBy abs array, + FlatList.Parallel.maxBy abs array, + "FlatList.Parallel.maxBy must return the element with the greatest projection" + ) + + [] + member _.``maxBy chooses among equal projections as Array.Parallel does`` () = + let key (struct (key : int, _ : char)) = key + + Assert.AreEqual( + Array.Parallel.maxBy key Inputs.Pairs, + FlatList.Parallel.maxBy key (FlatList.ofArray Inputs.Pairs), + "FlatList.Parallel.maxBy must choose among equal keys as Array.Parallel.maxBy does" + ) + + [] + member _.``maxBy throws for an empty flat list as Array.Parallel does`` () = + ExceptionAssert.Same ( + id, + (fun () -> Array.Parallel.maxBy abs Array.empty |> ignore), + (fun () -> FlatList.Parallel.maxBy abs FlatList.empty |> ignore), + "FlatList.Parallel.maxBy of an empty flat list must throw as Array.Parallel.maxBy does" + ) + + [] + member _.``min returns the smallest element`` (input : ParallelInput) = + let array = flatListOf input + Assert.AreEqual( + FlatList.min array, + FlatList.Parallel.min array, + "FlatList.Parallel.min must return the smallest element" + ) + + [] + member _.``min throws for an empty flat list as Array.Parallel does`` () = + ExceptionAssert.Same ( + id, + (fun () -> Array.Parallel.min Array.empty |> ignore), + (fun () -> FlatList.Parallel.min FlatList.empty |> ignore), + "FlatList.Parallel.min of an empty flat list must throw as Array.Parallel.min does" + ) + + [] + member _.``minBy returns the element with the smallest projection`` (input : ParallelInput) = + // In every input, only equal elements share the smallest absolute value, so any of them is the expected one + let array = flatListOf input + + Assert.AreEqual( + FlatList.minBy abs array, + FlatList.Parallel.minBy abs array, + "FlatList.Parallel.minBy must return the element with the smallest projection" + ) + + [] + member _.``minBy chooses among equal projections as Array.Parallel does`` () = + let key (struct (key : int, _ : char)) = key + + Assert.AreEqual( + Array.Parallel.minBy key Inputs.Pairs, + FlatList.Parallel.minBy key (FlatList.ofArray Inputs.Pairs), + "FlatList.Parallel.minBy must choose among equal keys as Array.Parallel.minBy does" + ) + + [] + member _.``minBy throws for an empty flat list as Array.Parallel does`` () = + ExceptionAssert.Same ( + id, + (fun () -> Array.Parallel.minBy abs Array.empty |> ignore), + (fun () -> FlatList.Parallel.minBy abs FlatList.empty |> ignore), + "FlatList.Parallel.minBy of an empty flat list must throw as Array.Parallel.minBy does" + ) + + [] + member _.``reduce combines the elements as the sequential reduce does for an associative and commutative function`` + (input : ParallelInput) + = + let array = flatListOf input + + Assert.AreEqual( + FlatList.reduce (+) array, + FlatList.Parallel.reduce (+) array, + "FlatList.Parallel.reduce must combine the elements as the sequential reduce does" + ) + + [] + member _.``reduce throws for an empty flat list as Array.Parallel does`` () = + ExceptionAssert.Same ( + id, + (fun () -> Array.Parallel.reduce (+) Array.empty |> ignore), + (fun () -> FlatList.Parallel.reduce (+) FlatList.empty |> ignore), + "FlatList.Parallel.reduce of an empty flat list must throw as Array.Parallel.reduce does" + ) + + [] + member _.``reduceBy combines the projections as Array.Parallel does`` (input : ParallelInput) = + // The sequential module has no reduceBy; it is reduce after map there + let array = flatListOf input + let combined = FlatList.Parallel.reduceBy abs (+) array + + Assert.AreEqual( + Array.Parallel.reduceBy abs (+) (FlatList.toArray array), + combined, + "FlatList.Parallel.reduceBy must combine as Array.Parallel.reduceBy does" + ) + + Assert.AreEqual( + FlatList.map abs array |> FlatList.reduce (+), + combined, + "FlatList.Parallel.reduceBy must combine as the sequential reduce after map does" + ) + + [] + member _.``reduceBy throws for an empty flat list as Array.Parallel does`` () = + ExceptionAssert.Same ( + id, + (fun () -> Array.Parallel.reduceBy abs (+) Array.empty |> ignore), + (fun () -> + FlatList.Parallel.reduceBy abs (+) FlatList.empty + |> ignore + ), + "FlatList.Parallel.reduceBy of an empty flat list must throw as Array.Parallel.reduceBy does" + ) + + [] + member _.``sum adds the elements`` (input : ParallelInput) = + let array = flatListOf input + Assert.AreEqual(FlatList.sum array, FlatList.Parallel.sum array, "FlatList.Parallel.sum must add the elements") + + [] + member _.``sumBy adds the projections`` (input : ParallelInput) = + let array = flatListOf input + Assert.AreEqual( + FlatList.sumBy abs array, + FlatList.Parallel.sumBy abs array, + "FlatList.Parallel.sumBy must add the projections" + ) + + // ---- Partitioning and grouping ---- + + [] + member _.``groupBy groups the elements as the sequential groupBy does`` (input : ParallelInput) = + let array = flatListOf input + let struct (expectedKeys, expectedGroups) = normalized (FlatList.groupBy (fun item -> item % 3) array) + let struct (keys, groups) = normalized (FlatList.Parallel.groupBy (fun item -> item % 3) array) + CollectionAssert.AreEqual (expectedKeys, keys, "FlatList.Parallel.groupBy must find the keys of the sequential groupBy") + + CollectionAssert.AreEqual ( + expectedGroups, + groups, + "FlatList.Parallel.groupBy must group the elements of each key as the sequential groupBy does" + ) + + [] + member _.``groupBy groups the elements of a null key`` (input : ParallelInput) = + let array = flatListOf input + let projection (item : int) : string | null = if item < 0 then null else string (item % 3) + let struct (expectedKeys, expectedGroups) = normalized (FlatList.groupBy projection array) + let struct (keys, groups) = normalized (FlatList.Parallel.groupBy projection array) + + CollectionAssert.AreEqual ( + expectedKeys, + keys, + "FlatList.Parallel.groupBy must find the keys of the sequential groupBy, the null key included" + ) + + CollectionAssert.AreEqual ( + expectedGroups, + groups, + "FlatList.Parallel.groupBy must group the elements of each key as the sequential groupBy does, the null key included" + ) + + [] + member _.``groupBy puts the NaN keys of type float and float32 in one group as Array.Parallel does`` () = + // Array.Parallel.groupBy compares these keys with ER semantics, while the sequential Array.groupBy makes a group of + // each NaN. The keys are compared as text, because NaN is not equal to itself. + let check (source : 'Key array) = + CollectionAssert.AreEqual ( + Array.Parallel.groupBy id source + |> Seq.map (fun (key, items) -> string key, items.Length) + |> Seq.sort + |> Seq.toArray, + FlatList.Parallel.groupBy id (FlatList.ofArray source) + |> Seq.map (fun struct (key, items) -> string key, items.Length) + |> Seq.sort + |> Seq.toArray, + $"FlatList.Parallel.groupBy of %A{source} must group as Array.Parallel.groupBy does" + ) + + check [| nan; 1.0; nan; 2.0; nan |] + check [| nanf; 1.0f; nanf; 2.0f; nanf |] + + [] + member _.``partition splits the elements in their order`` (input : ParallelInput, predicate : ParallelPredicate) = + let array = flatListOf input + let struct (expectedAccepted, expectedRejected) = FlatList.partition predicate.Matches array + let struct (accepted, rejected) = FlatList.Parallel.partition predicate.Matches array + + CollectionAssert.AreEqual ( + FlatList.toArray expectedAccepted, + FlatList.toArray accepted, + "FlatList.Parallel.partition must return the elements that satisfy the predicate in their order" + ) + + CollectionAssert.AreEqual ( + FlatList.toArray expectedRejected, + FlatList.toArray rejected, + "FlatList.Parallel.partition must return the elements that do not satisfy the predicate in their order" + ) + + [] + member _.``partitionWith splits the elements by the choice in their order`` (input : ParallelInput) = + let array = flatListOf input + + let partitioner (item : int) = + if item > 0 then + Choice1Of2 item + else + Choice2Of2 (string item) + + let struct (expectedFirst, expectedSecond) = FlatList.partitionWith partitioner array + let struct (first, second) = FlatList.Parallel.partitionWith partitioner array + + CollectionAssert.AreEqual ( + FlatList.toArray expectedFirst, + FlatList.toArray first, + "FlatList.Parallel.partitionWith must return the first choices in their order" + ) + + CollectionAssert.AreEqual ( + FlatList.toArray expectedSecond, + FlatList.toArray second, + "FlatList.Parallel.partitionWith must return the second choices in their order" + ) + + // ---- Sorting ---- + + [] + member _.``sort orders the elements ascending`` (input : ParallelInput) = + let array = flatListOf input + + CollectionAssert.AreEqual ( + FlatList.toArray (FlatList.sort array), + FlatList.toArray (FlatList.Parallel.sort array), + "FlatList.Parallel.sort must order the elements ascending" + ) + + [] + member _.``sortBy orders the elements by the projection`` (input : ParallelInput) = + let array = flatListOf input + + CollectionAssert.AreEqual ( + FlatList.toArray (FlatList.sortBy negate array), + FlatList.toArray (FlatList.Parallel.sortBy negate array), + "FlatList.Parallel.sortBy must order the elements by the projection" + ) + + [] + member _.``sortByDescending orders the elements by the projection descending`` (input : ParallelInput) = + let array = flatListOf input + + CollectionAssert.AreEqual ( + FlatList.toArray (FlatList.sortByDescending negate array), + FlatList.toArray (FlatList.Parallel.sortByDescending negate array), + "FlatList.Parallel.sortByDescending must order the elements by the projection descending" + ) + + [] + member _.``sortDescending orders the elements descending`` (input : ParallelInput) = + let array = flatListOf input + + CollectionAssert.AreEqual ( + FlatList.toArray (FlatList.sortDescending array), + FlatList.toArray (FlatList.Parallel.sortDescending array), + "FlatList.Parallel.sortDescending must order the elements descending" + ) + + [] + member _.``sortWith orders the elements with the comparison function`` (input : ParallelInput) = + let array = flatListOf input + let descending (left : int) (right : int) = compare right left + + CollectionAssert.AreEqual ( + FlatList.toArray (FlatList.sortWith descending array), + FlatList.toArray (FlatList.Parallel.sortWith descending array), + "FlatList.Parallel.sortWith must order the elements with the comparison function" + ) + + [] + member _.``the sorting functions leave the shared array of the input unchanged`` () = + let array = FlatList.ofArray (large ()) + + FlatList.Parallel.sort array |> ignore + FlatList.Parallel.sortBy negate array |> ignore + FlatList.Parallel.sortByDescending negate array |> ignore + FlatList.Parallel.sortDescending array |> ignore + FlatList.Parallel.sortWith compare array |> ignore + + CollectionAssert.AreEqual (large (), FlatList.toArray array, "The sorting functions must sort a copy of the input") + + // ---- Default flat lists ---- + + [] + member _.``functions reject a default flat list as Array.Parallel rejects a null array`` (name : string) = + let struct (oracle, actual) = arrayRejections[name] + ExceptionAssert.Same (id, oracle, actual, $"FlatList.Parallel.%s{name} must reject a default flat list") + + [] + member _.``sum and sumBy reject a default flat list where Array.Parallel dereferences a null array`` (name : string) = + // Array.Parallel.sum and sumBy throw NullReferenceException for a null array; their documentation promises + // ArgumentNullException, which a default flat list throws + let actual = dereferences[name] + + let ex = + Assert.ThrowsExactly( + Action actual, + $"FlatList.Parallel.%s{name} must reject a default flat list" + ) + + Assert.AreEqual( + "array", + ex.ParamName, + $"FlatList.Parallel.%s{name} must name the parameter of the default flat list" + ) diff --git a/tests/FSharp.Collections.Immutable.Tests/FlatList/FlatListParallelTupleTests.fs b/tests/FSharp.Collections.Immutable.Tests/FlatList/FlatListParallelTupleTests.fs new file mode 100644 index 00000000..be6af851 --- /dev/null +++ b/tests/FSharp.Collections.Immutable.Tests/FlatList/FlatListParallelTupleTests.fs @@ -0,0 +1,160 @@ +namespace FSharp.Collections.Immutable.Tests + +open FSharp.Collections.Immutable +open FSharp.Collections.Immutable.Tuple +open Microsoft.VisualStudio.TestTools.UnitTesting + +// The type annotations of the results are the proof that the functions of the Tuple namespace shadow the default ones, +// also in the nested Parallel module. + +/// The `FlatList.Parallel` module of the `Tuple` namespace. +[] +type FlatListParallelTupleTests () = + + static let array = FlatList.ofArray Inputs.Several + + /// The elements of a flat list long enough for the functions to split their work among several threads. + static let large () = Array.init 10_000 (fun index -> index % 1_000 - 500) + + static let isPositive (item : int) = item > 0 + + /// The flat list of the elements of an input. + static let flatListOf (input : ParallelInput) = FlatList.ofArray (input.Elements large) + + /// The input with several elements of the contracts and the larger input. + static member Sources = seq { + ParallelInput.Several + ParallelInput.Large + } + + [] + member _.``zip returns reference tuples`` (input : ParallelInput) = + let first = flatListOf input + + // The input with several elements is zipped with the second input of the contracts, the larger input with its + // reverse + let second = + match input with + | ParallelInput.Several -> FlatList.ofArray Inputs.Other + | _ -> FlatList.rev first + + let pairs : FlatList = FlatList.Parallel.zip first second + + CollectionAssert.AreEqual ( + Array.zip (FlatList.toArray first) (FlatList.toArray second), + FlatList.toArray pairs, + "Tuple.FlatList.Parallel.zip must zip as Array.zip does" + ) + + [] + member _.``zip throws for different lengths as the default does`` () = + ExceptionAssert.Same ( + id, + (fun () -> + FSharp.Collections.Immutable.FlatList.Parallel.zip array (FlatList.singleton 1) + |> ignore + ), + (fun () -> FlatList.Parallel.zip array (FlatList.singleton 1) |> ignore), + "Tuple.FlatList.Parallel.zip must throw as the default zip does" + ) + + [] + member _.``groupBy returns reference tuples`` (input : ParallelInput) = + let source = flatListOf input + let groups : FlatList> = FlatList.Parallel.groupBy (fun item -> item % 3) source + + // The order of the keys and of the elements of a key is open, so both are sorted; a group pairs its key with its + // elements, which a pair compares by reference, so the keys and the elements are compared apart + let expected = + Array.groupBy (fun item -> item % 3) (FlatList.toArray source) + |> Array.map (fun (key, items) -> key, Array.sort items) + |> Array.sortBy fst + + let actual = + groups + |> Seq.map (fun (key, items) -> key, items |> Seq.sort |> Seq.toArray) + |> Seq.sortBy fst + |> Seq.toArray + + CollectionAssert.AreEqual ( + Array.map fst expected, + Array.map fst actual, + "Tuple.FlatList.Parallel.groupBy must find the keys as Array.groupBy does" + ) + + CollectionAssert.AreEqual ( + Array.map snd expected, + Array.map snd actual, + "Tuple.FlatList.Parallel.groupBy must group the elements of each key as Array.groupBy does" + ) + + [] + member _.``groupBy puts the NaN keys of type float and float32 in one group as Array.Parallel does`` () = + // The keys are compared as text, because NaN is not equal to itself + let check (source : 'Key array) = + let groups : FlatList<'Key * FlatList<'Key>> = FlatList.Parallel.groupBy id (FlatList.ofArray source) + + CollectionAssert.AreEqual ( + Array.Parallel.groupBy id source + |> Seq.map (fun (key, items) -> string key, items.Length) + |> Seq.sort + |> Seq.toArray, + groups + |> Seq.map (fun (key, items) -> string key, items.Length) + |> Seq.sort + |> Seq.toArray, + $"Tuple.FlatList.Parallel.groupBy of %A{source} must group as Array.Parallel.groupBy does" + ) + + check [| nan; 1.0; nan; 2.0; nan |] + check [| nanf; 1.0f; nanf; 2.0f; nanf |] + + [] + member _.``partition returns a reference tuple`` (input : ParallelInput) = + let source = flatListOf input + let (accepted : FlatList), (rejected : FlatList) = + FlatList.Parallel.partition isPositive source + let expectedAccepted, expectedRejected = Array.partition isPositive (FlatList.toArray source) + + CollectionAssert.AreEqual ( + expectedAccepted, + FlatList.toArray accepted, + "Tuple.FlatList.Parallel.partition must return the accepted elements" + ) + + CollectionAssert.AreEqual ( + expectedRejected, + FlatList.toArray rejected, + "Tuple.FlatList.Parallel.partition must return the rejected elements" + ) + + [] + member _.``partitionWith returns a reference tuple`` (input : ParallelInput) = + let source = flatListOf input + + let partitioner (item : int) = + if item > 0 then + Choice1Of2 item + else + Choice2Of2 (string item) + + let (first : FlatList), (second : FlatList) = + FlatList.Parallel.partitionWith partitioner source + let expectedFirst, expectedSecond = Array.partitionWith partitioner (FlatList.toArray source) + + CollectionAssert.AreEqual ( + expectedFirst, + FlatList.toArray first, + "Tuple.FlatList.Parallel.partitionWith must return the first choices" + ) + + CollectionAssert.AreEqual ( + expectedSecond, + FlatList.toArray second, + "Tuple.FlatList.Parallel.partitionWith must return the second choices" + ) + + [] + member _.``the functions without a tuple keep resolving to the default module`` () = + let found : int voption = FlatList.Parallel.tryFind (fun item -> item > 6) array + Assert.AreEqual(ValueSome 8, found, "FlatList.Parallel.tryFind must resolve to the default module")