add: Common.Merge with explicit error

Author: IgorErin

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

@@ -0,0 +1,143 @@
+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] <- firstValues.[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,6 +35,7 @@
     <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\COO\Map.fs" />
     <Compile Include="Matrix\COO\Merge.fs" />

tests/GraphBLAS-sharp.Tests/Common/Merge.fs

@@ -0,0 +1,54 @@
+module GraphBLAS.FSharp.Tests.Common.Merge
+
+open Expecto
+open Brahma.FSharp
+open GraphBLAS.FSharp.Tests
+open GraphBLAS.FSharp.Backend.Common
+open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions
+
+let context = Context.defaultContext.ClContext
+
+let processor = Context.defaultContext.Queue
+
+let config =
+    { Utils.defaultConfig with
+          endSize = 10 }
+
+let makeTest isEqual testFun (leftArray: 'a []) (rightArray: 'a []) =
+    if leftArray.Length > 0 && rightArray.Length > 0 then
+
+        let leftArray = Array.sort leftArray |> Array.distinct
+
+        let rightArray = Array.sort rightArray |> Array.distinct
+
+        let clLeftArray = context.CreateClArray leftArray
+        let clRightArray = context.CreateClArray rightArray
+
+        let clResult: ClArray<'a> =
+            testFun processor clLeftArray clRightArray
+
+        let result = clResult.ToHostAndFree processor
+        clLeftArray.Free processor
+        clRightArray.Free processor
+
+        let expected =
+            Array.concat [ leftArray; rightArray ]
+            |> Array.sort
+
+        "Results must be the same"
+        |> Utils.compareArrays isEqual result expected
+
+let createTest<'a> isEqual =
+    Merge.run context Utils.defaultWorkGroupSize
+    |> makeTest isEqual
+    |> testPropertyWithConfig config $"test on {typeof<'a>}"
+
+let tests =
+    [ createTest<int> (=)
+
+      if Utils.isFloat64Available context.ClDevice then
+          createTest<float> (=)
+
+      createTest<float32> (=)
+      createTest<bool> (=) ]
+    |> testList "Merge"

tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj

@@ -18,6 +18,7 @@
         <Compile Include="QuickGraph/Algorithms/BFS.fs" />
         <Compile Include="Common/Scatter.fs" />
         <Compile Include="Common/Gather.fs" />
+        <Compile Include="Common\Merge.fs" />
         <Compile Include="Common/ClArray/Choose.fs" />
         <Compile Include="Common/ClArray/Exists.fs" />
         <Compile Include="Common/ClArray/Map.fs" />

tests/GraphBLAS-sharp.Tests/Matrix/Merge.fs

@@ -161,7 +161,7 @@ let makeTestCSR isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) =
 let createTestCSR isEqual (zero: 'a) =
     Matrix.CSR.Merge.run context Utils.defaultWorkGroupSize
     |> makeTestCSR isEqual zero
-    |> testPropertyWithConfig { config with endSize = 10 } $"test on {typeof<'a>}"
+    |> testPropertyWithConfig config $"test on {typeof<'a>}"
 
 let testsCSR =
     [ createTestCSR (=) 0

tests/GraphBLAS-sharp.Tests/Program.fs

@@ -95,6 +95,6 @@ open GraphBLAS.FSharp.Tests
 
 [<EntryPoint>]
 let main argv =
-    Matrix.Merge.testsCOO
+    Common.Merge.tests
     |> testSequenced
     |> runTestsWithCLIArgs [] argv