eWiseAdd with AtLeastOne

Author: kirillgarbar

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

@@ -1,5 +1,12 @@
 namespace GraphBLAS.FSharp.Backend.Common
 
+open GraphBLAS.FSharp.Backend.Common
+
+type AtLeastOne<'a, 'b when 'a: struct and 'b: struct> =
+    | Both of 'a * 'b
+    | Left of 'a
+    | Right of 'b
+
 module StandardOperations =
     let boolSum =
         <@ fun (_: bool option) (_: bool option) -> Some true @>
@@ -51,3 +58,50 @@ module StandardOperations =
             | None, None -> ()
 
             if res = 0f then None else (Some res) @>
+
+    let boolSum2 =
+        <@ fun (_: AtLeastOne<bool, bool>) -> Some true @>
+
+    let intSum2 =
+        <@ fun (values: AtLeastOne<int, int>) ->
+            let mutable res = 0
+
+            match values with
+            | Both (f, s) -> res <- f + s
+            | Left f -> res <- f
+            | Right s -> res <- s
+
+            if res = 0 then None else (Some res) @>
+
+    let byteSum2 =
+        <@ fun (values: AtLeastOne<byte, byte>) ->
+            let mutable res = 0uy
+
+            match values with
+            | Both (f, s) -> res <- f + s
+            | Left f -> res <- f
+            | Right s -> res <- s
+
+            if res = 0uy then None else (Some res) @>
+
+    let floatSum2 =
+        <@ fun (values: AtLeastOne<float, float>) ->
+            let mutable res = 0.0
+
+            match values with
+            | Both (f, s) -> res <- f + s
+            | Left f -> res <- f
+            | Right s -> res <- s
+
+            if res = 0.0 then None else (Some res) @>
+
+    let float32Sum2 =
+        <@ fun (values: AtLeastOne<float32, float32>) ->
+            let mutable res = 0f
+
+            match values with
+            | Both (f, s) -> res <- f + s
+            | Left f -> res <- f
+            | Right s -> res <- s
+
+            if res = 0f then None else (Some res) @>

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

@@ -1,6 +1,8 @@
 namespace GraphBLAS.FSharp.Backend
 
 open Brahma.FSharp
+open GraphBLAS.FSharp.Backend
+open GraphBLAS.FSharp.Backend.Common
 open Microsoft.FSharp.Quotations
 
 module COOMatrix =
@@ -659,3 +661,135 @@ module COOMatrix =
               RowPointers = compressedRows
               Columns = matrix.Columns
               Values = matrix.Values }
+
+    let private preparePositions2<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality>
+        (clContext: ClContext)
+        (opAdd: Expr<AtLeastOne<'a, 'b> -> '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
+                    rawPositionsBuffer.[i] <- 0
+
+                    match (%opAdd) (Both(leftValuesBuffer.[i + 1], rightValuesBuffer.[i])) with
+                    | Some v ->
+                        allValuesBuffer.[i + 1] <- v
+                        rawPositionsBuffer.[i + 1] <- 1
+                    | None -> rawPositionsBuffer.[i + 1] <- 0
+                else if (i > 0
+                         && i < length
+                         && (allRowsBuffer.[i] <> allRowsBuffer.[i - 1]
+                             || allColumnsBuffer.[i] <> allColumnsBuffer.[i - 1]))
+                        || i = 0 then
+                    if isLeftBitmap.[i] = 1 then
+                        match (%opAdd) (Left leftValuesBuffer.[i]) with
+                        | Some v ->
+                            allValuesBuffer.[i] <- v
+                            rawPositionsBuffer.[i] <- 1
+                        | None -> rawPositionsBuffer.[i] <- 0
+                    else
+                        match (%opAdd) (Right rightValuesBuffer.[i]) with
+                        | Some v ->
+                            allValuesBuffer.[i] <- v
+                            rawPositionsBuffer.[i] <- 1
+                        | None -> rawPositionsBuffer.[i] <- 0 @>
+
+        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.CreateClArray<int>(
+                    length,
+                    hostAccessMode = HostAccessMode.NotAccessible,
+                    allocationMode = AllocationMode.Default
+                )
+
+            let allValues =
+                clContext.CreateClArray<'c>(
+                    length,
+                    hostAccessMode = HostAccessMode.NotAccessible,
+                    allocationMode = AllocationMode.Default
+                )
+
+            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 eWiseAdd2<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality>
+        (clContext: ClContext)
+        (opAdd: Expr<AtLeastOne<'a, 'b> -> 'c option>)
+        workGroupSize
+        =
+
+        let merge = merge clContext workGroupSize
+
+        let preparePositions =
+            preparePositions2 clContext opAdd workGroupSize
+
+        let setPositions = setPositions<'c> clContext workGroupSize
+
+        fun (queue: MailboxProcessor<_>) (matrixLeft: COOMatrix<'a>) (matrixRight: COOMatrix<'b>) ->
+
+            let allRows, allColumns, leftMergedValues, rightMergedValues, isLeft =
+                merge
+                    queue
+                    matrixLeft.Rows
+                    matrixLeft.Columns
+                    matrixLeft.Values
+                    matrixRight.Rows
+                    matrixRight.Columns
+                    matrixRight.Values
+
+            let rawPositions, allValues =
+                preparePositions queue allRows allColumns leftMergedValues rightMergedValues isLeft
+
+            queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues))
+            queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues))
+
+            let resultRows, resultColumns, resultValues, resultLength =
+                setPositions queue 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/CSRMatrix/CSRMatrix.fs

@@ -2,6 +2,7 @@ namespace GraphBLAS.FSharp.Backend
 
 open Brahma.FSharp
 open GraphBLAS.FSharp.Backend
