add: Gather tests

Author: IgorErin

src/GraphBLAS-sharp.Backend/Common/ClArray.fs

@@ -349,13 +349,3 @@ module ClArray =
 
             result
 
-    let iterate (clContext: ClContext) workGroupSize iterator =
-
-        let create = create clContext workGroupSize iterator
-
-        let scatter = Scatter.runInplace clContext workGroupSize
-
-        fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) ->
-
-            let positions = create processor allocationMode
-

src/GraphBLAS-sharp.Backend/Common/Gather.fs

@@ -17,28 +17,28 @@ module internal Gather =
     let run (clContext: ClContext) workGroupSize =
 
         let gather =
-            <@ fun (ndRange: Range1D) (positions: ClArray<int>) (values: ClArray<'a>) (outputArray: ClArray<'a>) (size: int) ->
+            <@ fun (ndRange: Range1D) positionsLength valuesLength (positions: ClArray<int>) (values: ClArray<'a>) (outputArray: ClArray<'a>) ->
 
                 let i = ndRange.GlobalID0
 
-                if i < size then
+                if i < positionsLength then
                     let position = positions.[i]
-                    let value = values.[position]
 
-                    outputArray.[i] <- value @>
+                    if position >= 0 && position < valuesLength then
+                        outputArray.[i] <- values.[position] @>
 
-        let program = clContext.Compile(gather)
+        let program = clContext.Compile gather
 
-        fun (processor: MailboxProcessor<_>) (positions: ClArray<int>) (inputArray: ClArray<'a>) (outputArray: ClArray<'a>) ->
+        fun (processor: MailboxProcessor<_>) (positions: ClArray<int>) (values: ClArray<'a>) (outputArray: ClArray<'a>) ->
 
-            let size = outputArray.Length
+            if positions.Length <> outputArray.Length then failwith "Lengths must be the same"
 
             let kernel = program.GetKernel()
 
-            let ndRange = Range1D.CreateValid(size, workGroupSize)
+            let ndRange = Range1D.CreateValid(positions.Length, workGroupSize)
 
             processor.Post(
-                Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange positions inputArray outputArray size)
+                Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange positions.Length values.Length positions values outputArray)
             )
 
             processor.Post(Msg.CreateRunMsg<_, _>(kernel))

src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs

@@ -270,3 +270,75 @@ module PrefixSum =
         fun (processor: MailboxProcessor<_>) (inputArray: ClArray<int>) ->
 
             scan processor inputArray 0
+
+
+    module ByKey =
+        let private sequentialSegments opWrite (clContext: ClContext) workGroupSize opAdd zero =
+
+            let kernel =
+                <@ fun (ndRange: Range1D) lenght uniqueKeysCount (values: ClArray<'a>) (keys: ClArray<int>) (offsets: ClArray<int>) ->
+                    let gid = ndRange.GlobalID0
+
+                    if gid < uniqueKeysCount then
+                        let sourcePosition = offsets.[gid]
+                        let sourceKey = keys.[sourcePosition]
+
+                        let mutable currentSum = zero
+                        let mutable previousSum = zero
+
+                        let mutable currentPosition = sourcePosition
+
+                        while currentPosition < lenght
+                              && keys.[currentPosition] = sourceKey do
+
+                            previousSum <- currentSum
+                            currentSum <- (%opAdd) currentSum values.[currentPosition]
+
+                            values.[currentPosition] <- (%opWrite) previousSum currentSum
+
+                            currentPosition <- currentPosition + 1 @>
+
+            let kernel = clContext.Compile kernel
+
+            fun (processor: MailboxProcessor<_>) uniqueKeysCount (values: ClArray<'a>) (keys: ClArray<int>) (offsets: ClArray<int>) ->
+
+                let kernel = kernel.GetKernel()
+
+                let ndRange =
+                    Range1D.CreateValid(values.Length, workGroupSize)
+
+                processor.Post(
+                    Msg.MsgSetArguments
+                        (fun () -> kernel.KernelFunc ndRange values.Length uniqueKeysCount values keys offsets)
+                )
+
+                processor.Post(Msg.CreateRunMsg<_, _> kernel)
+
+        /// <summary>
+        /// Exclude scan by key.
+        /// </summary>
+        /// <example>
+        /// <code>
+        /// let arr = [| 1; 1; 1; 1; 1; 1|]
+        /// let keys = [| 1; 2; 2; 2; 3; 3 |]
+        /// ...
+        /// > val result = [| 0; 0; 1; 2; 0; 1 |]
+        /// </code>
+        /// </example>
+        let sequentialExclude clContext =
+            sequentialSegments (Map.fst ()) clContext
+
+        /// <summary>
+        /// Include scan by key.
+        /// </summary>
+        /// <example>
+        /// <code>
+        /// let arr = [| 1; 1; 1; 1; 1; 1|]
+        /// let keys = [| 1; 2; 2; 2; 3; 3 |]
+        /// ...
+        /// > val result = [| 1; 1; 2; 3; 1; 2 |]
+        /// </code>
+        /// </example>
+        let sequentialInclude clContext =
+            sequentialSegments (Map.snd ()) clContext
+

src/GraphBLAS-sharp.Backend/Common/Scatter.fs

@@ -43,6 +43,8 @@ module internal Scatter =
 
         fun (processor: MailboxProcessor<_>) (positions: ClArray<int>) (values: ClArray<'a>) (result: ClArray<'a>) ->
 
+            if positions.Length <> values.Length then failwith "Lengths must be the same"
+
             let positionsLength = positions.Length
 
             let ndRange =

src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs

@@ -12,47 +12,9 @@ open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions
 open GraphBLAS.FSharp.Backend.Objects.ClCell
 
 module Matrix =
-    let private expandRowPointers (clContext: ClContext) workGroupSize =
-
-        let expandRowPointers =
-            <@ fun (ndRange: Range1D) (rowPointers: ClArray<int>) (rowCount: int) (rows: ClArray<int>) ->
-
-                let i = ndRange.GlobalID0
-
-                if i < rowCount then
-                    let rowPointer = rowPointers.[i]
-
-                    if rowPointer <> rowPointers.[i + 1] then
-                        rows.[rowPointer] <- i @>
-
-        let program = clContext.Compile(expandRowPointers)
-
-        let create =
-            ClArray.zeroCreate clContext workGroupSize
-
-        let scan =
-            PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize
-
-        fun (processor: MailboxProcessor<_>) allocationMode (rowPointers: ClArray<int>) nnz rowCount ->
-
-            let rows = create processor allocationMode nnz
-
-            let kernel = program.GetKernel()
-
-            let ndRange =
-                Range1D.CreateValid(rowCount, workGroupSize)
-
-            processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange rowPointers rowCount rows))
-            processor.Post(Msg.CreateRunMsg<_, _> kernel)
-
-            let total = scan processor rows 0
-            processor.Post(Msg.CreateFreeMsg(total))
-
-            rows
-
     let toCOO (clContext: ClContext) workGroupSize =
         let prepare =
-            expandRowPointers clContext workGroupSize
+            Common.expandRowPointers clContext workGroupSize
 
         let copy = ClArray.copy clContext workGroupSize
 
@@ -77,7 +39,7 @@ module Matrix =
 
     let toCOOInplace (clContext: ClContext) workGroupSize =
         let prepare =
-            expandRowPointers clContext workGroupSize
+            Common.expandRowPointers clContext workGroupSize
 
         fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) ->
             let rows =