Frontier and levels buffers reused with new methods

Author: kirillgarbar

src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs

@@ -11,65 +11,62 @@ module BFS =
         (clContext: ClContext)
         (add: Expr<int option -> int option -> int option>)
         (mul: Expr<'a option -> 'b option -> int option>)
-        (addNumeric: Expr<int -> int -> int>)
         workGroupSize
         =
 
-        let spMV = SpMV.run clContext add mul workGroupSize
+        let spMVTo =
+            SpMV.runTo clContext add mul workGroupSize
 
         let zeroCreate =
             ClArray.zeroCreate clContext workGroupSize
 
         let ofList = Vector.ofList clContext Dense
 
-        let maskComplemented =
-            DenseVector.DenseVector.elementWise clContext StandardOperations.complementedMaskOp workGroupSize
+        let maskComplementedTo =
+            DenseVector.DenseVector.elementWiseTo clContext StandardOperations.complementedMaskOp workGroupSize
 
-        let fillSubVector =
-            Vector.standardFillSubVector<int, int> clContext workGroupSize
+        let fillSubVectorTo =
+            DenseVector.DenseVector.standardFillSubVectorTo<int, int> clContext workGroupSize
 
         let containsNonZero =
             DenseVector.DenseVector.containsNonZero clContext workGroupSize
 
         fun (queue: MailboxProcessor<Msg>) (matrix: CSRMatrix<'a>) (source: int) ->
             let vertexCount = matrix.RowCount
 
-            let mutable levels: ClVector<int> =
-                zeroCreate queue vertexCount |> ClVectorDense
+            let levels = zeroCreate queue vertexCount
 
-            let mutable frontier = ofList vertexCount [ source, 1 ]
+            let frontier = ofList vertexCount [ source, 1 ]
 
-            let mutable level = 0
-            let mutable stop = false
+            match frontier with
+            | ClVectorDense front ->
 
-            while not stop do
-                level <- level + 1
+                let mutable level = 0
+                let mutable stop = false
 
-                let newLevels =
-                    fillSubVector queue levels frontier (clContext.CreateClCell level)
+                while not stop do
+                    level <- level + 1
 
-                levels.Dispose queue
-
-                match frontier, newLevels with
-                | ClVectorDense f, ClVectorDense nl ->
-                    let newFrontierUnmasked = spMV queue matrix f
+                    //Assigning new level values
+                    fillSubVectorTo queue levels front (clContext.CreateClCell level) levels
+                    |> ignore
 
-                    let newFrontier =
-                        maskComplemented queue newFrontierUnmasked nl
+                    //Getting new frontier
+                    spMVTo queue matrix front front |> ignore
 
-                    newFrontierUnmasked.Dispose queue
-                    frontier.Dispose queue
+                    maskComplementedTo queue front levels front
+                    |> ignore
 
+                    //Checking if front is empty
                     let frontNotEmpty = Array.zeroCreate 1
-                    let sum = containsNonZero queue newFrontier
+                    let sum = containsNonZero queue front
 
                     queue.PostAndReply(fun ch -> Msg.CreateToHostMsg(sum, frontNotEmpty, ch))
                     |> ignore
 
-                    frontier <- newFrontier |> ClVectorDense
-                    levels <- newLevels
-
                     stop <- not frontNotEmpty.[0]
-                | _ -> failwith "Not implemented"
 
-            levels
+                front.Dispose queue
+
+                levels
+            | _ -> failwith "Not implemented"

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

@@ -36,7 +36,7 @@ module DenseVector =
 
             result
 
-    let elementWise<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct>
+    let elementWiseTo<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct>
         (clContext: ClContext)
         (opAdd: Expr<'a option -> 'b option -> 'c option>)
         (workGroupSize: int)
@@ -52,14 +52,7 @@ module DenseVector =
 
         let kernel = clContext.Compile(elementWise)
 
-        fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) ->
-            let resultVector =
-                clContext.CreateClArray(
-                    leftVector.Length,
-                    hostAccessMode = HostAccessMode.NotAccessible,
-                    deviceAccessMode = DeviceAccessMode.ReadWrite,
-                    allocationMode = AllocationMode.Default
-                )
+        fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) ->
 
             let ndRange =
                 Range1D.CreateValid(leftVector.Length, workGroupSize)
@@ -75,10 +68,30 @@ module DenseVector =
 
             resultVector
 
+    let elementWise<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct>
+        (clContext: ClContext)
+        (opAdd: Expr<'a option -> 'b option -> 'c option>)
+        (workGroupSize: int)
+        =
+
+        let elementWiseTo =
+            elementWiseTo clContext opAdd workGroupSize
+
+        fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) ->
+            let resultVector =
+                clContext.CreateClArray(
+                    leftVector.Length,
+                    hostAccessMode = HostAccessMode.NotAccessible,
+                    deviceAccessMode = DeviceAccessMode.ReadWrite,
+                    allocationMode = AllocationMode.Default
+                )
+
+            elementWiseTo processor leftVector rightVector resultVector
+
     let elementWiseAtLeastOne clContext op workGroupSize =
         elementWise clContext (StandardOperations.atLeastOneToOption op) workGroupSize
 
-    let fillSubVector<'a, 'b when 'a: struct and 'b: struct>
+    let fillSubVectorTo<'a, 'b when 'a: struct and 'b: struct>
         (clContext: ClContext)
         (maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>)
         (workGroupSize: int)
