wip: expand refactor, tests in progress

Author: IgorErin

paket.dependencies

@@ -59,4 +59,4 @@ group Docs
 group Analyzers
   source https://www.nuget.org/api/v2
   source https://api.nuget.org/v3/index.json
-  nuget BinaryDefense.FSharp.Analyzers.Hashing 0.2.2
+  nuget BinaryDefense.FSharp.Analyzers.Hashing 0.2.2

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

@@ -335,7 +335,7 @@ module ClArray =
     let getUniqueBitmap2LastOccurrence clContext =
         getUniqueBitmap2General getUniqueBitmapLastOccurrence clContext
 
-    let private assignOption (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b option>) =
+    let assignOption (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b option>) =
 
         let assign =
             <@ fun (ndRange: Range1D) length (values: ClArray<'a>) (positions: ClArray<int>) (result: ClArray<'b>) resultLength ->
@@ -574,7 +574,7 @@ module ClArray =
 
         let kernel = clContext.Compile assign
 
-        fun (processor: MailboxProcessor<_>) allocationMode (targetArray: ClArray<'a>) startPosition (appendedArray: ClArray<'a>) ->
+        fun (processor: MailboxProcessor<_>) (targetArray: ClArray<'a>) startPosition (appendedArray: ClArray<'a>) ->
             if startPosition < 0 then
                 failwith "The starting position cannot be less than zero"
 
@@ -605,9 +605,9 @@ module ClArray =
                 |> Seq.sumBy (fun array -> array.Length)
 
             let result =
-                clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength)
+                clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
 
-            let assign = assign processor allocationMode result
+            let assign = assign processor result
 
             // write each array to result
             Seq.fold
@@ -652,3 +652,27 @@ module ClArray =
             )
 
             processor.Post(Msg.CreateRunMsg<_, _>(kernel))
+
+    let pairwise (clContext: ClContext) workGroupSize =
+
+        let idGather =
+            Gather.runInit Map.id clContext workGroupSize
+
+        let incGather =
+            Gather.runInit Map.inc clContext workGroupSize
+
+        fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) ->
+
+            let resultLength = values.Length - 1
+
+            let firstItems =
+                clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
+
+            idGather processor values firstItems
+
+            let secondItems =
+                clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
+
+            incGather processor values secondItems
+
+            firstItems, secondItems

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

@@ -315,7 +315,7 @@ module Reduce =
 
                 processor.Post(Msg.CreateRunMsg<_, _>(kernel))
 
-                reducedKeys, reducedValues
+                reducedValues, reducedKeys
 
         /// <summary>
         /// Reduces values by key. Each segment is reduced by one work item.
@@ -381,7 +381,7 @@ module Reduce =
 
                 processor.Post(Msg.CreateRunMsg<_, _>(kernel))
 
-                reducedKeys, reducedValues
+                reducedValues, reducedKeys
 
         /// <summary>
         /// Reduces values by key. One work group participates in the reduction.
@@ -470,8 +470,120 @@ module Reduce =
 
                 processor.Post(Msg.CreateRunMsg<_, _>(kernel))
 
-                reducedKeys, reducedValues
+                reducedValues, reducedKeys
 
