Merge

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

@@ -0,0 +1,144 @@
+namespace GraphBLAS.FSharp.Backend.Common
+
+open Brahma.FSharp
+open GraphBLAS.FSharp.Backend.Objects.ClContext
+
+module Merge =
+    let run<'a, 'b when 'a: struct and 'b: struct and 'a: comparison> (clContext: ClContext) workGroupSize =
+
+        let defaultValue = Unchecked.defaultof<'a>
+
+        let merge =
+            <@ fun (ndRange: Range1D) (firstSide: int) (secondSide: int) (sumOfSides: int) (firstValues: ClArray<'a>) (secondValues: ClArray<'a>) (resultValues: ClArray<'a>) ->
+
+                let gid = ndRange.GlobalID0
+                let lid = ndRange.LocalID0
+
+                let mutable beginIdxLocal = local ()
+                let mutable endIdxLocal = local ()
+
+                if lid < 2 then
+                    // (n - 1) * wgSize - 1 for lid = 0
+                    // n * wgSize - 1 for lid = 1
+                    // where n in 1 .. wgGroupCount
+                    let x = lid * (workGroupSize - 1) + gid - 1
+
+                    let diagonalNumber = min (sumOfSides - 1) x
+
+                    let mutable leftEdge = max 0 (diagonalNumber + 1 - secondSide)
+
+                    let mutable rightEdge = min (firstSide - 1) diagonalNumber
+
+                    while leftEdge <= rightEdge do
+                        let middleIdx = (leftEdge + rightEdge) / 2
+
+                        let firstIndex = firstValues.[middleIdx]
+
+                        let secondIndex =
+                            secondValues.[diagonalNumber - middleIdx]
+
+                        if firstIndex <= secondIndex then
+                            leftEdge <- middleIdx + 1
+                        else
+                            rightEdge <- middleIdx - 1
+
+                    // Here localID equals either 0 or 1
+                    if lid = 0 then
+                        beginIdxLocal <- leftEdge
+                    else
+                        endIdxLocal <- leftEdge
+
+                barrierLocal ()
+
+                let beginIdx = beginIdxLocal
+                let endIdx = endIdxLocal
+                let firstLocalLength = endIdx - beginIdx
+
+                let mutable x = workGroupSize - firstLocalLength
+
+                if endIdx = firstSide then
+                    x <- secondSide - gid + lid + beginIdx
+
+                let secondLocalLength = x
+
+                //First indices are from 0 to firstLocalLength - 1 inclusive
+                //Second indices are from firstLocalLength to firstLocalLength + secondLocalLength - 1 inclusive
+                let localIndices = localArray<'a> workGroupSize
+
+                if lid < firstLocalLength then
+                    localIndices.[lid] <- firstValues.[beginIdx + lid]
+
+                if lid < secondLocalLength then
+                    localIndices.[firstLocalLength + lid] <- secondValues.[gid - beginIdx]
+
+                barrierLocal ()
+
+                if gid < sumOfSides then
+                    let mutable leftEdge = lid + 1 - secondLocalLength
+                    if leftEdge < 0 then leftEdge <- 0
+
+                    let mutable rightEdge = firstLocalLength - 1
+
+                    rightEdge <- min rightEdge lid
+
+                    while leftEdge <= rightEdge do
+                        let middleIdx = (leftEdge + rightEdge) / 2
+                        let firstIndex = localIndices.[middleIdx]
+
+                        let secondIndex =
+                            localIndices.[firstLocalLength + lid - middleIdx]
+
+                        if firstIndex <= secondIndex then
+                            leftEdge <- middleIdx + 1
+                        else
+                            rightEdge <- middleIdx - 1
+
+                    let boundaryX = rightEdge
+                    let boundaryY = lid - leftEdge
+
+                    // boundaryX and boundaryY can't be off the right edge of array (only off the left edge)
+                    let isValidX = boundaryX >= 0
+                    let isValidY = boundaryY >= 0
+
+                    let mutable fstIdx = defaultValue
+
+                    if isValidX then
+                        fstIdx <- localIndices.[boundaryX]
+
+                    let mutable sndIdx = defaultValue
+
+                    if isValidY then
+                        sndIdx <- localIndices.[firstLocalLength + boundaryY]
+
+                    if not isValidX || isValidY && fstIdx <= sndIdx then
+                        resultValues.[gid] <- sndIdx
+                    else
+                        resultValues.[gid] <- fstIdx @>
+
+        let kernel = clContext.Compile merge
+
+        fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'a>) ->
+
+            let firstSide = firstValues.Length
+
+            let secondSide = secondValues.Length
+
+            let sumOfSides = firstSide + secondSide
+
+            let resultValues =
+                clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, sumOfSides)
+
+            let ndRange =
+                Range1D.CreateValid(sumOfSides, workGroupSize)
+
+            let kernel = kernel.GetKernel()
+
+            processor.Post(
+                Msg.MsgSetArguments
+                    (fun () ->
+                        kernel.KernelFunc ndRange firstSide secondSide sumOfSides firstValues secondValues resultValues)
+            )
+
+            processor.Post(Msg.CreateRunMsg<_, _>(kernel))
+
+            resultValues

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