@@ -94,14 +107,7 @@ module DenseVector =
 
         let kernel = clContext.Compile(fillSubVectorKernel)
 
-        fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: ClCell<'a>) ->
-            let resultVector =
-                clContext.CreateClArray<'a option>(
-                    leftVector.Length,
-                    hostAccessMode = HostAccessMode.NotAccessible,
-                    deviceAccessMode = DeviceAccessMode.ReadWrite,
-                    allocationMode = AllocationMode.Default
-                )
+        fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: ClCell<'a>) (resultVector: ClArray<'a option>) ->
 
             let ndRange =
                 Range1D.CreateValid(leftVector.Length, workGroupSize)
@@ -117,6 +123,32 @@ module DenseVector =
 
             resultVector
 
+    let fillSubVector<'a, 'b when 'a: struct and 'b: struct>
+        (clContext: ClContext)
+        (maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>)
+        (workGroupSize: int)
+        =
+
+        let fillSubVectorTo =
+            fillSubVectorTo clContext maskOp workGroupSize
+
+        fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: ClCell<'a>) ->
+            let resultVector =
+                clContext.CreateClArray<'a option>(
+                    leftVector.Length,
+                    hostAccessMode = HostAccessMode.NotAccessible,
+                    deviceAccessMode = DeviceAccessMode.ReadWrite,
+                    allocationMode = AllocationMode.Default
+                )
+
+            fillSubVectorTo processor leftVector maskVector value resultVector
+
+    let standardFillSubVectorTo<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) (workGroupSize: int) =
+        fillSubVectorTo<'a, 'b>
+            clContext
+            (StandardOperations.fillSubToOption StandardOperations.fillSubOp<'a>)
+            workGroupSize
+
     let private getBitmap<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) =
 
         let getPositions =

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

@@ -7,7 +7,7 @@ open GraphBLAS.FSharp.Backend.Common
 open Microsoft.FSharp.Quotations
 
 module SpMV =
-    let run
+    let runTo
         (clContext: ClContext)
         (add: Expr<'c option -> 'c option -> 'c option>)
         (mul: Expr<'a option -> 'b option -> 'c option>)
@@ -95,7 +95,7 @@ module SpMV =
         let multiplyValues = clContext.Compile multiplyValues
         let reduceValuesByRows = clContext.Compile reduceValuesByRows
 
-        fun (queue: MailboxProcessor<_>) (matrix: CSRMatrix<'a>) (vector: ClArray<'b option>) ->
+        fun (queue: MailboxProcessor<_>) (matrix: CSRMatrix<'a>) (vector: ClArray<'b option>) (result: ClArray<'b option>) ->
 
             let matrixLength = matrix.Values.Length
 
@@ -129,14 +129,6 @@ module SpMV =
 
             queue.Post(Msg.CreateRunMsg<_, _>(multiplyValues))
 
-            let outputArray =
-                clContext.CreateClArray<'c option>(
-                    matrix.RowCount,
-                    deviceAccessMode = DeviceAccessMode.ReadWrite,
-                    hostAccessMode = HostAccessMode.NotAccessible,
-                    allocationMode = AllocationMode.Default
-                )
-
             let reduceValuesByRows = reduceValuesByRows.GetKernel()
 
             queue.Post(
@@ -147,11 +139,31 @@ module SpMV =
                             matrix.RowCount
                             intermediateArray
                             matrix.RowPointers
-                            outputArray)
+                            result)
             )
 
             queue.Post(Msg.CreateRunMsg<_, _>(reduceValuesByRows))
 
             queue.Post(Msg.CreateFreeMsg intermediateArray)
 
-            outputArray
+            result
+
+    let run
+        (clContext: ClContext)
+        (add: Expr<'c option -> 'c option -> 'c option>)
+        (mul: Expr<'a option -> 'b option -> 'c option>)
+        workGroupSize
+        =
+        let runTo = runTo clContext add mul workGroupSize
+
+        fun (queue: MailboxProcessor<_>) (matrix: CSRMatrix<'a>) (vector: ClArray<'b option>) ->
+
+            let result =
+                clContext.CreateClArray<'b option>(
+                    matrix.RowCount,
+                    deviceAccessMode = DeviceAccessMode.ReadWrite,
+                    hostAccessMode = HostAccessMode.NotAccessible,
+                    allocationMode = AllocationMode.Default
+                )
+
+            runTo queue matrix vector result

tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs

@@ -18,12 +18,7 @@ let testFixtures (testContext: TestContext) =
           sprintf "Test on %A" testContext.ClContext
 
       let bfs =
-          Algorithms.BFS.singleSource
-              context
-              StandardOperations.intSum
-              StandardOperations.intMul
-              <@ (+) @>
-              workGroupSize
+          Algorithms.BFS.singleSource context StandardOperations.intSum StandardOperations.intMul workGroupSize
 
       testPropertyWithConfig config testName
       <| fun (matrix: int [,]) ->
@@ -47,7 +42,7 @@ let testFixtures (testContext: TestContext) =
 
               match matrix with
               | MatrixCSR mtx ->
-                  let res = bfs queue mtx source
+                  let res = bfs queue mtx source |> ClVectorDense
 
                   let resHost = res.ToHost queue