refactor: DenseVector.toSparse

Author: IgorErin

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

@@ -24,6 +24,7 @@
     <Compile Include="Quotes/SubSum.fs" />
     <Compile Include="Quotes/PreparePositions.fs" />
     <Compile Include="Quotes/Predicates.fs" />
+    <Compile Include="Quotes\Map.fs" />
     <Compile Include="Common/Scatter.fs" />
     <Compile Include="Common/Utils.fs" />
     <Compile Include="Common/Sum.fs" />

src/GraphBLAS-sharp.Backend/Quotes/Map.fs

@@ -0,0 +1,13 @@
+module GraphBLAS.FSharp.Backend.Quotes
+
+module Map =
+    let optionToValueOrZero<'a> =
+        <@ fun (item: 'a option) ->
+            match item with
+            | Some value -> value
+            | None -> Unchecked.defaultof<'a> @>
+
+    let option onSome onNone =
+        <@ function
+            | Some _ -> onSome
+            | None -> onNone @>

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

@@ -86,65 +86,26 @@ module DenseVector =
 
             resultVector
 
-    let private getBitmap<'a when 'a: struct> (clContext: ClContext) workGroupSize =
-
-        let getPositions =
-            <@ fun (ndRange: Range1D) length (vector: ClArray<'a option>) (positions: ClArray<int>) ->
-
-                let gid = ndRange.GlobalID0
-
-                if gid < length then
-                    match vector.[gid] with
-                    | Some _ -> positions.[gid] <- 1
-                    | None -> positions.[gid] <- 0 @>
-
-        let kernel = clContext.Compile(getPositions)
-
-        fun (processor: MailboxProcessor<_>) allocationMode (vector: ClArray<'a option>) ->
-            let positions =
-                clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, vector.Length)
-
-            let ndRange =
-                Range1D.CreateValid(vector.Length, workGroupSize)
-
-            let kernel = kernel.GetKernel()
-
-            processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange vector.Length vector positions))
-
-            processor.Post(Msg.CreateRunMsg(kernel))
-
-            positions
-
-    let private getValuesAndIndices<'a when 'a: struct> (clContext: ClContext) workGroupSize =
-
-        let getValuesAndIndices =
-            <@ fun (ndRange: Range1D) length (denseVector: ClArray<'a option>) (positions: ClArray<int>) (resultValues: ClArray<'a>) (resultIndices: ClArray<int>) ->
-
-                let gid = ndRange.GlobalID0
-
-                if gid = length - 1
-                   || gid < length
-                      && positions.[gid] <> positions.[gid + 1] then
-                    let index = positions.[gid]
+    let toSparse<'a when 'a: struct> (clContext: ClContext) workGroupSize =
 
-                    match denseVector.[gid] with
-                    | Some value ->
-                        resultValues.[index] <- value
-                        resultIndices.[index] <- gid
-                    | None -> () @>
+        let scatterValues = Scatter.runInplace clContext workGroupSize
 
-        let kernel = clContext.Compile(getValuesAndIndices)
+        let scatterIndices = Scatter.runInplace clContext workGroupSize
 
-        let getPositions = getBitmap clContext workGroupSize
+        let getBitmap = ClArray.map clContext workGroupSize <| Map.option 1 0
 
         let prefixSum =
             PrefixSum.standardExcludeInplace clContext workGroupSize
 
+        let allIndices = ClArray.init clContext workGroupSize <@ id @>
+
+        let allValues = ClArray.map clContext workGroupSize Map.optionToValueOrZero
+
         let resultLength = Array.zeroCreate<int> 1
 
         fun (processor: MailboxProcessor<_>) allocationMode (vector: ClArray<'a option>) ->
 
-            let positions = getPositions processor DeviceOnly vector
+            let positions = getBitmap processor DeviceOnly vector
 
             let resultLengthGpu = clContext.CreateClCell 0
 
@@ -159,60 +120,49 @@ module DenseVector =
 
                 res.[0]
 
-            let resultValues =
-                clContext.CreateClArrayWithSpecificAllocationMode<'a>(allocationMode, resultLength)
-
+            // compute result indices
             let resultIndices =
                 clContext.CreateClArrayWithSpecificAllocationMode<int>(allocationMode, resultLength)
 
-            let ndRange =
-                Range1D.CreateValid(vector.Length, workGroupSize)
+            let allIndices = allIndices processor DeviceOnly vector.Length
 
-            let kernel = kernel.GetKernel()
+            scatterIndices processor positions allIndices resultIndices
 
-            processor.Post(
-                Msg.MsgSetArguments
-                    (fun () -> kernel.KernelFunc ndRange vector.Length vector positions resultValues resultIndices)
-            )
-
-            processor.Post(Msg.CreateRunMsg(kernel))
+            processor.Post <| Msg.CreateFreeMsg<_>(allIndices)
 
-            processor.Post(Msg.CreateFreeMsg<_>(positions))
+            // compute result values
+            let allValues = allValues processor DeviceOnly vector
 
-            resultValues, resultIndices
-
-    let toSparse<'a when 'a: struct> (clContext: ClContext) workGroupSize =
+            let resultValues =
+                clContext.CreateClArrayWithSpecificAllocationMode<'a>(allocationMode, resultLength)
 
-        let getValuesAndIndices =
-            getValuesAndIndices clContext workGroupSize
+            scatterValues processor positions allValues resultValues
 
-        fun (processor: MailboxProcessor<_>) allocationMode (vector: ClArray<'a option>) ->
+            processor.Post <| Msg.CreateFreeMsg<_>(allValues)
 
-            let values, indices =
-                getValuesAndIndices processor allocationMode vector
+            processor.Post <| Msg.CreateFreeMsg<_>(positions)
 
             { Context = clContext
-              Indices = indices
-              Values = values
+              Indices = resultIndices
+              Values = resultValues
               Size = vector.Length }
 
     let reduce<'a when 'a: struct> (clContext: ClContext) workGroupSize (opAdd: Expr<'a -> 'a -> 'a>) =
 
         let getValuesAndIndices =
-            getValuesAndIndices clContext workGroupSize
+            ClArray.map clContext workGroupSize Map.optionToValueOrZero
 
         let reduce =
             Reduce.reduce clContext workGroupSize opAdd
 
         fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) ->
 
             try
-                let values, indices =
+                let values =
                     getValuesAndIndices processor DeviceOnly vector
 
                 let result = reduce processor values
 
-                processor.Post(Msg.CreateFreeMsg<_>(indices))
                 processor.Post(Msg.CreateFreeMsg<_>(values))
 
                 result