Count atomic

Author: kirillgarbar

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

@@ -902,22 +902,40 @@ module ClArray =
 
     let count<'a> (predicate: Expr<'a -> bool>) (clContext: ClContext) workGroupSize =
 
-        let sum =
-            Reduce.reduce <@ (+) @> clContext workGroupSize
+        let count =
+            <@ fun (ndRange: Range1D) (length: int) (array: ClArray<'a>) (count: ClCell<int>) ->
+                let gid = ndRange.GlobalID0
+                let mutable countLocal = 0
+                let gSize = ndRange.GlobalWorkSize
 
-        let getBitmap =
-            Map.map<'a, int> (Map.predicateBitmap predicate) clContext workGroupSize
+                let mutable i = gid
+
+                while i < length do
+                    let res = (%predicate) array.[i]
+                    if res then countLocal <- countLocal + 1
+                    i <- i + gSize
+
+                atomic (+) count.Value countLocal |> ignore @>
+
+        let count = clContext.Compile count
 
         fun (processor: RawCommandQueue) (array: ClArray<'a>) ->
 
-            let bitmap = getBitmap processor DeviceOnly array
+            let result = clContext.CreateClCell<int>(0)
 
-            let result =
-                (sum processor bitmap).ToHostAndFree processor
+            let numberOfGroups =
+                Utils.divUpClamp array.Length workGroupSize 1 1024
 
-            bitmap.Free()
+            let ndRange =
+                Range1D.CreateValid(workGroupSize * numberOfGroups, workGroupSize)
 
-            result
+            let kernel = count.GetKernel()
+
+            kernel.KernelFunc ndRange array.Length array result
+
+            processor.RunKernel kernel
+
+            result.ToHostAndFree processor
 
     /// <summary>
     /// Builds a new array whose elements are the results of applying the given function

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

@@ -19,6 +19,10 @@ module internal Utils =
         >> fun x -> x ||| (x >>> 16)
         >> fun x -> x + 1
 
+    let divUp x y = x / y + (if x % y = 0 then 0 else 1)
+
+    let divUpClamp x y left right = min (max (divUp x y) left) right
+
     let floorToMultiple multiple x = x / multiple * multiple
 
     let ceilToMultiple multiple x = ((x - 1) / multiple + 1) * multiple