@@ -35,21 +35,22 @@
     <Compile Include="Common/Sort/Radix.fs" />
     <Compile Include="Common/Sort/Bitonic.fs" />
     <Compile Include="Common/Sum.fs" />
+    <Compile Include="Common/Merge.fs" />
     <Compile Include="Matrix/Common.fs" />
-    <Compile Include="Matrix/COOMatrix/Map2.fs" />
-    <Compile Include="Matrix/COOMatrix/Map2AtLeastOne.fs" />
-    <Compile Include="Matrix/COOMatrix/Map.fs" />
-    <Compile Include="Matrix/COOMatrix/Matrix.fs" />
-    <Compile Include="Matrix/CSRMatrix/Map2.fs" />
-    <Compile Include="Matrix/CSRMatrix/SpGEMM/Expand.fs" />
-    <Compile Include="Matrix/CSRMatrix/SpGEMM/Masked.fs" />
-    <Compile Include="Matrix/CSRMatrix/Map2AtLeastOne.fs" />
-    <Compile Include="Matrix/CSRMatrix/Map.fs" />
-    <Compile Include="Matrix/CSRMatrix/Matrix.fs" />
+    <Compile Include="Matrix/COO/Map.fs" />
+    <Compile Include="Matrix/COO/Merge.fs" />
+    <Compile Include="Matrix/COO/Map2.fs" />
+    <Compile Include="Matrix/COO/Matrix.fs" />
+    <Compile Include="Matrix/CSR/Merge.fs" />
+    <Compile Include="Matrix/CSR/Map2.fs" />
+    <Compile Include="Matrix/CSR/SpGEMM/Expand.fs" />
+    <Compile Include="Matrix/CSR/SpGEMM/Masked.fs" />
+    <Compile Include="Matrix/CSR/Map.fs" />
+    <Compile Include="Matrix/CSR/Matrix.fs" />
     <Compile Include="Matrix/Matrix.fs" />
     <Compile Include="Vector/SparseVector/Common.fs" />
+    <Compile Include="Vector/SparseVector/Merge.fs" />
     <Compile Include="Vector/SparseVector/Map2.fs" />
-    <Compile Include="Vector/SparseVector/Map2AtLeastOne.fs" />
     <Compile Include="Vector/SparseVector/SparseVector.fs" />
     <Compile Include="Vector/DenseVector/DenseVector.fs" />
     <Compile Include="Vector/Vector.fs" />

src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs → src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs

@@ -8,10 +8,8 @@ open GraphBLAS.FSharp.Backend
 open GraphBLAS.FSharp.Backend.Quotes
 open GraphBLAS.FSharp.Backend.Objects.ClMatrix
 open GraphBLAS.FSharp.Backend.Objects.ClContext
-open GraphBLAS.FSharp.Backend.Quotes
 
 module internal Map2 =
-
     let preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd =
 
         let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) =
@@ -134,3 +132,123 @@ module internal Map2 =
               Rows = resultRows
               Columns = resultColumns
               Values = resultValues }