+        /// <summary>
+        /// Reduces values by key. Each segment is reduced by one work item.
+        /// </summary>
+        /// <param name="clContext">ClContext.</param>
+        /// <param name="workGroupSize">Work group size.</param>
+        /// <param name="reduceOp">Operation for reducing values.</param>
+        /// <remarks>
+        /// The length of the result must be calculated in advance.
+        /// </remarks>
+        let segmentSequentialOption<'a> (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a option>) =
+
+            let kernel =
+                <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray<int>) (keys: ClArray<int>) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray<int>) (resultPositions: ClArray<int>) ->
+
+                    let gid = ndRange.GlobalID0
+
+                    if gid < uniqueKeyCount then
+                        let startPosition = offsets.[gid]
+
+                        let firstSourceKey = keys.[startPosition]
+
+                        let mutable sum = Some values.[startPosition]
+
+                        let mutable currentPosition = startPosition + 1
+
+                        while currentPosition < keysLength
+                              && firstSourceKey = keys.[currentPosition] do
+
+                            match sum with
+                            | Some value ->
+                                let result =
+                                    ((%reduceOp) value values.[currentPosition]) // brahma error
+
+                                sum <- result
+                            | None -> sum <- Some values.[currentPosition]
+
+                            currentPosition <- currentPosition + 1
+
+                        match sum with
+                        | Some value ->
+                            reducedValues.[gid] <- value
+                            resultPositions.[gid] <- 1
+                        | None -> resultPositions.[gid] <- 0
+
+                        firstReducedKeys.[gid] <- firstSourceKey @>
+
+            let kernel = clContext.Compile kernel
+
+            let scatterData =
+                Scatter.lastOccurrence clContext workGroupSize
+
+            let scatterIndices =
+                Scatter.lastOccurrence clContext workGroupSize
+
+            let prefixSum =
+                PrefixSum.standardExcludeInplace clContext workGroupSize
+
+            fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray<int>) (keys: ClArray<int>) (values: ClArray<'a>) ->
+
+                let reducedValues =
+                    clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
+
+                let reducedKeys =
+                    clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
+
+                let resultPositions =
+                    clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength)
+
+                let ndRange =
+                    Range1D.CreateValid(resultLength, workGroupSize)
+
+                let kernel = kernel.GetKernel()
+
+                processor.Post(
+                    Msg.MsgSetArguments
+                        (fun () ->
+                            kernel.KernelFunc
+                                ndRange
+                                resultLength
+                                keys.Length
+                                offsets
+                                keys
+                                values
+                                reducedValues
+                                reducedKeys
+                                resultPositions)
+                )
+
+                processor.Post(Msg.CreateRunMsg<_, _>(kernel))
+
+                let resultLength =
+                    (prefixSum processor resultPositions)
+                        .ToHostAndFree processor
+
+                if resultLength =  0 then None
+                else
+                    let resultValues =
+                        clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
+
+                    scatterData processor resultPositions reducedValues resultValues
+
+                    reducedValues.Free processor
+
+                    let resultKeys =
+                        clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
+
+                    scatterIndices processor resultPositions reducedKeys resultKeys // TODO(mb error)
+
+                    reducedKeys.Free processor
+                    resultPositions.Free processor
+
+                    Some (resultValues, reducedKeys)
     module ByKey2D =
         /// <summary>
         /// Reduce an array of values by 2D keys using a single work item.
@@ -550,7 +662,7 @@ module Reduce =
 
                 processor.Post(Msg.CreateRunMsg<_, _>(kernel))
 
-                firstReducedKeys, secondReducedKeys, reducedValues
+                reducedValues, firstReducedKeys, secondReducedKeys
 
         /// <summary>
         /// Reduces values by key. Each segment is reduced by one work item.
@@ -625,7 +737,7 @@ module Reduce =
 
                 processor.Post(Msg.CreateRunMsg<_, _>(kernel))
 
-                firstReducedKeys, secondReducedKeys, reducedValues
+                reducedValues, firstReducedKeys, secondReducedKeys
 
         /// <summary>
         /// Reduces values by key. Each segment is reduced by one work item.
@@ -729,27 +841,29 @@ module Reduce =
                     (prefixSum processor resultPositions)
                         .ToHostAndFree processor
 
-                let resultValues =
-                    clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
+                if resultLength = 0 then None
+                else
+                    let resultValues =
+                        clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
 
-                scatterData processor resultPositions reducedValues resultValues
+                    scatterData processor resultPositions reducedValues resultValues
 
-                reducedValues.Free processor
+                    reducedValues.Free processor
 
-                let resultFirstKeys =
-                    clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
+                    let resultFirstKeys =
+                        clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
 
-                scatterIndices processor resultPositions firstReducedKeys resultFirstKeys
+                    scatterIndices processor resultPositions firstReducedKeys resultFirstKeys
 
-                firstReducedKeys.Free processor
+                    firstReducedKeys.Free processor
 
-                let resultSecondKeys =
-                    clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
+                    let resultSecondKeys =
+                        clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
 
-                scatterIndices processor resultPositions secondReducedKeys resultSecondKeys
+                    scatterIndices processor resultPositions secondReducedKeys resultSecondKeys
 
-                secondReducedKeys.Free processor
+                    secondReducedKeys.Free processor
 
-                resultPositions.Free processor
+                    resultPositions.Free processor
 
-                resultFirstKeys, resultSecondKeys, resultValues
+                    Some (resultValues, resultFirstKeys, resultSecondKeys)

src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj

@@ -30,8 +30,8 @@
     <Compile Include="Common/Scatter.fs" />
     <Compile Include="Common/Utils.fs" />
     <Compile Include="Common/PrefixSum.fs" />
