refactor: Matrix.map*, ClArray.choose

Author: IgorErin

README.md

@@ -19,8 +19,8 @@ GraphBLAS# is a GPGPU-based [GraphBLAS](https://graphblas.org/)-like API impleme
      | Left of 't1
      | Right of 't2
   ```
-  So, type of matrix-matrix elementwise oertion is ```Matrix<Option<'t1>> -> Matrix<Option<'t2>> -> (AtLeastOne<'t1,'t2> -> Option<'t3>) -> Matrix<Option<'t3>>```. 
-- No semirings. Just functions. Ofcourse one can implement semirings on the top of provided API.
+  So, type of matrix-matrix elementwise operation is ```Matrix<Option<'t1>> -> Matrix<Option<'t2>> -> (AtLeastOne<'t1,'t2> -> Option<'t3>) -> Matrix<Option<'t3>>```. 
+- No semirings. Just functions. Of course one can implement semirings on the top of provided API.
 - Minimal core: high-order functions allows us to minimaze core by functions unification. For example, such functions as matrix-matrix addition, matrix-matrix element-wise multiplication, masking all are partial case of `map2` function.
 
 ### Operations

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

@@ -390,12 +390,19 @@ module ClArray =
                 (prefixSum processor positions)
                     .ToHostAndFree(processor)
 
-            let result =
-                clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
+            if resultLength = 0 then
+                positions.Free processor
+
+                None
+            else
+                let result =
+                    clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength)
 
-            assignValues processor sourceValues positions result
+                assignValues processor sourceValues positions result
 
-            result
+                positions.Free processor
+
+                Some result
 
     let assignOption2 (op: Expr<'a -> 'b -> 'c option>) (clContext: ClContext) workGroupSize =
 

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

@@ -94,7 +94,7 @@ module internal Map2 =
     ///<param name="clContext">.</param>
     ///<param name="opAdd">.</param>
     ///<param name="workGroupSize">Should be a power of 2 and greater than 1.</param>
-    let runToCOO<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality>
+    let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality>
         (opAdd: Expr<'a option -> 'b option -> 'c option>)
         (clContext: ClContext)
         workGroupSize
@@ -135,22 +135,6 @@ module internal Map2 =
               Columns = resultColumns
               Values = resultValues }
 
-    let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality>
-        (opAdd: Expr<'a option -> 'b option -> 'c option>)
-        (clContext: ClContext)
-        workGroupSize
-        =
-
-        let map2ToCOO = runToCOO opAdd clContext workGroupSize
-
-        let toCSRInPlace =
-            Matrix.toCSRInPlace clContext workGroupSize
-
-        fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) ->
-            map2ToCOO queue allocationMode matrixLeft matrixRight
-            |> toCSRInPlace queue allocationMode
-
-
     module AtLeastOne =
         let preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality>
             (opAdd: Expr<'a option -> 'b option -> 'c option>)

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

@@ -10,8 +10,6 @@ open GraphBLAS.FSharp.Backend.Objects.ClMatrix
 open GraphBLAS.FSharp.Backend.Objects.ClContext
 open GraphBLAS.FSharp.Backend.Objects.ClVector
 open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions
-open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions
-open GraphBLAS.FSharp.Backend.Objects.ClCell
 
 
 module Matrix =

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

@@ -261,12 +261,16 @@ module Matrix =
         let mapCSR =
             CSR.Matrix.map opAdd clContext workGroupSize
 
+        let transposeCOO =
+            COO.Matrix.transposeInPlace clContext workGroupSize
+
         fun (processor: MailboxProcessor<_>) allocationMode matrix ->
             match matrix with
             | ClMatrix.COO m -> mapCOO processor allocationMode m |> ClMatrix.COO
             | ClMatrix.CSR m -> mapCSR processor allocationMode m |> ClMatrix.COO
             | ClMatrix.CSC m ->
                 (mapCSR processor allocationMode m.ToCSR)
+                |> transposeCOO processor
                 |> ClMatrix.COO
             | _ -> failwith "Not yet implemented"
 
@@ -277,18 +281,21 @@ module Matrix =
         let map2CSR =
             CSR.Matrix.map2 opAdd clContext workGroupSize
 
+        let transposeCOO =
+            COO.Matrix.transposeInPlace clContext workGroupSize
+
         fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 ->
             match matrix1, matrix2 with
             | ClMatrix.COO m1, ClMatrix.COO m2 ->
                 map2COO processor allocationMode m1 m2
                 |> ClMatrix.COO
             | ClMatrix.CSR m1, ClMatrix.CSR m2 ->
                 map2CSR processor allocationMode m1 m2
-                |> ClMatrix.CSR
+                |> ClMatrix.COO
             | ClMatrix.CSC m1, ClMatrix.CSC m2 ->
                 (map2CSR processor allocationMode m1.ToCSR m2.ToCSR)
-                    .ToCSC
-                |> ClMatrix.CSC
+                |> transposeCOO processor
+                |> ClMatrix.COO
             | _ -> failwith "Matrix formats are not matching"
 
     let map2AtLeastOne (opAdd: Expr<AtLeastOne<'a, 'b> -> 'c option>) (clContext: ClContext) workGroupSize =

src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs

@@ -156,18 +156,12 @@ module Vector =
 
         fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) ->
 
-            let notEmpty =
-                (containsNonZero processor vector)
-                    .ToHostAndFree processor
+            choose processor DeviceOnly vector
+            |> function
+                | Some values ->
+                    let result = reduce processor values
 
-            if notEmpty then
-                let values = choose processor DeviceOnly vector
+                    processor.Post(Msg.CreateFreeMsg<_>(values))
 
-                let result = reduce processor values
-
-                processor.Post(Msg.CreateFreeMsg<_>(values))
-
-                result
-
-            else
-                clContext.CreateClCell Unchecked.defaultof<'a>
+                    result
+                | None -> clContext.CreateClCell Unchecked.defaultof<'a>

tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs

@@ -13,37 +13,31 @@ let workGroupSize = Utils.defaultWorkGroupSize
 
 let config = Utils.defaultConfig
 
-let context = Context.defaultContext.ClContext
-
-let processor = defaultContext.Queue
+let makeTest<'a, 'b> testContext mapFun isEqual choose (array: 'a []) =
+    let context = testContext.ClContext
+    let q = testContext.Queue
 
-let makeTest<'a, 'b> testContext choose mapFun isEqual (array: 'a []) =
     if array.Length > 0 then
-        let context = testContext.ClContext
-        let q = testContext.Queue
-
-        let clArray =
-            context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, array)
-
-        let (clResult: ClArray<'b>) = choose q HostInterop clArray
 
-        let hostResult = Array.zeroCreate clResult.Length
+        let clArray = context.CreateClArray array
 
-        q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clResult, hostResult, ch))
-        |> ignore
+        let (clResult: ClArray<'b> option) = choose q HostInterop clArray
 
         let expectedResult = Array.choose mapFun array
 
-        "Result should be the same"
-        |> Utils.compareArrays isEqual hostResult expectedResult
+        match clResult with
+        | Some clResult ->
+            let hostResult = clResult.ToHostAndFree testContext.Queue
 
-let createTest<'a, 'b> testContext mapFun mapFunQ isEqual =
-    let context = testContext.ClContext
+            "Result should be the same"
+            |> Utils.compareArrays isEqual hostResult expectedResult
+        | None ->
+            "Result must be empty"
+            |> Expect.isTrue (expectedResult.Length = 0)
 
-    let choose =
-        ClArray.choose mapFunQ context workGroupSize
-
-    makeTest<'a, 'b> testContext choose mapFun isEqual
+let createTest<'a, 'b> testContext mapFun mapFunQ isEqual =
+    ClArray.choose mapFunQ testContext.ClContext workGroupSize
+    |> makeTest<'a, 'b> testContext mapFun isEqual
     |> testPropertyWithConfig config $"test on %A{typeof<'a>} -> %A{typeof<'b>}"
 
 let testFixtures testContext =
@@ -61,7 +55,10 @@ let testFixtures testContext =
 let tests =
     TestCases.gpuTests "choose id" testFixtures
 
-let makeTest2 isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) =
+let makeTest2 testContext isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) =
+    let context = testContext.ClContext
+    let processor = testContext.Queue
+
     if firstArray.Length > 0 && secondArray.Length > 0 then
 
         let expected =
@@ -81,21 +78,23 @@ let makeTest2 isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) =
         "Results must be the same"
         |> Utils.compareArrays isEqual actual expected
 
-let createTest2 (isEqual: 'a -> 'a -> bool) (opMapQ, opMap) testFun =
-    let testFun =
-        testFun opMapQ context Utils.defaultWorkGroupSize
-
-    makeTest2 isEqual opMap testFun
+let createTest2 testsContext (isEqual: 'a -> 'a -> bool) (opMapQ, opMap) testFun =
+    testFun opMapQ testsContext.ClContext Utils.defaultWorkGroupSize
+    |> makeTest2 testsContext isEqual opMap
     |> testPropertyWithConfig config $"test on %A{typeof<'a>}"
 
-let tests2 =
-    [ createTest2 (=) ArithmeticOperations.intAdd ClArray.choose2
+let testsFixtures2 testContext =
+    let context = testContext.ClContext
+
+    [ createTest2 testContext (=) ArithmeticOperations.intAdd ClArray.choose2
 
       if Utils.isFloat64Available context.ClDevice then
-          createTest2 (=) ArithmeticOperations.floatAdd ClArray.choose2
+          createTest2 testContext (=) ArithmeticOperations.floatAdd ClArray.choose2
 
-      createTest2 (=) ArithmeticOperations.float32Add ClArray.choose2
-      createTest2 (=) ArithmeticOperations.boolAdd ClArray.choose2 ]
-    |> testList "choose2 add"
+      createTest2 testContext (=) ArithmeticOperations.float32Add ClArray.choose2
+      createTest2 testContext (=) ArithmeticOperations.boolAdd ClArray.choose2 ]
+
+let tests2 =
+    TestCases.gpuTests "choose2 add" testsFixtures2
 
 let allTests = testList "Choose" [ tests; tests2 ]