+
+    module AtLeastOne =
+        let preparePositionsAtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality>
+            (clContext: ClContext)
+            (opAdd: Expr<'a option -> 'b option -> 'c option>)
+            workGroupSize
+            =
+
+            let preparePositions =
+                <@ fun (ndRange: Range1D) length (allRowsBuffer: ClArray<int>) (allColumnsBuffer: ClArray<int>) (leftValuesBuffer: ClArray<'a>) (rightValuesBuffer: ClArray<'b>) (allValuesBuffer: ClArray<'c>) (rawPositionsBuffer: ClArray<int>) (isLeftBitmap: ClArray<int>) ->
+
+                    let i = ndRange.GlobalID0
+
+                    if (i < length - 1
+                        && allRowsBuffer.[i] = allRowsBuffer.[i + 1]
+                        && allColumnsBuffer.[i] = allColumnsBuffer.[i + 1]) then
+
+                        let result =
+                            (%opAdd) (Some leftValuesBuffer.[i + 1]) (Some rightValuesBuffer.[i])
+
+                        (%PreparePositions.both) i result rawPositionsBuffer allValuesBuffer
+                    elif (i > 0
+                          && i < length
+                          && (allRowsBuffer.[i] <> allRowsBuffer.[i - 1]
+                              || allColumnsBuffer.[i] <> allColumnsBuffer.[i - 1]))
+                         || i = 0 then
+
+                        let leftResult =
+                            (%opAdd) (Some leftValuesBuffer.[i]) None
+
+                        let rightResult =
+                            (%opAdd) None (Some rightValuesBuffer.[i])
+
+                        (%PreparePositions.leftRight)
+                            i
+                            leftResult
+                            rightResult
+                            isLeftBitmap
+                            allValuesBuffer
+                            rawPositionsBuffer @>
+
+            let kernel = clContext.Compile(preparePositions)
+
+            fun (processor: MailboxProcessor<_>) (allRows: ClArray<int>) (allColumns: ClArray<int>) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray<int>) ->
+                let length = leftValues.Length
+
+                let ndRange =
+                    Range1D.CreateValid(length, workGroupSize)
+
+                let rawPositionsGpu =
+                    clContext.CreateClArrayWithSpecificAllocationMode<int>(DeviceOnly, length)
+
+                let allValues =
+                    clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, length)
+
+                let kernel = kernel.GetKernel()
+
+                processor.Post(
+                    Msg.MsgSetArguments
+                        (fun () ->
+                            kernel.KernelFunc
+                                ndRange
+                                length
+                                allRows
+                                allColumns
+                                leftValues
+                                rightValues
+                                allValues
+                                rawPositionsGpu
+                                isLeft)
+                )
+
+                processor.Post(Msg.CreateRunMsg<_, _>(kernel))
+
+                rawPositionsGpu, allValues
+
+
+        ///<param name="clContext">.</param>
+        ///<param name="opAdd">.</param>
+        ///<param name="workGroupSize">Should be a power of 2 and greater than 1.</param>
+        let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality>
+            (clContext: ClContext)
+            (opAdd: Expr<'a option -> 'b option -> 'c option>)
+            workGroupSize
+            =
+
+            let merge = Merge.run clContext workGroupSize
+
+            let preparePositions =
+                preparePositionsAtLeastOne clContext opAdd workGroupSize
+
+            let setPositions =
+                Common.setPositions<'c> clContext workGroupSize
+
+            fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) ->
+
+                let allRows, allColumns, leftMergedValues, rightMergedValues, isLeft =
+                    merge queue matrixLeft matrixRight
+
+                let rawPositions, allValues =
+                    preparePositions queue allRows allColumns leftMergedValues rightMergedValues isLeft
+
+                queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues))
+                queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues))
+
+                let resultRows, resultColumns, resultValues, _ =
+                    setPositions queue allocationMode allRows allColumns allValues rawPositions
+
+                queue.Post(Msg.CreateFreeMsg<_>(isLeft))
+                queue.Post(Msg.CreateFreeMsg<_>(rawPositions))
+                queue.Post(Msg.CreateFreeMsg<_>(allRows))
+                queue.Post(Msg.CreateFreeMsg<_>(allColumns))
+                queue.Post(Msg.CreateFreeMsg<_>(allValues))
+
+                { Context = clContext
+                  RowCount = matrixLeft.RowCount
+                  ColumnCount = matrixLeft.ColumnCount
+                  Rows = resultRows
+                  Columns = resultColumns
+                  Values = resultValues }

src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs → src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs

@@ -21,7 +21,7 @@ module Matrix =
         workGroupSize
         =
 
-        Map2AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize
+        Map2.AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize
 
     let getTuples (clContext: ClContext) workGroupSize =