+    <Compile Include="Common\Gather.fs" />
     <Compile Include="Common/ClArray.fs" />
-    <Compile Include="Common/Gather.fs" />
     <Compile Include="Common/Sort/Radix.fs" />
     <Compile Include="Common/Sort/Bitonic.fs" />
     <Compile Include="Common/Sum.fs" />
@@ -51,10 +51,10 @@
     <Compile Include="Matrix\CSR\Map.fs" />
     <Compile Include="Matrix\CSR\Map2.fs" />
     <Compile Include="Matrix\CSR\Map2AtLeastOne.fs" />
-    <Compile Include="Matrix\CSR\SpGEMM\Masked.fs" />
-    <Compile Include="Matrix\CSR\SpGEMM\Expand.fs" />
     <Compile Include="Matrix\CSR\Matrix.fs" />
     <Compile Include="Matrix\Rows\Matrix.fs" />
+    <Compile Include="Matrix\SpGeMM\Expand.fs" />
+    <Compile Include="Matrix\SpGeMM\Masked.fs" />
     <Compile Include="Matrix\Matrix.fs" />
     <Compile Include="Algorithms/BFS.fs" />
   </ItemGroup>

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

@@ -40,7 +40,7 @@ module Matrix =
               Columns = cols
               Values = values }
 
-    let toCOOInplace (clContext: ClContext) workGroupSize =
+    let toCOOInPlace (clContext: ClContext) workGroupSize =
         let prepare =
             Common.expandRowPointers clContext workGroupSize
 
@@ -77,35 +77,35 @@ module Matrix =
 
         Map2AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize
 
-    let transposeInplace (clContext: ClContext) workGroupSize =
+    let transposeInPlace (clContext: ClContext) workGroupSize =
 
-        let toCOOInplace = toCOOInplace clContext workGroupSize
+        let toCOOInPlace = toCOOInPlace clContext workGroupSize
 
-        let transposeInplace =
+        let transposeInPlace =
             COO.Matrix.transposeInplace clContext workGroupSize
 
-        let toCSRInplace =
+        let toCSRInPlace =
             COO.Matrix.toCSRInplace clContext workGroupSize
 
         fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) ->
-            toCOOInplace queue allocationMode matrix
-            |> transposeInplace queue
-            |> toCSRInplace queue allocationMode
+            toCOOInPlace queue allocationMode matrix
+            |> transposeInPlace queue
+            |> toCSRInPlace queue allocationMode
 
     let transpose (clContext: ClContext) workGroupSize =
 
         let toCOO = toCOO clContext workGroupSize
 
-        let transposeInplace =
+        let transposeInPlace =
             COO.Matrix.transposeInplace clContext workGroupSize
 
-        let toCSRInplace =
+        let toCSRInPlace =
             COO.Matrix.toCSRInplace clContext workGroupSize
 
         fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) ->
             toCOO queue allocationMode matrix
-            |> transposeInplace queue
-            |> toCSRInplace queue allocationMode
+            |> transposeInPlace queue
+            |> toCSRInPlace queue allocationMode
 
     let byRowsLazy (clContext: ClContext) workGroupSize =
 
@@ -148,40 +148,3 @@ module Matrix =
             runLazy processor allocationMode matrix
             |> Seq.map (fun lazyValue -> lazyValue.Value)
             |> Seq.toArray
-
-    module SpGeMM =
-        let masked
-            (clContext: ClContext)
-            workGroupSize
-            (opAdd: Expr<'c -> 'c -> 'c option>)
-            (opMul: Expr<'a -> 'b -> 'c option>)
-            =
-
-            let run =
-                SpGeMM.Masked.run clContext workGroupSize opAdd opMul
-
-            fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) ->
-
-                run queue matrixLeft matrixRight mask
-
-        let expand
-            (clContext: ClContext)
-            workGroupSize
-            (opAdd: Expr<'c -> 'c -> 'c option>)
-            (opMul: Expr<'a -> 'b -> 'c option>)
-            =
-
-            let run =
-                SpGeMM.Expand.run clContext workGroupSize opAdd opMul
-
-            fun (queue: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) ->
-
-                let values, columns, rows =
-                    run queue allocationMode leftMatrix rightMatrix
-
-                { COO.Context = clContext
-                  ColumnCount = rightMatrix.ColumnCount
-                  RowCount = leftMatrix.RowCount
-                  Values = values
-                  Columns = columns
-                  Rows = rows }