Vector

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

@@ -36,6 +36,23 @@ module SubSum =
 
     let treeSum<'a> opAdd = sumGeneral<'a> <| treeAccess<'a> opAdd
 
+module SubReduce =
+    let run opAdd =
+        <@ fun length wgSize gid lid (localValues: 'a []) ->
+            let mutable step = 2
+
+            while step <= wgSize do
+                if (gid + wgSize / step) < length
+                   && lid < wgSize / step then
+                    let firstValue = localValues.[lid]
+                    let secondValue = localValues.[lid + wgSize / step]
+
+                    localValues.[lid] <- (%opAdd) firstValue secondValue
+
+                step <- step <<< 1
+
+                barrierLocal () @>
+
 module PreparePositions =
     let both<'c> =
         <@ fun index (result: 'c option) (rawPositionsBuffer: ClArray<int>) (allValuesBuffer: ClArray<'c>) ->

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

@@ -0,0 +1,144 @@
+namespace GraphBLAS.FSharp.Backend.Common
+
+open Brahma.FSharp
+open GraphBLAS.FSharp.Backend
+open Microsoft.FSharp.Control
+open Microsoft.FSharp.Quotations
+
+module Reduce =
+    let private scan<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) =
+
+        let scan =
+            <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) ->
+
+                let gid = ndRange.GlobalID0
+                let lid = ndRange.LocalID0
+
+                let localValues = localArray<'a> workGroupSize
+
+                if gid < length then
+                    localValues.[lid] <- inputArray.[gid]
+
+                barrierLocal ()
+
+                if gid < length then
+
+                    (%SubReduce.run opAdd) length workGroupSize gid lid localValues
+
+                    if lid = 0 then
+                        resultArray.[gid / workGroupSize] <- localValues.[0] @>
+
+        let kernel = clContext.Compile(scan)
+
+        fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength (resultArray: ClArray<'a>) ->
+
+            let ndRange =
+                Range1D.CreateValid(valuesArray.Length, workGroupSize)
+
+            let kernel = kernel.GetKernel()
+
+            processor.Post(
+                Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultArray)
+            )
+
+            processor.Post(Msg.CreateRunMsg<_, _>(kernel))
+
+    let private scanToCell<'a when 'a: struct>
+        (clContext: ClContext)
+        (workGroupSize: int)
+        (opAdd: Expr<'a -> 'a -> 'a>)
+        =
+
+        let scan =
+            <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (resultValue: ClCell<'a>) ->
+
+                let gid = ndRange.GlobalID0
+                let lid = ndRange.LocalID0
+
+                let localValues = localArray<'a> workGroupSize
+
+                if gid < length then
+                    localValues.[lid] <- inputArray.[gid]
+
+                barrierLocal ()
+
+                if gid < length then
+
+                    (%SubReduce.run opAdd) length workGroupSize gid lid localValues
+
+                    if lid = 0 then
+                        resultValue.Value <- localValues.[0] @>
+
+        let kernel = clContext.Compile(scan)
+
+        fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength (resultValue: ClCell<'a>) ->
+
+            let ndRange =
+                Range1D.CreateValid(valuesArray.Length, workGroupSize)
+
+            let kernel = kernel.GetKernel()
+
+            processor.Post(
+                Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultValue)
+            )
+
+            processor.Post(Msg.CreateRunMsg<_, _>(kernel))
+
+    let run<'a when 'a: struct> (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) =
+
+        let scan = scan clContext workGroupSize opAdd
+
+        let scanToCell = scanToCell clContext workGroupSize opAdd
+
+        fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) ->
+
+            let scan = scan processor
+
+            let firstLength =
+                (inputArray.Length - 1) / workGroupSize + 1
+
+            let firstVerticesArray =
+                clContext.CreateClArray(
+                    firstLength,
+                    hostAccessMode = HostAccessMode.NotAccessible,
+                    deviceAccessMode = DeviceAccessMode.ReadWrite,
+                    allocationMode = AllocationMode.Default
+                )
+
+            let secondLength = (firstLength - 1) / workGroupSize + 1
+
+            let secondVerticesArray =
+                clContext.CreateClArray(
+                    secondLength,
+                    hostAccessMode = HostAccessMode.NotAccessible,
+                    deviceAccessMode = DeviceAccessMode.ReadWrite,
+                    allocationMode = AllocationMode.Default
+                )
+
+            let mutable verticesArrays = firstVerticesArray, secondVerticesArray
+            let swap (a, b) = (b, a)
+
+            scan inputArray inputArray.Length (fst verticesArrays)
+
+            let mutable verticesLength = firstLength
+
+            while verticesLength > workGroupSize do
+                let fstVertices = fst verticesArrays
+                let sndVertices = snd verticesArrays
+
+                scan fstVertices verticesLength sndVertices
+
+                verticesArrays <- swap verticesArrays
+                verticesLength <- (verticesLength - 1) / workGroupSize + 1
+
+            let fstVertices = fst verticesArrays
+
+            let result =
+                clContext.CreateClCell Unchecked.defaultof<'a>
+
+            scanToCell processor fstVertices verticesLength result
+
+            processor.Post(Msg.CreateFreeMsg(firstVerticesArray))
+            processor.Post(Msg.CreateFreeMsg(secondVerticesArray))
+
+            result

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

@@ -1,5 +1,7 @@
 namespace GraphBLAS.FSharp.Backend.Common
 
+open FSharp.Quotations
+
 type AtLeastOne<'a, 'b when 'a: struct and 'b: struct> =
     | Both of 'a * 'b
     | Left of 'a
@@ -109,3 +111,33 @@ module StandardOperations =
             | None, Some right -> (%op) (Right right)
             | Some left, None -> (%op) (Left left)
             | None, None -> None @>
+
+    let fillSubToOption (op: Expr<'a option -> 'a option -> 'a option>) =
+        <@ fun (leftItem: 'a option) (rightItem: 'b option) (value: 'a) ->
+            match rightItem with
+            | Some _ -> (%op) leftItem (Some value)
+            | None -> (%op) leftItem None @>
+
+    let fillSubComplementedToOption (op: Expr<'a option -> 'a option -> 'a option>) =
+        <@ fun (leftItem: 'a option) (rightItem: 'b option) (value: 'a) ->
+            match rightItem with
+            | Some _ -> (%op) leftItem None
+            | None -> (%op) leftItem (Some value) @>
+
+    let fillSubOp<'a when 'a: struct> =
+        <@ fun (left: 'a option) (right: 'a option) ->
+            match left, right with
+            | _, None -> left
+            | _ -> right @>
+
+    let maskOp<'a, 'b when 'a: struct and 'b: struct> =
+        <@ fun (left: 'a option) (right: 'b option) ->
+            match right with
+            | Some _ -> left
+            | _ -> None @>
+
+    let complementedMaskOp<'a, 'b when 'a: struct and 'b: struct> =
+        <@ fun (left: 'a option) (right: 'b option) ->
+            match right with
+            | None -> left
+            | _ -> None @>

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

@@ -19,6 +19,7 @@
     <Compile Include="Common/BitonicSort.fs" />
     <Compile Include="Common/Scatter.fs" />
     <Compile Include="Common/StandardOperations.fs" />
+    <Compile Include="Common/Reduce.fs" />
     <Compile Include="Predefined/PrefixSum.fs" />
     <!--Compile Include="Matrices.fs" /-->
     <Compile Include="Masks.fs" />
@@ -32,6 +33,10 @@
     <Compile Include="Matrix/CSRMatrix/CSRMatrix.fs" />
     <Compile Include="Matrix/CSRMatrix/CSRMatrix.fs" />
     <Compile Include="Matrix/Matrix.fs" />
+    <Compile Include="Vector/SparseVector/SparseElementwise.fs" />
+    <Compile Include="Vector/SparseVector/SparseVector.fs" />
+    <Compile Include="Vector/DenseVector/DenseVector.fs" />
+    <Compile Include="Vector/Vector.fs" />
     <Compile Include="Vector/SpMV.fs" />
     <!--Compile Include="Backend/CSRMatrix/GetTuples.fs" /-->
     <!--Compile Include="Backend/CSRMatrix/SpMSpV.fs" /-->