+open GraphBLAS.FSharp.Backend.Common
 open Microsoft.FSharp.Quotations
 
 module CSRMatrix =
@@ -117,3 +118,29 @@ module CSRMatrix =
             processor.Post(Msg.CreateFreeMsg(m3COO.Rows))
 
             m3
+
+    let eWiseAdd2 (clContext: ClContext) (opAdd: Expr<AtLeastOne<'a, 'b> -> 'c option>) workGroupSize =
+
+        let toCOOInplaceLeft = toCOOInplace clContext workGroupSize
+        let toCOOInplaceRight = toCOOInplace clContext workGroupSize
+
+        let eWiseCOO =
+            COOMatrix.eWiseAdd2 clContext opAdd workGroupSize
+
+        let toCSRInplace =
+            COOMatrix.toCSRInplace clContext workGroupSize
+
+        fun (processor: MailboxProcessor<_>) (m1: CSRMatrix<'a>) (m2: CSRMatrix<'b>) ->
+
+            let m1COO = toCOOInplaceLeft processor m1
+            let m2COO = toCOOInplaceRight processor m2
+
+            let m3COO = eWiseCOO processor m1COO m2COO
+
+            processor.Post(Msg.CreateFreeMsg(m1COO.Rows))
+            processor.Post(Msg.CreateFreeMsg(m2COO.Rows))
+
+            let m3 = toCSRInplace processor m3COO
+            processor.Post(Msg.CreateFreeMsg(m3COO.Rows))
+
+            m3

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

@@ -1,8 +1,9 @@
 namespace GraphBLAS.FSharp.Backend
 
 open Brahma.FSharp
+open GraphBLAS.FSharp.Backend
 open Microsoft.FSharp.Quotations
-open OpenCL.Net
+open GraphBLAS.FSharp.Backend.Common
 
 module Matrix =
     let copy (clContext: ClContext) =
@@ -65,3 +66,16 @@ module Matrix =
             | MatrixCOO m1, MatrixCOO m2 -> COOeWiseAdd processor m1 m2 |> MatrixCOO
             | MatrixCSR m1, MatrixCSR m2 -> CSReWiseAdd processor m1 m2 |> MatrixCSR
             | _ -> failwith "Matrix formats are not matching"
+
+    let eWiseAdd2 (clContext: ClContext) (opAdd: Expr<AtLeastOne<'a, 'b> -> 'c option>) workGroupSize =
+        let COOeWiseAdd =
+            COOMatrix.eWiseAdd2 clContext opAdd workGroupSize
+
+        let CSReWiseAdd =
+            CSRMatrix.eWiseAdd2 clContext opAdd workGroupSize
+
+        fun (processor: MailboxProcessor<_>) matrix1 matrix2 ->
+            match matrix1, matrix2 with
+            | MatrixCOO m1, MatrixCOO m2 -> COOeWiseAdd processor m1 m2 |> MatrixCOO
+            | MatrixCSR m1, MatrixCSR m2 -> CSReWiseAdd processor m1 m2 |> MatrixCSR
+            | _ -> failwith "Matrix formats are not matching"

tests/GraphBLAS-sharp.Tests/BackendCommonTests/MatrixEwiseAddTests.fs

@@ -147,3 +147,67 @@ let tests =
             )
     |> List.collect testFixtures
     |> testList "Backend.Matrix.eWiseAdd tests"
+
+let testFixtures2 case =
+    [ let config = defaultConfig
+      let wgSize = 256
+
+      let getCorrectnessTestName datatype =
+          sprintf "Correctness on %s, %A" datatype case
+
+      let context = case.ClContext.ClContext
+      let q = case.ClContext.Queue
+      q.Error.Add(fun e -> failwithf "%A" e)
+
+      let boolAdd =
+          Matrix.eWiseAdd2 context boolSum2 wgSize
+
+      let boolToCOO = Matrix.toCOO context wgSize
+
+      case
+      |> correctnessGenericTest false (||) boolAdd boolToCOO (=) q
+      |> testPropertyWithConfig config (getCorrectnessTestName "bool")
+
+      let intAdd =
+          Matrix.eWiseAdd2 context intSum2 wgSize
+
+      let intToCOO = Matrix.toCOO context wgSize
+
+      case
+      |> correctnessGenericTest 0 (+) intAdd intToCOO (=) q
+      |> testPropertyWithConfig config (getCorrectnessTestName "int")
+
+      let floatAdd =
+          Matrix.eWiseAdd2 context floatSum2 wgSize
+
+      let floatToCOO = Matrix.toCOO context wgSize
+
+      case
+      |> correctnessGenericTest 0.0 (+) floatAdd floatToCOO (fun x y -> abs (x - y) < Accuracy.medium.absolute) q
+      |> testPropertyWithConfig config (getCorrectnessTestName "float")
+
+      let byteAdd =
+          Matrix.eWiseAdd2 context byteSum2 wgSize
+
+      let byteToCOO = Matrix.toCOO context wgSize
+
+      case
+      |> correctnessGenericTest 0uy (+) byteAdd byteToCOO (=) q
+      |> testPropertyWithConfig config (getCorrectnessTestName "byte") ]
+
+let tests2 =
+    testCases
+    |> List.filter
+        (fun case ->
+            let mutable e = ErrorCode.Unknown
+            let device = case.ClContext.ClContext.ClDevice.Device
+
+            let deviceType =
+                Cl
+                    .GetDeviceInfo(device, DeviceInfo.Type, &e)
+                    .CastTo<DeviceType>()
+
+            deviceType = DeviceType.Gpu
+            )
+    |> List.collect testFixtures2
+    |> testList "Backend.Matrix.eWiseAdd2 tests"