diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs index 618b99ca..283cbcc2 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs @@ -83,7 +83,7 @@ type BFSBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : (matrix :> IDeviceMemObject).Dispose this.Processor member this.ClearResult() = - this.ResultVector.Dispose this.Processor + this.ResultVector.FreeAndWait this.Processor member this.ReadMatrix() = let matrixReader = this.InputMatrixReader @@ -103,7 +103,7 @@ type BFSBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : type BFSBenchmarksWithoutDataTransfer() = inherit BFSBenchmarks, int>( - (fun context wgSize -> BFS.singleSource context ArithmeticOperations.intSum ArithmeticOperations.intMul wgSize), + (fun context wgSize -> BFS.singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption wgSize), int, (fun _ -> Utils.nextInt (System.Random())), Matrix.ToBackendCSR) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs index a298634f..18aa2cdd 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs @@ -195,7 +195,7 @@ module M = type EWiseAddBenchmarks4Float32COOWithoutDataTransfer() = inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32Sum wgSize), + (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), float32, (fun _ -> Utils.nextSingle (System.Random())), Matrix.ToBackendCOO @@ -207,7 +207,7 @@ type EWiseAddBenchmarks4Float32COOWithoutDataTransfer() = type EWiseAddBenchmarks4Float32COOWithDataTransfer() = inherit EWiseAddBenchmarksWithDataTransfer,float32>( - (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32Sum wgSize), + (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), float32, (fun _ -> Utils.nextSingle (System.Random())), Matrix.ToBackendCOO, @@ -234,7 +234,7 @@ type EWiseAddBenchmarks4BoolCOOWithoutDataTransfer() = type EWiseAddBenchmarks4Float32CSRWithoutDataTransfer() = inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> CSR.Matrix.map2 context ArithmeticOperations.float32Sum wgSize), + (fun context wgSize -> CSR.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), float32, (fun _ -> Utils.nextSingle (System.Random())), Matrix.ToBackendCSR diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs index a886736b..dd5d7673 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs @@ -229,7 +229,7 @@ module Operations = type MxmBenchmarks4Float32MultiplicationOnly() = inherit MxmBenchmarksMultiplicationOnly( - (Matrix.mxm Operations.add Operations.mult), + (Matrix.SpGeMM.masked Operations.add Operations.mult), float32, (fun _ -> Utils.nextSingle (System.Random())), (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) @@ -241,7 +241,7 @@ type MxmBenchmarks4Float32MultiplicationOnly() = type MxmBenchmarks4Float32WithTransposing() = inherit MxmBenchmarksWithTransposing( - (Matrix.mxm Operations.add Operations.mult), + (Matrix.SpGeMM.masked Operations.add Operations.mult), float32, (fun _ -> Utils.nextSingle (System.Random())), (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) @@ -253,7 +253,7 @@ type MxmBenchmarks4Float32WithTransposing() = type MxmBenchmarks4BoolMultiplicationOnly() = inherit MxmBenchmarksMultiplicationOnly( - (Matrix.mxm Operations.logicalOr Operations.logicalAnd), + (Matrix.SpGeMM.masked Operations.logicalOr Operations.logicalAnd), (fun _ -> true), (fun _ -> true), (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) @@ -265,7 +265,7 @@ type MxmBenchmarks4BoolMultiplicationOnly() = type MxmBenchmarks4BoolWithTransposing() = inherit MxmBenchmarksWithTransposing( - (Matrix.mxm Operations.logicalOr Operations.logicalAnd), + (Matrix.SpGeMM.masked Operations.logicalOr Operations.logicalAnd), (fun _ -> true), (fun _ -> true), (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) @@ -277,7 +277,7 @@ type MxmBenchmarks4BoolWithTransposing() = type MxmBenchmarks4Float32MultiplicationOnlyWithZerosFilter() = inherit MxmBenchmarksMultiplicationOnly( - (Matrix.mxm Operations.addWithFilter Operations.mult), + (Matrix.SpGeMM.masked Operations.addWithFilter Operations.mult), float32, (fun _ -> Utils.nextSingle (System.Random())), (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) @@ -289,7 +289,7 @@ type MxmBenchmarks4Float32MultiplicationOnlyWithZerosFilter() = type MxmBenchmarks4Float32WithTransposingWithZerosFilter() = inherit MxmBenchmarksWithTransposing( - (Matrix.mxm Operations.addWithFilter Operations.mult), + (Matrix.SpGeMM.masked Operations.addWithFilter Operations.mult), float32, (fun _ -> Utils.nextSingle (System.Random())), (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs index 378a2036..97d75077 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs @@ -159,13 +159,13 @@ type VectorEWiseBenchmarksWithDataTransfer<'elem when 'elem : struct>( type VectorEWiseBenchmarks4FloatSparseWithoutDataTransfer() = inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSum), + (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), VectorGenerator.floatPair Sparse) type VectorEWiseBenchmarks4Int32SparseWithoutDataTransfer() = inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSum), + (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), VectorGenerator.intPair Sparse) /// General @@ -173,13 +173,13 @@ type VectorEWiseBenchmarks4Int32SparseWithoutDataTransfer() = type VectorEWiseGeneralBenchmarks4FloatSparseWithoutDataTransfer() = inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSum), + (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), VectorGenerator.floatPair Sparse) type VectorEWiseGeneralBenchmarks4Int32SparseWithoutDataTransfer() = inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSum), + (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), VectorGenerator.intPair Sparse) /// With data transfer @@ -187,13 +187,13 @@ type VectorEWiseGeneralBenchmarks4Int32SparseWithoutDataTransfer() = type VectorEWiseBenchmarks4FloatSparseWithDataTransfer() = inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSum), + (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), VectorGenerator.floatPair Sparse) type VectorEWiseBenchmarks4Int32SparseWithDataTransfer() = inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSum), + (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), VectorGenerator.intPair Sparse) /// General with data transfer @@ -201,11 +201,11 @@ type VectorEWiseBenchmarks4Int32SparseWithDataTransfer() = type VectorEWiseGeneralBenchmarks4FloatSparseWithDataTransfer() = inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSum), + (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), VectorGenerator.floatPair Sparse) type VectorEWiseGeneralBenchmarks4Int32SparseWithDataTransfer() = inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSum), + (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), VectorGenerator.intPair Sparse) diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs b/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs index 570688cc..4dbb9ba4 100644 --- a/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs +++ b/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs @@ -67,7 +67,7 @@ module BFS = not <| (containsNonZero queue front).ToHostAndFree queue - front.Dispose queue + front.Free queue levels | _ -> failwith "Not implemented" diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index aace2a48..5db339a7 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -5,6 +5,8 @@ open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Quotes module ClArray = let init (clContext: ClContext) workGroupSize (initializer: Expr 'a>) = @@ -62,7 +64,7 @@ module ClArray = outputArray - let zeroCreate (clContext: ClContext) workGroupSize = + let zeroCreate<'a> (clContext: ClContext) workGroupSize = let create = create clContext workGroupSize @@ -129,18 +131,20 @@ module ClArray = outputArray - let getUniqueBitmap (clContext: ClContext) workGroupSize = + let private getUniqueBitmapGeneral predicate (clContext: ClContext) workGroupSize = let getUniqueBitmap = <@ fun (ndRange: Range1D) (inputArray: ClArray<'a>) inputLength (isUniqueBitmap: ClArray) -> - let i = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if i < inputLength - 1 - && inputArray.[i] = inputArray.[i + 1] then - isUniqueBitmap.[i] <- 0 - else - isUniqueBitmap.[i] <- 1 @> + if gid < inputLength then + let isUnique = (%predicate) gid inputLength inputArray // brahma error + + if isUnique then + isUniqueBitmap.[gid] <- 1 + else + isUniqueBitmap.[gid] <- 0 @> let kernel = clContext.Compile(getUniqueBitmap) @@ -162,6 +166,16 @@ module ClArray = bitmap + let getUniqueBitmapFirstOccurrence clContext = + getUniqueBitmapGeneral + <| Predicates.firstOccurrence () + <| clContext + + let getUniqueBitmapLastOccurrence clContext = + getUniqueBitmapGeneral + <| Predicates.lastOccurrence () + <| clContext + ///Remove duplicates form the given array. ///Computational context ///Should be a power of 2 and greater than 1. @@ -169,9 +183,10 @@ module ClArray = let removeDuplications (clContext: ClContext) workGroupSize = let scatter = - Scatter.runInplace clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize - let getUniqueBitmap = getUniqueBitmap clContext workGroupSize + let getUniqueBitmap = + getUniqueBitmapLastOccurrence clContext workGroupSize let prefixSumExclude = PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize @@ -291,41 +306,167 @@ module ClArray = resultArray + let getUniqueBitmap2General<'a when 'a: equality> getUniqueBitmap (clContext: ClContext) workGroupSize = + + let map = + map2 clContext workGroupSize <@ fun x y -> x ||| y @> + + let firstGetBitmap = getUniqueBitmap clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (firstArray: ClArray<'a>) (secondArray: ClArray<'a>) -> + let firstBitmap = + firstGetBitmap processor DeviceOnly firstArray + + let secondBitmap = + firstGetBitmap processor DeviceOnly secondArray + + let result = + map processor allocationMode firstBitmap secondBitmap + + firstBitmap.Free processor + secondBitmap.Free processor + + result + + let getUniqueBitmap2FirstOccurrence clContext = + getUniqueBitmap2General getUniqueBitmapFirstOccurrence clContext + + let getUniqueBitmap2LastOccurrence clContext = + getUniqueBitmap2General getUniqueBitmapLastOccurrence clContext + + let private assignOption (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b option>) = + + let assign = + <@ fun (ndRange: Range1D) length (values: ClArray<'a>) (positions: ClArray) (result: ClArray<'b>) resultLength -> + + let gid = ndRange.GlobalID0 + + if gid < length then + let position = positions.[gid] + let value = values.[gid] + + // seems like scatter (option scatter) ??? + if 0 <= position && position < resultLength then + match (%op) value with + | Some value -> result.[position] <- value + | None -> () @> + + let kernel = clContext.Compile assign + + fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (positions: ClArray) (result: ClArray<'b>) -> + + if values.Length <> positions.Length then + failwith "lengths must be the same" + + let ndRange = + Range1D.CreateValid(values.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange values.Length values positions result result.Length) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + let choose<'a, 'b> (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b option>) = let getBitmap = map<'a, int> clContext workGroupSize <| Map.chooseBitmap predicate - let getOptionValues = - map<'a, 'b option> clContext workGroupSize predicate - - let getValues = - map<'b option, 'b> clContext workGroupSize - <| Map.optionToValueOrZero Unchecked.defaultof<'b> - let prefixSum = - PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize + PrefixSum.standardExcludeInplace clContext workGroupSize - let scatter = - Scatter.runInplace clContext workGroupSize + let assignValues = + assignOption clContext workGroupSize predicate - fun (processor: MailboxProcessor<_>) allocationMode (array: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) allocationMode (sourceValues: ClArray<'a>) -> - let positions = getBitmap processor DeviceOnly array + let positions = + getBitmap processor DeviceOnly sourceValues let resultLength = - (prefixSum processor positions 0) + (prefixSum processor positions) .ToHostAndFree(processor) - let optionValues = - getOptionValues processor DeviceOnly array + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + assignValues processor sourceValues positions result + + result + + let assignOption2 (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b -> 'c option>) = + + let assign = + <@ fun (ndRange: Range1D) length (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (positions: ClArray) (result: ClArray<'c>) resultLength -> + + let gid = ndRange.GlobalID0 + + if gid < length then + let position = positions.[gid] + + let leftValue = firstValues.[gid] + let rightValue = secondValues.[gid] + + // seems like scatter2 (option scatter2) ??? + if 0 <= position && position < resultLength then + match (%op) leftValue rightValue with + | Some value -> result.[position] <- value + | None -> () @> + + let kernel = clContext.Compile assign + + fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (positions: ClArray) (result: ClArray<'c>) -> + + if firstValues.Length <> secondValues.Length + || secondValues.Length <> positions.Length then + failwith "lengths must be the same" - let values = - getValues processor DeviceOnly optionValues + let ndRange = + Range1D.CreateValid(firstValues.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + firstValues.Length + firstValues + secondValues + positions + result + result.Length) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + let choose2 (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b -> 'c option>) = + let getBitmap = + map2<'a, 'b, int> clContext workGroupSize + <| Map.chooseBitmap2 predicate + + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize + + let assignValues = + assignOption2 clContext workGroupSize predicate + + fun (processor: MailboxProcessor<_>) allocationMode (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) -> + + let positions = + getBitmap processor DeviceOnly firstValues secondValues + + let resultLength = + (prefixSum processor positions) + .ToHostAndFree(processor) let result = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - scatter processor positions values result + assignValues processor firstValues secondValues positions result result diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs new file mode 100644 index 00000000..c4f1fa19 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -0,0 +1,74 @@ +namespace GraphBLAS.FSharp.Backend.Common + +open Brahma.FSharp + +module internal Gather = + let runInit positionMap (clContext: ClContext) workGroupSize = + + let gather = + <@ fun (ndRange: Range1D) valuesLength (values: ClArray<'a>) (outputArray: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + + if gid < valuesLength then + let position = (%positionMap) gid + + if position >= 0 && position < valuesLength then + outputArray.[gid] <- values.[position] @> + + let program = clContext.Compile gather + + fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> + + let kernel = program.GetKernel() + + let ndRange = + Range1D.CreateValid(outputArray.Length, workGroupSize) + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange values.Length values outputArray)) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + + /// + /// Creates a new array obtained from positions replaced with values from the given array at these positions (indices). + /// + /// + /// + /// let positions = [| 2; 0; 2; 1 |] + /// let array = [| 1.4; 2.5; 3.6 |] + /// ... + /// > val result = [| 3.6; 1.4; 3.6; 2.5 |] + /// + /// + let run (clContext: ClContext) workGroupSize = + + let gather = + <@ fun (ndRange: Range1D) positionsLength valuesLength (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + + if gid < positionsLength then + let position = positions.[gid] + + if position >= 0 && position < valuesLength then + outputArray.[gid] <- values.[position] @> + + let program = clContext.Compile gather + + fun (processor: MailboxProcessor<_>) (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> + + if positions.Length <> outputArray.Length then + failwith "Lengths must be the same" + + let kernel = program.GetKernel() + + let ndRange = + Range1D.CreateValid(positions.Length, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange positions.Length values.Length positions values outputArray) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index a3d54dec..4f51cb93 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -1,8 +1,72 @@ namespace GraphBLAS.FSharp.Backend.Common open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Quotes module internal Scatter = + let private general<'a> predicate (clContext: ClContext) workGroupSize = + + let run = + <@ fun (ndRange: Range1D) (positions: ClArray) (positionsLength: int) (values: ClArray<'a>) (result: ClArray<'a>) (resultLength: int) -> + + let gid = ndRange.GlobalID0 + + if gid < positionsLength then + // positions lengths == values length + let predicateResult = + (%predicate) gid positionsLength positions + + let position = positions.[gid] + + if predicateResult + && 0 <= position + && position < resultLength then + + result.[positions.[gid]] <- values.[gid] @> + + let program = clContext.Compile(run) + + fun (processor: MailboxProcessor<_>) (positions: ClArray) (values: ClArray<'a>) (result: ClArray<'a>) -> + + if positions.Length <> values.Length then + failwith "Lengths must be the same" + + let positionsLength = positions.Length + + let ndRange = + Range1D.CreateValid(positionsLength, workGroupSize) + + let kernel = program.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange positions positionsLength values result result.Length) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + /// + /// Creates a new array from the given one where it is indicated by the array of positions at which position in the new array + /// should be a value from the given one. + /// + /// + /// Every element of the positions array must not be less than the previous one. + /// If there are several elements with the same indices, the FIRST one of them will be at the common index. + /// If index is out of bounds, the value will be ignored. + /// + /// + /// + /// let positions = [| 0; 0; 1; 1; 1; 2; 3; 3; 4 |] + /// let values = [| 1.9; 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; 8.2; 9.1 |] + /// run clContext 32 processor positions values result + /// ... + /// > val result = [| 1,9; 3.7; 6.4; 7.3; 9.1 |] + /// + /// + let firstOccurrence clContext = + general + <| Predicates.firstOccurrence () + <| clContext /// /// Creates a new array from the given one where it is indicated by the array of positions at which position in the new array @@ -10,38 +74,46 @@ module internal Scatter = /// /// /// Every element of the positions array must not be less than the previous one. - /// If there are several elements with the same indices, the last one of them will be at the common index. + /// If there are several elements with the same indices, the LAST one of them will be at the common index. /// If index is out of bounds, the value will be ignored. /// /// /// /// let positions = [| 0; 0; 1; 1; 1; 2; 3; 3; 4 |] /// let values = [| 1.9; 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; 8.2; 9.1 |] - /// let result = run clContext 32 processor positions values result + /// run clContext 32 processor positions values result /// ... /// > val result = [| 2.8; 5.5; 6.4; 8.2; 9.1 |] /// /// - let runInplace<'a> (clContext: ClContext) workGroupSize = + let lastOccurrence clContext = + general + <| Predicates.lastOccurrence () + <| clContext + + let private generalInit<'a> predicate valueMap (clContext: ClContext) workGroupSize = let run = - <@ fun (ndRange: Range1D) (positions: ClArray) (positionsLength: int) (values: ClArray<'a>) (result: ClArray<'a>) (resultLength: int) -> + <@ fun (ndRange: Range1D) (positions: ClArray) (positionsLength: int) (result: ClArray<'a>) (resultLength: int) -> + + let gid = ndRange.GlobalID0 + + if gid < positionsLength then + // positions lengths == values length + let predicateResult = + (%predicate) gid positionsLength positions - let i = ndRange.GlobalID0 + let position = positions.[gid] - if i < positionsLength then - let index = positions.[i] + if predicateResult + && 0 <= position + && position < resultLength then - if 0 <= index && index < resultLength then - if i < positionsLength - 1 then - if index <> positions.[i + 1] then - result.[index] <- values.[i] - else - result.[index] <- values.[i] @> + result.[positions.[gid]] <- (%valueMap) gid @> let program = clContext.Compile(run) - fun (processor: MailboxProcessor<_>) (positions: ClArray) (values: ClArray<'a>) (result: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) (positions: ClArray) (result: ClArray<'a>) -> let positionsLength = positions.Length @@ -51,8 +123,55 @@ module internal Scatter = let kernel = program.GetKernel() processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange positions positionsLength values result result.Length) + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange positions positionsLength result result.Length) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + /// + /// Creates a new array from the given one where it is indicated by the array of positions at which position in the new array + /// should be a values obtained by applying the mapping to the global id. + /// + /// + /// Every element of the positions array must not be less than the previous one. + /// If there are several elements with the same indices, the FIRST one of them will be at the common index. + /// If index is out of bounds, the value will be ignored. + /// + /// + /// + /// let positions = [| 0; 0; 1; 1; 1; 2; 3; 3; 4 |] + /// let valueMap = id + /// run clContext 32 processor positions values result + /// ... + /// > val result = [| 0; 2; 5; 6; 8 |] + /// + /// + /// Maps global id to a value + let initFirsOccurrence<'a> valueMap = + generalInit<'a> + <| Predicates.firstOccurrence () + <| valueMap + + /// + /// Creates a new array from the given one where it is indicated by the array of positions at which position in the new array + /// should be a values obtained by applying the mapping to the global id. + /// + /// + /// Every element of the positions array must not be less than the previous one. + /// If there are several elements with the same indices, the LAST one of them will be at the common index. + /// If index is out of bounds, the value will be ignored. + /// + /// + /// + /// let positions = [| 0; 0; 1; 1; 1; 2; 3; 3; 4 |] + /// let valueMap = id + /// run clContext 32 processor positions values result + /// ... + /// > val result = [| 1; 4; 5; 7; 8 |] + /// + /// + /// Maps global id to a value + let initLastOccurrence<'a> valueMap = + generalInit<'a> + <| Predicates.lastOccurrence () + <| valueMap diff --git a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs index d2055b6e..6bc24183 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs @@ -163,7 +163,7 @@ module Radix = fun (processor: MailboxProcessor<_>) (keys: Indices) -> if keys.Length <= 1 then - keys + copy processor DeviceOnly keys // TODO(allocation mode) else let firstKeys = copy processor DeviceOnly keys @@ -194,6 +194,7 @@ module Radix = localOffset.Free processor shift.Free processor + (snd pair).Free processor fst pair let standardRunKeysOnly clContext workGroupSize = @@ -264,25 +265,28 @@ module Radix = let scatterByKey = scatterByKey clContext workGroupSize mask - fun (processor: MailboxProcessor<_>) (keys: Indices) (values: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) allocationMode (keys: Indices) (values: ClArray<'a>) -> if values.Length <> keys.Length then failwith "Mismatch of key lengths and value. Lengths must be the same" if values.Length <= 1 then - values + dataCopy processor allocationMode values else let firstKeys = copy processor DeviceOnly keys let secondKeys = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys.Length) - let secondValues = dataCopy processor DeviceOnly values + let firstValues = dataCopy processor DeviceOnly values + + let secondValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values.Length) let workGroupCount = clContext.CreateClCell((keys.Length - 1) / workGroupSize + 1) let mutable keysPair = (firstKeys, secondKeys) - let mutable valuesPair = (values, secondValues) + let mutable valuesPair = (firstValues, secondValues) let swap (x, y) = y, x // compute bound of iterations diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index bbfa8af9..bdf1840d 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -6,6 +6,7 @@ open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClCell module Reduce = /// @@ -470,3 +471,285 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) reducedKeys, reducedValues + + module ByKey2D = + /// + /// Reduce an array of values by 2D keys using a single work item. + /// + /// ClContext. + /// Work group size. + /// Operation for reducing values. + /// + /// The length of the result must be calculated in advance. + /// + let sequential (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + + let kernel = + <@ fun (ndRange: Range1D) length (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (secondReducedKeys: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid = 0 then + let mutable firstCurrentKey = firstKeys.[0] + let mutable secondCurrentKey = secondKeys.[0] + + let mutable segmentResult = values.[0] + let mutable segmentCount = 0 + + for i in 1 .. length - 1 do + if firstCurrentKey = firstKeys.[i] + && secondCurrentKey = secondKeys.[i] then + segmentResult <- (%reduceOp) segmentResult values.[i] + else + reducedValues.[segmentCount] <- segmentResult + + firstReducedKeys.[segmentCount] <- firstCurrentKey + secondReducedKeys.[segmentCount] <- secondCurrentKey + + segmentCount <- segmentCount + 1 + firstCurrentKey <- firstKeys.[i] + secondCurrentKey <- secondKeys.[i] + segmentResult <- values.[i] + + firstReducedKeys.[segmentCount] <- firstCurrentKey + secondReducedKeys.[segmentCount] <- secondCurrentKey + + reducedValues.[segmentCount] <- segmentResult @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> + + let reducedValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let firstReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let secondReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + firstKeys.Length + firstKeys + secondKeys + values + reducedValues + firstReducedKeys + secondReducedKeys) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + firstReducedKeys, secondReducedKeys, reducedValues + + /// + /// Reduces values by key. Each segment is reduced by one work item. + /// + /// ClContext. + /// Work group size. + /// Operation for reducing values. + /// + /// The length of the result must be calculated in advance. + /// + let segmentSequential<'a> (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + + let kernel = + <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (secondReducedKeys: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < uniqueKeyCount then + let startPosition = offsets.[gid] + + let firstSourceKey = firstKeys.[startPosition] + let secondSourceKey = secondKeys.[startPosition] + + let mutable sum = values.[startPosition] + + let mutable currentPosition = startPosition + 1 + + while currentPosition < keysLength + && firstSourceKey = firstKeys.[currentPosition] + && secondSourceKey = secondKeys.[currentPosition] do + + sum <- (%reduceOp) sum values.[currentPosition] + currentPosition <- currentPosition + 1 + + reducedValues.[gid] <- sum + firstReducedKeys.[gid] <- firstSourceKey + secondReducedKeys.[gid] <- secondSourceKey @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> + + let reducedValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let firstReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let secondReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + firstKeys.Length + offsets + firstKeys + secondKeys + values + reducedValues + firstReducedKeys + secondReducedKeys) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + firstReducedKeys, secondReducedKeys, reducedValues + + /// + /// Reduces values by key. Each segment is reduced by one work item. + /// + /// ClContext. + /// Work group size. + /// Operation for reducing values. + /// + /// The length of the result must be calculated in advance. + /// + let segmentSequentialOption<'a> (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a option>) = + + let kernel = + <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (secondReducedKeys: ClArray) (resultPositions: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < uniqueKeyCount then + let startPosition = offsets.[gid] + + let firstSourceKey = firstKeys.[startPosition] + let secondSourceKey = secondKeys.[startPosition] + + let mutable sum = Some values.[startPosition] + + let mutable currentPosition = startPosition + 1 + + while currentPosition < keysLength + && firstSourceKey = firstKeys.[currentPosition] + && secondSourceKey = secondKeys.[currentPosition] do + + match sum with + | Some value -> + let result = + ((%reduceOp) value values.[currentPosition]) // brahma error + + sum <- result + | None -> sum <- Some values.[currentPosition] + + currentPosition <- currentPosition + 1 + + match sum with + | Some value -> + reducedValues.[gid] <- value + resultPositions.[gid] <- 1 + | None -> resultPositions.[gid] <- 0 + + firstReducedKeys.[gid] <- firstSourceKey + secondReducedKeys.[gid] <- secondSourceKey @> + + let kernel = clContext.Compile kernel + + let scatterData = + Scatter.lastOccurrence clContext workGroupSize + + let scatterIndices = + Scatter.lastOccurrence clContext workGroupSize + + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> + + let reducedValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let firstReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let secondReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + let resultPositions = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + firstKeys.Length + offsets + firstKeys + secondKeys + values + reducedValues + firstReducedKeys + secondReducedKeys + resultPositions) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + let resultLength = + (prefixSum processor resultPositions) + .ToHostAndFree processor + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + scatterData processor resultPositions reducedValues resultValues + + reducedValues.Free processor + + let resultFirstKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + scatterIndices processor resultPositions firstReducedKeys resultFirstKeys + + firstReducedKeys.Free processor + + let resultSecondKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + scatterIndices processor resultPositions secondReducedKeys resultSecondKeys + + secondReducedKeys.Free processor + + resultPositions.Free processor + + resultFirstKeys, resultSecondKeys, resultValues diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index b8ca8ba0..74797513 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -31,18 +31,19 @@ + - + + - @@ -54,21 +55,6 @@ - - - - - diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs index 5a606ad3..63cd4fcc 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs @@ -8,49 +8,13 @@ open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClCell module Matrix = - let private expandRowPointers (clContext: ClContext) workGroupSize = - - let expandRowPointers = - <@ fun (ndRange: Range1D) (rowPointers: ClArray) (rowCount: int) (rows: ClArray) -> - - let i = ndRange.GlobalID0 - - if i < rowCount then - let rowPointer = rowPointers.[i] - - if rowPointer <> rowPointers.[i + 1] then - rows.[rowPointer] <- i @> - - let program = clContext.Compile(expandRowPointers) - - let create = - ClArray.zeroCreate clContext workGroupSize - - let scan = - PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (rowPointers: ClArray) nnz rowCount -> - - let rows = create processor allocationMode nnz - - let kernel = program.GetKernel() - - let ndRange = - Range1D.CreateValid(rowCount, workGroupSize) - - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange rowPointers rowCount rows)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) - - let total = scan processor rows 0 - processor.Post(Msg.CreateFreeMsg(total)) - - rows - let toCOO (clContext: ClContext) workGroupSize = let prepare = - expandRowPointers clContext workGroupSize + Common.expandRowPointers clContext workGroupSize let copy = ClArray.copy clContext workGroupSize @@ -75,7 +39,7 @@ module Matrix = let toCOOInplace (clContext: ClContext) workGroupSize = let prepare = - expandRowPointers clContext workGroupSize + Common.expandRowPointers clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> let rows = @@ -140,16 +104,39 @@ module Matrix = |> transposeInplace queue |> toCSRInplace queue allocationMode - let spgemmCSC - (clContext: ClContext) - workGroupSize - (opAdd: Expr<'c -> 'c -> 'c option>) - (opMul: Expr<'a -> 'b -> 'c option>) - = + module SpGeMM = + let masked + (clContext: ClContext) + workGroupSize + (opAdd: Expr<'c -> 'c -> 'c option>) + (opMul: Expr<'a -> 'b -> 'c option>) + = + + let run = + SpGeMM.Masked.run clContext workGroupSize opAdd opMul + + fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> + + run queue matrixLeft matrixRight mask + + let expand + (clContext: ClContext) + workGroupSize + (opAdd: Expr<'c -> 'c -> 'c option>) + (opMul: Expr<'a -> 'b -> 'c option>) + = + + let run = + SpGeMM.Expand.run clContext workGroupSize opAdd opMul - let run = - SpGEMM.run clContext workGroupSize opAdd opMul + fun (queue: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> + let values, columns, rows = + run queue allocationMode leftMatrix rightMatrix - run queue matrixLeft matrixRight mask + { COO.Context = clContext + ColumnCount = rightMatrix.ColumnCount + RowCount = leftMatrix.RowCount + Values = values + Columns = columns + Rows = rows } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs new file mode 100644 index 00000000..37cefdce --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -0,0 +1,333 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Common.Sort +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClCell +open FSharp.Quotations + +type Indices = ClArray + +type Values<'a> = ClArray<'a> + +module Expand = + let getSegmentPointers (clContext: ClContext) workGroupSize = + + let subtract = + ClArray.map2 clContext workGroupSize Map.subtraction + + let idGather = + Gather.runInit Map.id clContext workGroupSize + + let incGather = + Gather.runInit Map.inc clContext workGroupSize + + let gather = Gather.run clContext workGroupSize + + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + + let positionsLength = rightMatrix.RowPointers.Length - 1 + + // extract first rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers + // (right matrix row pointers without last item) + let firstPointers = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) + + idGather processor rightMatrix.RowPointers firstPointers + + // extract last rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers + // (right matrix row pointers without first item) + let lastPointers = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) + + incGather processor rightMatrix.RowPointers lastPointers + + // subtract + let rightMatrixRowsLengths = + subtract processor DeviceOnly lastPointers firstPointers + + firstPointers.Free processor + lastPointers.Free processor + + let segmentsLengths = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrix.Columns.Length) + + // extract needed lengths by left matrix nnz + gather processor leftMatrix.Columns rightMatrixRowsLengths segmentsLengths + + rightMatrixRowsLengths.Free processor + + // compute pointers + let length = + (prefixSum processor segmentsLengths) + .ToHostAndFree processor + + length, segmentsLengths + + let multiply (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b -> 'c option>) = + let getBitmap = + ClArray.map2<'a, 'b, int> clContext workGroupSize + <| Map.chooseBitmap2 predicate + + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize + + let assignValues = + ClArray.assignOption2 clContext workGroupSize predicate + + let scatter = + Scatter.lastOccurrence clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (columns: Indices) (rows: Indices) -> + + let positions = + getBitmap processor DeviceOnly firstValues secondValues + + let resultLength = + (prefixSum processor positions) + .ToHostAndFree(processor) + + let resultColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + scatter processor positions columns resultColumns + + let resultRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + scatter processor positions rows resultRows + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + assignValues processor firstValues secondValues positions resultValues + + resultValues, resultColumns, resultRows + + let expand (clContext: ClContext) workGroupSize = + + let idScatter = + Scatter.initLastOccurrence Map.id clContext workGroupSize + + let scatter = + Scatter.lastOccurrence clContext workGroupSize + + let zeroCreate = + ClArray.zeroCreate clContext workGroupSize + + let maxPrefixSum = + PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize + + let create = ClArray.create clContext workGroupSize + + let gather = Gather.run clContext workGroupSize + + let segmentPrefixSum = + PrefixSum.ByKey.sequentialInclude clContext workGroupSize <@ (+) @> 0 + + let removeDuplicates = + ClArray.removeDuplications clContext workGroupSize + + let expandRowPointers = + Common.expandRowPointers clContext workGroupSize + + let leftMatrixGather = Gather.run clContext workGroupSize + + let rightMatrixGather = Gather.run clContext workGroupSize + + fun (processor: MailboxProcessor<_>) lengths (segmentsPointers: Indices) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + + // Compute left matrix positions + let leftMatrixPositions = zeroCreate processor DeviceOnly lengths + + idScatter processor segmentsPointers leftMatrixPositions + + (maxPrefixSum processor leftMatrixPositions 0) + .Free processor + + // Compute right matrix positions + let rightMatrixPositions = create processor DeviceOnly lengths 1 + + let requiredRightMatrixPointers = + zeroCreate processor DeviceOnly leftMatrix.Columns.Length + + gather processor leftMatrix.Columns rightMatrix.RowPointers requiredRightMatrixPointers + + scatter processor segmentsPointers requiredRightMatrixPointers rightMatrixPositions + + requiredRightMatrixPointers.Free processor + + // another way to get offsets ??? + let offsets = + removeDuplicates processor segmentsPointers + + segmentPrefixSum processor offsets.Length rightMatrixPositions leftMatrixPositions offsets + + offsets.Free processor + + // compute columns + let columns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + gather processor rightMatrixPositions rightMatrix.Columns columns + + // compute rows + let leftMatrixRows = + expandRowPointers processor DeviceOnly leftMatrix.RowPointers leftMatrix.NNZ leftMatrix.RowCount + + let rows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + gather processor leftMatrixPositions leftMatrixRows rows + + leftMatrixRows.Free processor + + // compute left matrix values + let leftMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + leftMatrixGather processor leftMatrixPositions leftMatrix.Values leftMatrixValues + + leftMatrixPositions.Free processor + + // compute right matrix values + let rightMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + rightMatrixGather processor rightMatrixPositions rightMatrix.Values rightMatrixValues + + rightMatrixPositions.Free processor + + // left, right matrix values, columns and rows indices + leftMatrixValues, rightMatrixValues, columns, rows + + let sortByColumnsAndRows (clContext: ClContext) workGroupSize = + + let sortByKeyIndices = + Radix.runByKeysStandard clContext workGroupSize + + let sortByKeyValues = + Radix.runByKeysStandard clContext workGroupSize + + let sortKeys = + Radix.standardRunKeysOnly clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> + // sort by columns + let valuesSortedByColumns = + sortByKeyValues processor DeviceOnly columns values + + let rowsSortedByColumns = + sortByKeyIndices processor DeviceOnly columns rows + + let sortedColumns = sortKeys processor columns + + // sort by rows + let valuesSortedByRows = + sortByKeyValues processor DeviceOnly rowsSortedByColumns valuesSortedByColumns + + let columnsSortedByRows = + sortByKeyIndices processor DeviceOnly rowsSortedByColumns sortedColumns + + let sortedRows = sortKeys processor rowsSortedByColumns + + valuesSortedByColumns.Free processor + rowsSortedByColumns.Free processor + sortedColumns.Free processor + + valuesSortedByRows, columnsSortedByRows, sortedRows + + let reduce (clContext: ClContext) workGroupSize opAdd = + + let reduce = + Reduce.ByKey2D.segmentSequentialOption clContext workGroupSize opAdd + + let getUniqueBitmap = + ClArray.getUniqueBitmap2LastOccurrence clContext workGroupSize + + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize + + let idScatter = + Scatter.initFirsOccurrence Map.id clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> + + let bitmap = + getUniqueBitmap processor DeviceOnly columns rows + + let uniqueKeysCount = + (prefixSum processor bitmap) + .ToHostAndFree processor + + let offsets = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) + + idScatter processor bitmap offsets + + bitmap.Free processor + + let reducedColumns, reducedRows, reducedValues = // by size variance TODO() + reduce processor allocationMode uniqueKeysCount offsets columns rows values + + offsets.Free processor + + reducedValues, reducedColumns, reducedRows + + let run (clContext: ClContext) workGroupSize opAdd opMul = + + let getSegmentPointers = + getSegmentPointers clContext workGroupSize + + let expand = expand clContext workGroupSize + + let multiply = multiply clContext workGroupSize opMul + + let sort = + sortByColumnsAndRows clContext workGroupSize + + let reduce = reduce clContext workGroupSize opAdd + + fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + + let length, segmentPointers = + getSegmentPointers processor leftMatrix rightMatrix + + // expand + let leftMatrixValues, rightMatrixValues, columns, rows = + expand processor length segmentPointers leftMatrix rightMatrix + + // multiply + let resultValues, resultColumns, resultRows = + multiply processor leftMatrixValues rightMatrixValues columns rows + + leftMatrixValues.Free processor + rightMatrixValues.Free processor + columns.Free processor + rows.Free processor + + // sort + let sortedValues, sortedColumns, sortedRows = + sort processor resultValues resultColumns resultRows + + resultValues.Free processor + resultColumns.Free processor + resultRows.Free processor + + // addition + let reducedValues, reducedColumns, reducedRows = + reduce processor allocationMode sortedValues sortedColumns sortedRows + + sortedValues.Free processor + sortedColumns.Free processor + sortedRows.Free processor + + reducedValues, reducedColumns, reducedRows diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Masked.fs similarity index 96% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Masked.fs index a7b45ebc..b4f3fcbd 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Masked.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Backend.Matrix.CSR +namespace GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM open GraphBLAS.FSharp.Backend.Common open Brahma.FSharp @@ -8,7 +8,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell -module internal SpGEMM = +module internal Masked = let private calculate (context: ClContext) workGroupSize @@ -151,8 +151,11 @@ module internal SpGEMM = let calculate = calculate context workGroupSize opAdd opMul - let scatter = Scatter.runInplace context workGroupSize - let scatterData = Scatter.runInplace context workGroupSize + let scatter = + Scatter.lastOccurrence context workGroupSize + + let scatterData = + Scatter.lastOccurrence context workGroupSize let scanInplace = PrefixSum.standardExcludeInplace context workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs index 1300b3cb..ea26fd7f 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs @@ -11,10 +11,10 @@ module Common = let setPositions<'a when 'a: struct> (clContext: ClContext) workGroupSize = let indicesScatter = - Scatter.runInplace clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let valuesScatter = - Scatter.runInplace clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let sum = PrefixSum.standardExcludeInplace clContext workGroupSize @@ -40,3 +40,40 @@ module Common = valuesScatter processor positions allValues resultValues resultRows, resultColumns, resultValues, resultLength + + let expandRowPointers (clContext: ClContext) workGroupSize = + + let expandRowPointers = + <@ fun (ndRange: Range1D) (rowPointers: ClArray) (rowCount: int) (rows: ClArray) -> + + let i = ndRange.GlobalID0 + + if i < rowCount then + let rowPointer = rowPointers.[i] + + if rowPointer <> rowPointers.[i + 1] then + rows.[rowPointer] <- i @> + + let program = clContext.Compile expandRowPointers + + let create = + ClArray.zeroCreate clContext workGroupSize + + let scan = + PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (rowPointers: ClArray) nnz rowCount -> + + let rows = create processor allocationMode nnz + + let kernel = program.GetKernel() + + let ndRange = + Range1D.CreateValid(rowCount, workGroupSize) + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange rowPointers rowCount rows)) + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + (scan processor rows 0).Free processor + + rows diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 3fac746a..7b93b433 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -337,17 +337,35 @@ module Matrix = Values = copyData processor allocationMode m.Values } |> ClMatrix.CSR - let mxm - (opAdd: Expr<'c -> 'c -> 'c option>) - (opMul: Expr<'a -> 'b -> 'c option>) - (clContext: ClContext) - workGroupSize - = - - let runCSRnCSC = - CSR.Matrix.spgemmCSC clContext workGroupSize opAdd opMul - - fun (queue: MailboxProcessor<_>) (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) (mask: ClMatrix<_>) -> - match matrix1, matrix2, mask with - | ClMatrix.CSR m1, ClMatrix.CSC m2, ClMatrix.COO mask -> runCSRnCSC queue m1 m2 mask |> ClMatrix.COO - | _ -> failwith "Matrix formats are not matching" + module SpGeMM = + let masked + (opAdd: Expr<'c -> 'c -> 'c option>) + (opMul: Expr<'a -> 'b -> 'c option>) + (clContext: ClContext) + workGroupSize + = + + let runCSRnCSC = + CSR.Matrix.SpGeMM.masked clContext workGroupSize opAdd opMul + + fun (queue: MailboxProcessor<_>) (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) (mask: ClMatrix<_>) -> + match matrix1, matrix2, mask with + | ClMatrix.CSR m1, ClMatrix.CSC m2, ClMatrix.COO mask -> runCSRnCSC queue m1 m2 mask |> ClMatrix.COO + | _ -> failwith "Matrix formats are not matching" + + let expand + (clContext: ClContext) + workGroupSize + (opAdd: Expr<'c -> 'c -> 'c option>) + (opMul: Expr<'a -> 'b -> 'c option>) + = + + let run = + CSR.Matrix.SpGeMM.expand clContext workGroupSize opAdd opMul + + fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> + match leftMatrix, rightMatrix with + | ClMatrix.CSR leftMatrix, ClMatrix.CSR rightMatrix -> + run processor allocationMode leftMatrix rightMatrix + |> ClMatrix.COO + | _ -> failwith "Matrix formats are not matching" diff --git a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs index d7a6c784..29aad544 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs @@ -4,7 +4,7 @@ open Brahma.FSharp module ArraysExtensions = type ClArray<'a> with - member this.Dispose(q: MailboxProcessor) = + member this.FreeAndWait(q: MailboxProcessor) = q.Post(Msg.CreateFreeMsg this) q.PostAndReply(Msg.MsgNotifyMe) diff --git a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs index 957c5fe3..1603a010 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs @@ -23,6 +23,8 @@ module ClMatrix = q.Post(Msg.CreateFreeMsg<_>(this.RowPointers)) q.PostAndReply(Msg.MsgNotifyMe) + member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.NNZ = this.Values.Length member this.ToCSC = @@ -48,6 +50,8 @@ module ClMatrix = q.Post(Msg.CreateFreeMsg<_>(this.ColumnPointers)) q.PostAndReply(Msg.MsgNotifyMe) + member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.NNZ = this.Values.Length member this.ToCSR = @@ -73,6 +77,8 @@ module ClMatrix = q.Post(Msg.CreateFreeMsg<_>(this.Rows)) q.PostAndReply(Msg.MsgNotifyMe) + member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.NNZ = this.Values.Length type Tuple<'elem when 'elem: struct> = @@ -88,6 +94,8 @@ module ClMatrix = q.Post(Msg.CreateFreeMsg<_>(this.Values)) q.PostAndReply(Msg.MsgNotifyMe) + member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.NNZ = this.Values.Length [] @@ -110,9 +118,9 @@ type ClMatrix<'a when 'a: struct> = member this.Dispose q = match this with - | ClMatrix.CSR matrix -> (matrix :> IDeviceMemObject).Dispose q - | ClMatrix.COO matrix -> (matrix :> IDeviceMemObject).Dispose q - | ClMatrix.CSC matrix -> (matrix :> IDeviceMemObject).Dispose q + | ClMatrix.CSR matrix -> matrix.Dispose q + | ClMatrix.COO matrix -> matrix.Dispose q + | ClMatrix.CSC matrix -> matrix.Dispose q member this.NNZ = match this with diff --git a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs index 4e9f3b33..fb8cdcc8 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs @@ -34,4 +34,4 @@ type ClVector<'a when 'a: struct> = member this.Dispose(q) = match this with | Sparse vector -> vector.Dispose(q) - | Dense vector -> vector.Dispose(q) + | Dense vector -> vector.FreeAndWait(q) diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 8aa72db5..5e0ba6c4 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -72,10 +72,10 @@ module ArithmeticOperations = let inline addRightConst zero constant = mkUnaryOp zero <@ fun x -> x + constant @> - let intSum = mkNumericSum 0 - let byteSum = mkNumericSum 0uy - let floatSum = mkNumericSum 0.0 - let float32Sum = mkNumericSum 0f + let intSumOption = mkNumericSum 0 + let byteSumOption = mkNumericSum 0uy + let floatSumOption = mkNumericSum 0.0 + let float32SumOption = mkNumericSum 0f let boolSumAtLeastOne = <@ fun (_: AtLeastOne) -> Some true @> @@ -85,7 +85,7 @@ module ArithmeticOperations = let floatSumAtLeastOne = mkNumericSumAtLeastOne 0.0 let float32SumAtLeastOne = mkNumericSumAtLeastOne 0f - let boolMul = + let boolMulOption = <@ fun (x: bool option) (y: bool option) -> let mutable res = false @@ -101,10 +101,10 @@ module ArithmeticOperations = let inline mulRightConst zero constant = mkUnaryOp zero <@ fun x -> x * constant @> - let intMul = mkNumericMul 0 - let byteMul = mkNumericMul 0uy - let floatMul = mkNumericMul 0.0 - let float32Mul = mkNumericMul 0f + let intMulOption = mkNumericMul 0 + let byteMulOption = mkNumericMul 0uy + let floatMulOption = mkNumericMul 0.0 + let float32MulOption = mkNumericMul 0f let boolMulAtLeastOne = <@ fun (values: AtLeastOne) -> @@ -121,8 +121,46 @@ module ArithmeticOperations = let floatMulAtLeastOne = mkNumericMulAtLeastOne 0.0 let float32MulAtLeastOne = mkNumericMulAtLeastOne 0f - let notQ = + let notOption = <@ fun x -> match x with | Some true -> None | _ -> Some true @> + + let inline private binOpQ zero op = + <@ fun (left: 'a) (right: 'a) -> + let result = (%op) left right + + if result = zero then + None + else + Some result @> + + let inline private binOp zero op = + fun left right -> + let result = op left right + + if result = zero then + None + else + Some result + + let inline createPair zero op opQ = binOpQ zero opQ, binOp zero op + + // addition + let intAdd = createPair 0 (+) <@ (+) @> + + let boolAdd = createPair false (||) <@ (||) @> + + let floatAdd = createPair 0.0 (+) <@ (+) @> + + let float32Add = createPair 0.0f (+) <@ (+) @> + + // multiplication + let intMul = createPair 0 (*) <@ (*) @> + + let boolMul = createPair true (&&) <@ (&&) @> + + let floatMul = createPair 0.0 (*) <@ (*) @> + + let float32Mul = createPair 0.0f (*) <@ (*) @> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs index 58ad1026..f0750dac 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs @@ -22,6 +22,16 @@ module Map = | Some _ -> 1 | None -> 0 @> + let chooseBitmap2<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c option>) = + <@ fun (leftItem: 'a) (rightItem: 'b) -> + match (%map) leftItem rightItem with + | Some _ -> 1 + | None -> 0 @> + + let inc = <@ fun item -> item + 1 @> + + let subtraction = <@ fun first second -> first - second @> + let fst () = <@ fun fst _ -> fst @> let snd () = <@ fun _ snd -> snd @> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs b/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs index ad2c4165..74fda243 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs @@ -1,8 +1,20 @@ namespace GraphBLAS.FSharp.Backend.Quotes +open Brahma.FSharp + module Predicates = let isSome<'a> = <@ fun (item: 'a option) -> match item with | Some _ -> true | _ -> false @> + + let inline lastOccurrence () = + <@ fun (gid: int) (length: int) (inputArray: ClArray<'a>) -> + gid = length - 1 + || inputArray.[gid] <> inputArray.[gid + 1] @> + + let inline firstOccurrence () = + <@ fun (gid: int) (_: int) (inputArray: ClArray<'a>) -> + gid = 0 + || inputArray.[gid - 1] <> inputArray.[gid] @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 5aca4a57..3d37a595 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs @@ -90,10 +90,10 @@ module DenseVector = let toSparse<'a when 'a: struct> (clContext: ClContext) workGroupSize = let scatterValues = - Scatter.runInplace clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let scatterIndices = - Scatter.runInplace clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let getBitmap = ClArray.map clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs index a78fdd9f..d44c5a4b 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs @@ -13,10 +13,10 @@ module internal Common = PrefixSum.standardExcludeInplace clContext workGroupSize let valuesScatter = - Scatter.runInplace clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let indicesScatter = - Scatter.runInplace clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 0746d515..1e36d108 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -35,7 +35,7 @@ module Vector = let ofList (clContext: ClContext) workGroupSize = let scatter = - Scatter.runInplace clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let zeroCreate = ClArray.zeroCreate clContext workGroupSize diff --git a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj index 97538119..96e59d55 100644 --- a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj +++ b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj @@ -31,10 +31,6 @@ - Always diff --git a/src/GraphBLAS-sharp/Objects/Matrix.fs b/src/GraphBLAS-sharp/Objects/Matrix.fs index 5dda085b..5213e750 100644 --- a/src/GraphBLAS-sharp/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp/Objects/Matrix.fs @@ -19,6 +19,8 @@ module Matrix = sprintf "Values: %A \n" this.Values ] |> String.concat "" + member this.NNZ = this.Values.Length + static member FromTuples(rowCount: int, columnCount: int, rows: int [], columns: int [], values: 'a []) = { RowCount = rowCount ColumnCount = columnCount @@ -79,6 +81,8 @@ module Matrix = RowCount = rowsCount ColumnCount = columnsCount } + member this.NNZ = this.Values.Length + member this.ToDevice(context: ClContext) = { Context = context RowCount = this.RowCount @@ -121,6 +125,8 @@ module Matrix = RowCount = rowsCount ColumnCount = columnsCount } + member this.NNZ = this.Values.Length + member this.ToDevice(context: ClContext) = { Context = context RowCount = this.RowCount @@ -154,9 +160,9 @@ type Matrix<'a when 'a: struct> = member this.NNZ = match this with - | COO m -> m.Values.Length - | CSR m -> m.Values.Length - | CSC m -> m.Values.Length + | COO m -> m.NNZ + | CSR m -> m.NNZ + | CSC m -> m.NNZ member this.ToDevice(context: ClContext) = match this with diff --git a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs b/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs index 1590f142..4c7f76d6 100644 --- a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs +++ b/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs @@ -22,7 +22,11 @@ let testFixtures (testContext: TestContext) = sprintf "Test on %A" testContext.ClContext let bfs = - Algorithms.BFS.singleSource context ArithmeticOperations.intSum ArithmeticOperations.intMul workGroupSize + Algorithms.BFS.singleSource + context + ArithmeticOperations.intSumOption + ArithmeticOperations.intMulOption + workGroupSize testPropertyWithConfig config testName <| fun (matrix: int [,]) -> diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs index 628ff51a..7c1cfdea 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs @@ -7,11 +7,16 @@ open GraphBLAS.FSharp.Tests.Context open GraphBLAS.FSharp.Backend.Objects.ClContext open Brahma.FSharp open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions let workGroupSize = Utils.defaultWorkGroupSize let config = Utils.defaultConfig +let context = Context.defaultContext.ClContext + +let processor = defaultContext.Queue + let makeTest<'a, 'b> testContext choose mapFun isEqual (array: 'a []) = if array.Length > 0 then let context = testContext.ClContext @@ -39,7 +44,7 @@ let createTest<'a, 'b> testContext mapFun mapFunQ isEqual = ClArray.choose context workGroupSize mapFunQ makeTest<'a, 'b> testContext choose mapFun isEqual - |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>} -> %A{typeof<'b>}" + |> testPropertyWithConfig config $"test on %A{typeof<'a>} -> %A{typeof<'b>}" let testFixtures testContext = let device = testContext.ClContext.ClDevice @@ -54,4 +59,43 @@ let testFixtures testContext = createTest testContext id Map.id Utils.float32IsEqual ] let tests = - TestCases.gpuTests "ClArray.choose id tests" testFixtures + TestCases.gpuTests "choose id" testFixtures + +let makeTest2 isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) = + if firstArray.Length > 0 && secondArray.Length > 0 then + + let expected = + Array.map2 opMap firstArray secondArray + |> Array.choose id + + let clFirstArray = context.CreateClArray firstArray + let clSecondArray = context.CreateClArray secondArray + + let (clActual: ClArray<_>) = + testFun processor HostInterop clFirstArray clSecondArray + + let actual = clActual.ToHostAndFree processor + clFirstArray.Free processor + clSecondArray.Free processor + + "Results must be the same" + |> Utils.compareArrays isEqual actual expected + +let createTest2 (isEqual: 'a -> 'a -> bool) (opMapQ, opMap) testFun = + let testFun = + testFun context Utils.defaultWorkGroupSize opMapQ + + makeTest2 isEqual opMap testFun + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests2 = + [ createTest2 (=) ArithmeticOperations.intAdd ClArray.choose2 + + if Utils.isFloat64Available context.ClDevice then + createTest2 (=) ArithmeticOperations.floatAdd ClArray.choose2 + + createTest2 (=) ArithmeticOperations.float32Add ClArray.choose2 + createTest2 (=) ArithmeticOperations.boolAdd ClArray.choose2 ] + |> testList "choose2 add" + +let allTests = testList "Choose" [ tests; tests2 ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs index dcf4ed83..2c8d2ba2 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs @@ -7,6 +7,7 @@ open Brahma.FSharp open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions let logger = Log.create "ClArray.Copy.Tests" @@ -20,13 +21,13 @@ let config = Utils.defaultConfig let makeTest<'a when 'a: equality> copyFun (array: array<'a>) = if array.Length > 0 then - use clArray = context.CreateClArray array + let clArray = context.CreateClArray array let actual = - use clActual: ClArray<'a> = copyFun q HostInterop clArray + (copyFun q HostInterop clArray: ClArray<_>) + .ToHostAndFree q - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + clArray.Free q logger.debug ( eventX "Actual is {actual}" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs index c7067df5..0299eb05 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs @@ -7,6 +7,7 @@ open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions let logger = Log.create "Replicate.Tests" @@ -20,13 +21,13 @@ let config = Utils.defaultConfig let makeTest<'a when 'a: equality> replicateFun (array: array<'a>) i = if array.Length > 0 && i > 0 then - use clArray = context.CreateClArray array + let clArray = context.CreateClArray array let actual = - use clActual: ClArray<'a> = replicateFun q HostInterop clArray i + (replicateFun q HostInterop clArray i: ClArray<'a>) + .ToHostAndFree q - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + clArray.Free q logger.debug ( eventX $"Actual is {actual}" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Gather.fs b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs new file mode 100644 index 00000000..3019d9d3 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs @@ -0,0 +1,127 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.Gather + +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Tests +open Expecto +open Microsoft.FSharp.Collections +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Quotes + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let check isEqual actual positions values target = + + HostPrimitives.gather positions values target + |> ignore + + "Results must be the same" + |> Utils.compareArrays isEqual actual target + +let makeTest isEqual testFun (array: (uint * 'a * 'a) []) = + + if array.Length > 0 then + + let positions, values, target = + Array.unzip3 array + |> fun (fst, snd, thd) -> Array.map int fst, snd, thd + + let clPositions = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positions) + + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + let clTarget = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, target) + + testFun processor clPositions clValues clTarget + + clPositions.Free processor + clValues.Free processor + + let actual = clTarget.ToHostAndFree processor + + check isEqual actual positions values target + +let createTest<'a> (isEqual: 'a -> 'a -> bool) testFun = + + let testFun = + testFun context Utils.defaultWorkGroupSize + + makeTest isEqual testFun + |> testPropertyWithConfig Utils.defaultConfig $"test on %A{typeof<'a>}" + +let tests = + [ createTest (=) Gather.run + + if Utils.isFloat64Available context.ClDevice then + createTest Utils.floatIsEqual Gather.run + + createTest Utils.float32IsEqual Gather.run + createTest (=) Gather.run + createTest (=) Gather.run ] + |> testList "Gather" + + +let makeTestInit isEqual testFun indexMap (array: ('a * 'a) []) = + if array.Length > 0 then + + let positions, values, target = + Array.mapi (fun index (first, second) -> indexMap index, first, second) array + |> Array.unzip3 + + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + let clTarget = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, target) + + testFun processor clValues clTarget + + clValues.Free processor + + let actual = clTarget.ToHostAndFree processor + + check isEqual actual positions values target + +let createTestInit<'a> (isEqual: 'a -> 'a -> bool) testFun indexMapQ indexMap = + + let testFun = + testFun indexMapQ context Utils.defaultWorkGroupSize + + makeTestInit isEqual testFun indexMap + |> testPropertyWithConfig Utils.defaultConfig $"test on {typeof<'a>}" + +let initTests = + + let idTests = + [ createTestInit (=) Gather.runInit Map.id id + + if Utils.isFloat64Available context.ClDevice then + createTestInit Utils.floatIsEqual Gather.runInit Map.id id + + createTestInit Utils.float32IsEqual Gather.runInit Map.id id + createTestInit (=) Gather.runInit Map.id id + createTestInit (=) Gather.runInit Map.id id ] + |> testList "id" + + let inc = ((+) 1) + + let incTests = + [ createTestInit (=) Gather.runInit Map.inc inc + + if Utils.isFloat64Available context.ClDevice then + createTestInit Utils.floatIsEqual Gather.runInit Map.inc inc + + createTestInit Utils.float32IsEqual Gather.runInit Map.inc inc + createTestInit (=) Gather.runInit Map.inc inc + createTestInit (=) Gather.runInit Map.inc inc ] + |> testList "inc" + + testList "init" [ idTests; incTests ] + + +let allTests = testList "Gather" [ tests; initTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs index 3d365f27..d6d47640 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs @@ -6,6 +6,8 @@ open Expecto.Logging.Message open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ClCell +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions let logger = Log.create "Reduce.Tests" @@ -28,15 +30,11 @@ let makeTest (reduce: MailboxProcessor<_> -> ClArray<'a> -> ClCell<'a>) plus zer ) let actualSum = - use clArray = context.CreateClArray array + let clArray = context.CreateClArray array let total = reduce clArray - let actualSum = [| zero |] - - let sum = - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(total, actualSum, ch)) - - sum.[0] + clArray.Free q + total.ToHostAndFree q logger.debug ( eventX "Actual is {actual}\n" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index 6ef76e26..09e0b21a 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -2,6 +2,8 @@ module GraphBLAS.FSharp.Tests.Backend.Common.Reduce.ByKey open Expecto open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Test open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ClContext open Brahma.FSharp @@ -13,6 +15,16 @@ let processor = Context.defaultContext.Queue let config = Utils.defaultConfig +let getOffsets array = + Array.map fst array + |> HostPrimitives.getUniqueBitmapFirstOccurrence + |> HostPrimitives.getBitPositions + +let getOffsets2D array = + Array.map (fun (fst, snd, _) -> fst, snd) array + |> HostPrimitives.getUniqueBitmapFirstOccurrence + |> HostPrimitives.getBitPositions + let checkResult isEqual actualKeys actualValues keys values reduceOp = let expectedKeys, expectedValues = @@ -185,3 +197,271 @@ let sequentialSegmentTests = createTestSequentialSegments (=) (&&) <@ (&&) @> ] testList "Sequential segments" [ addTests; mulTests ] + +let checkResult2D isEqual firstActualKeys secondActualKeys actualValues firstKeys secondKeys values reduceOp = + + let expectedFirstKeys, expectedSecondKeys, expectedValues = + HostPrimitives.reduceByKey2D firstKeys secondKeys values reduceOp + + "First keys must be the same" + |> Utils.compareArrays (=) firstActualKeys expectedFirstKeys + + "Second keys must be the same" + |> Utils.compareArrays (=) secondActualKeys expectedSecondKeys + + "Values must the same" + |> Utils.compareArrays isEqual actualValues expectedValues + +let makeTest2D isEqual reduce reduceOp (array: (int * int * 'a) []) = + let firstKeys, secondKeys, values = + array + |> Array.sortBy (fun (fst, snd, _) -> fst, snd) + |> Array.unzip3 + + if firstKeys.Length > 0 then + let clFirstKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, firstKeys) + + let clSecondKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, secondKeys) + + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + let resultLength = + Array.length + <| Array.distinctBy (fun (fst, snd, _) -> (fst, snd)) array + + let clFirstActualKeys, clSecondActualKeys, clActualValues: ClArray * ClArray * ClArray<'a> = + reduce processor HostInterop resultLength clFirstKeys clSecondKeys clValues + + clValues.Free processor + clFirstKeys.Free processor + clSecondKeys.Free processor + + let actualValues = clActualValues.ToHostAndFree processor + + let firstActualKeys = + clFirstActualKeys.ToHostAndFree processor + + let secondActualKeys = + clSecondActualKeys.ToHostAndFree processor + + checkResult2D isEqual firstActualKeys secondActualKeys actualValues firstKeys secondKeys values reduceOp + +let createTestSequential2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = + + let reduce = + Reduce.ByKey2D.sequential context Utils.defaultWorkGroupSize reduceOpQ + + makeTest2D isEqual reduce reduceOp + |> testPropertyWithConfig + { config with + arbitrary = [ typeof ] + endSize = 10 } + $"test on {typeof<'a>}" + +let sequential2DTest = + let addTests = + testList + "add tests" + [ createTestSequential2D (=) (+) <@ (+) @> + createTestSequential2D (=) (+) <@ (+) @> + + if Utils.isFloat64Available context.ClDevice then + createTestSequential2D Utils.floatIsEqual (+) <@ (+) @> + + createTestSequential2D Utils.float32IsEqual (+) <@ (+) @> + createTestSequential2D (=) (||) <@ (||) @> ] + + let mulTests = + testList + "mul tests" + [ createTestSequential2D (=) (*) <@ (*) @> + createTestSequential2D (=) (*) <@ (*) @> + + if Utils.isFloat64Available context.ClDevice then + createTestSequential2D Utils.floatIsEqual (*) <@ (*) @> + + createTestSequential2D Utils.float32IsEqual (*) <@ (*) @> + createTestSequential2D (=) (&&) <@ (&&) @> ] + + testList "Sequential 2D" [ addTests; mulTests ] + +let makeTestSequentialSegments2D isEqual reduce reduceOp (array: (int * int * 'a) []) = + + if array.Length > 0 then + let array = + Array.sortBy (fun (fst, snd, _) -> fst, snd) array + + let offsets = + array + |> Array.map (fun (fst, snd, _) -> fst, snd) + |> HostPrimitives.getUniqueBitmapFirstOccurrence + |> HostPrimitives.getBitPositions + + let resultLength = offsets.Length + + let firstKeys, secondKeys, values = Array.unzip3 array + + let clOffsets = + context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) + + let clFirstKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, firstKeys) + + let clSecondKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, secondKeys) + + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + let clFirstActualKeys, clSecondActualKeys, clReducedValues: ClArray * ClArray * ClArray<'a> = + reduce processor DeviceOnly resultLength clOffsets clFirstKeys clSecondKeys clValues + + let reducedFirsKeys = + clFirstActualKeys.ToHostAndFree processor + + let reducesSecondKeys = + clSecondActualKeys.ToHostAndFree processor + + let reducedValues = clReducedValues.ToHostAndFree processor + + checkResult2D isEqual reducedFirsKeys reducesSecondKeys reducedValues firstKeys secondKeys values reduceOp + +let createTestSequentialSegments2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = + let reduce = + Reduce.ByKey2D.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ + + makeTestSequentialSegments2D isEqual reduce reduceOp + |> testPropertyWithConfig + { config with + arbitrary = [ typeof ] } + $"test on {typeof<'a>}" + +let sequentialSegment2DTests = + let addTests = + testList + "add tests" + [ createTestSequentialSegments2D (=) (+) <@ (+) @> + createTestSequentialSegments2D (=) (+) <@ (+) @> + + if Utils.isFloat64Available context.ClDevice then + createTestSequentialSegments2D Utils.floatIsEqual (+) <@ (+) @> + + createTestSequentialSegments2D Utils.float32IsEqual (+) <@ (+) @> + createTestSequentialSegments2D (=) (||) <@ (||) @> ] + + let mulTests = + testList + "mul tests" + [ createTestSequentialSegments2D (=) (*) <@ (*) @> + createTestSequentialSegments2D (=) (*) <@ (*) @> + + if Utils.isFloat64Available context.ClDevice then + createTestSequentialSegments2D Utils.floatIsEqual (*) <@ (*) @> + + createTestSequentialSegments2D Utils.float32IsEqual (*) <@ (*) @> + createTestSequentialSegments2D (=) (&&) <@ (&&) @> ] + + testList "Sequential segments 2D" [ addTests; mulTests ] + +let checkResult2DOption isEqual firstActualKeys secondActualKeys actualValues firstKeys secondKeys values reduceOp = + + let reduceOp left right = + match left, right with + | Some left, Some right -> reduceOp left right + | Some value, None + | None, Some value -> Some value + | _ -> None + + let expectedFirstKeys, expectedSecondKeys, expectedValues = + let keys = Array.zip firstKeys secondKeys + + Array.zip keys values + |> Array.groupBy fst + |> Array.map (fun (key, array) -> key, Array.map snd array) + |> Array.map + (fun (key, array) -> + Array.map Some array + |> Array.reduce reduceOp + |> fun result -> key, result) + |> Array.choose + (fun ((fstKey, sndKey), value) -> + match value with + | Some value -> Some(fstKey, sndKey, value) + | _ -> None) + |> Array.unzip3 + + "First keys must be the same" + |> Utils.compareArrays (=) firstActualKeys expectedFirstKeys + + "Second keys must be the same" + |> Utils.compareArrays (=) secondActualKeys expectedSecondKeys + + "Values must the same" + |> Utils.compareArrays isEqual actualValues expectedValues + +let test2DOption<'a> isEqual reduce reduceOp (array: (int * int * 'a) []) = + if array.Length > 0 then + let array = + Array.sortBy (fun (fst, snd, _) -> fst, snd) array + + let offsets = getOffsets2D array + + let firstKeys, secondKeys, values = Array.unzip3 array + + let clOffsets = + context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) + + let clFirstKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, firstKeys) + + let clSecondKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, secondKeys) + + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + let clFirstActualKeys, clSecondActualKeys, clReducedValues: ClArray * ClArray * ClArray<'a> = + reduce processor DeviceOnly offsets.Length clOffsets clFirstKeys clSecondKeys clValues + + let reducedFirsKeys = + clFirstActualKeys.ToHostAndFree processor + + let reducesSecondKeys = + clSecondActualKeys.ToHostAndFree processor + + let reducedValues = clReducedValues.ToHostAndFree processor + + checkResult2DOption isEqual reducedFirsKeys reducesSecondKeys reducedValues firstKeys secondKeys values reduceOp + +let createTest2DOption (isEqual: 'a -> 'a -> bool) (reduceOpQ, reduceOp) = + let reduce = + Reduce.ByKey2D.segmentSequentialOption context Utils.defaultWorkGroupSize reduceOpQ + + test2DOption<'a> isEqual reduce reduceOp + |> testPropertyWithConfig + { config with + arbitrary = [ typeof ] } + $"test on {typeof<'a>}" + +let testsSegmentsSequential2DOption = + [ createTest2DOption (=) ArithmeticOperations.intAdd + + if Utils.isFloat64Available context.ClDevice then + createTest2DOption Utils.floatIsEqual ArithmeticOperations.floatAdd + + createTest2DOption Utils.float32IsEqual ArithmeticOperations.float32Add + createTest2DOption (=) ArithmeticOperations.boolAdd ] + |> testList "2D option" + +let allTests = + testList + "Reduce.ByKey" + [ sequentialTest + oneWorkGroupTest + sequentialSegmentTests + sequential2DTest + sequentialSegment2DTests + testsSegmentsSequential2DOption ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs index c779ea07..e094d572 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs @@ -8,6 +8,8 @@ open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Tests open FSharp.Quotations open Context +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClCell let logger = Log.create "Sum.Test" @@ -27,11 +29,11 @@ let makeTest plus zero sum (array: 'a []) = ) let actualSum = - use clArray = context.CreateClArray array - use total = sum q clArray + let clArray = context.CreateClArray array + let (total: ClCell<_>) = sum q clArray - let actualSum = [| zero |] - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(total, actualSum, ch)).[0] + clArray.Free q + total.ToHostAndFree q logger.debug ( eventX "Actual is {actual}\n" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs b/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs index c8ce588a..734b96f9 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs @@ -8,6 +8,7 @@ open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Tests.Context open GraphBLAS.FSharp open GraphBLAS.FSharp.Backend.Objects.ClCell +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions let logger = Log.create "ClArray.PrefixSum.Tests" @@ -28,12 +29,12 @@ let makeTest plus zero isEqual scan (array: 'a []) = ) let actual, actualSum = - use clArray = context.CreateClArray array + let clArray = context.CreateClArray array let (total: ClCell<_>) = scan q clArray zero - let actual = Array.zeroCreate<'a> clArray.Length - let actualSum = total.ToHostAndFree(q) - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clArray, actual, ch)), actualSum + let actual = clArray.ToHostAndFree q + let actualSum = total.ToHostAndFree q + actual, actualSum logger.debug ( eventX "Actual is {actual}\n" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs index 5730ca2e..a72de22b 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs @@ -3,61 +3,112 @@ module GraphBLAS.FSharp.Tests.Backend.Common.Scatter open Expecto open Expecto.Logging open Brahma.FSharp +open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Context -open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions let logger = Log.create "Scatter.Tests" let context = defaultContext.ClContext -let config = - { Tests.Utils.defaultConfig with - endSize = 1000000 } +let config = Utils.defaultConfig -let wgSize = Tests.Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize let q = defaultContext.Queue -let makeTest scatter (array: (int * 'a) []) (result: 'a []) = +let makeTest<'a when 'a: equality> hostScatter scatter (array: (int * 'a) []) (result: 'a []) = if array.Length > 0 then - let expected = Array.copy result + let positions, values = Array.sortBy fst array |> Array.unzip - array - |> Array.pairwise - |> Array.iter - (fun ((i, u), (j, _)) -> - if i <> j && 0 <= i && i < expected.Length then - expected.[i] <- u) - - let i, u = array.[array.Length - 1] - - if 0 <= i && i < expected.Length then - expected.[i] <- u - - let positions, values = Array.unzip array + let expected = + Array.copy result |> hostScatter positions values let actual = - use clPositions = context.CreateClArray positions - use clValues = context.CreateClArray values - use clResult = context.CreateClArray result + let clPositions = context.CreateClArray positions + let clValues = context.CreateClArray values + let clResult = context.CreateClArray result scatter q clPositions clValues clResult - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clResult, Array.zeroCreate result.Length, ch)) + clValues.Free q + clPositions.Free q + clResult.ToHostAndFree q - $"Arrays should be equal. Actual is \n%A{actual}, expected \n%A{expected}" - |> Tests.Utils.compareArrays (=) actual expected + $"Arrays should be equal." + |> Utils.compareArrays (=) actual expected -let testFixtures<'a when 'a: equality> = - Scatter.runInplace<'a> context wgSize - |> makeTest +let testFixturesLast<'a when 'a: equality> = + Scatter.lastOccurrence context wgSize + |> makeTest<'a> HostPrimitives.scatterLastOccurrence + |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" + +let testFixturesFirst<'a when 'a: equality> = + Scatter.firstOccurrence context wgSize + |> makeTest<'a> HostPrimitives.scatterFirstOccurrence |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" let tests = q.Error.Add(fun e -> failwithf $"%A{e}") - [ testFixtures - testFixtures - testFixtures ] - |> testList "Backend.Common.Scatter tests" + let last = + [ testFixturesLast + testFixturesLast + testFixturesLast ] + |> testList "Last Occurrence" + + let first = + [ testFixturesFirst + testFixturesFirst + testFixturesFirst ] + |> testList "First Occurrence" + + testList "ones occurrence" [ first; last ] + +let makeTestInit<'a when 'a: equality> hostScatter valueMap scatter (positions: int []) (result: 'a []) = + if positions.Length > 0 then + + let values = Array.init positions.Length valueMap + let positions = Array.sort positions + + let expected = + Array.copy result |> hostScatter positions values + + let clPositions = context.CreateClArray positions + let clResult = context.CreateClArray result + + scatter q clPositions clResult + + clPositions.Free q + let actual = clResult.ToHostAndFree q + + $"Arrays should be equal." + |> Utils.compareArrays (=) actual expected + +let createInitTest clScatter hostScatter name valuesMap valuesMapQ = + let scatter = + clScatter valuesMapQ context Utils.defaultWorkGroupSize + + makeTestInit<'a> hostScatter valuesMap scatter + |> testPropertyWithConfig config name + +let initTests = + q.Error.Add(fun e -> failwithf $"%A{e}") + + let inc = ((+) 1) + + let firstOccurrence = + [ createInitTest Scatter.initFirsOccurrence HostPrimitives.scatterFirstOccurrence "id" id Map.id + createInitTest Scatter.initFirsOccurrence HostPrimitives.scatterFirstOccurrence "inc" inc Map.inc ] + |> testList "first occurrence" + + let lastOccurrence = + [ createInitTest Scatter.initLastOccurrence HostPrimitives.scatterLastOccurrence "id" id Map.id + createInitTest Scatter.initLastOccurrence HostPrimitives.scatterLastOccurrence "inc" inc Map.inc ] + |> testList "last occurrence" + + testList "init" [ firstOccurrence; lastOccurrence ] + +let allTests = testList "Scatter" [ tests; initTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs b/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs index 40fcc9f6..60705e76 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs @@ -7,6 +7,7 @@ open GraphBLAS.FSharp.Backend.Common open Brahma.FSharp open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Context +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions module Bitonic = let logger = Log.create "BitonicSort.Tests" @@ -32,22 +33,16 @@ module Bitonic = let rows, cols, vals = Array.unzip3 array - use clRows = context.CreateClArray rows - use clColumns = context.CreateClArray cols - use clValues = context.CreateClArray vals + let clRows = context.CreateClArray rows + let clColumns = context.CreateClArray cols + let clValues = context.CreateClArray vals let actualRows, actualCols, actualValues = sort q clRows clColumns clValues - let rows = Array.zeroCreate<'n> clRows.Length - let columns = Array.zeroCreate<'n> clColumns.Length - let values = Array.zeroCreate<'a> clValues.Length - - q.Post(Msg.CreateToHostMsg(clRows, rows)) - q.Post(Msg.CreateToHostMsg(clColumns, columns)) - - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clValues, values, ch)) - |> ignore + let rows = clRows.ToHostAndFree q + let columns = clColumns.ToHostAndFree q + let values = clValues.ToHostAndFree q rows, columns, values @@ -80,7 +75,6 @@ module Bitonic = testFixtures testFixtures - testFixtures testFixtures ] |> testList "Backend.Common.BitonicSort tests" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs index 56add17c..049568c5 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs @@ -5,6 +5,7 @@ open GraphBLAS.FSharp.Backend.Common.Sort open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects.ClContext module Radix = let config = @@ -18,15 +19,12 @@ module Radix = let context = Context.defaultContext.ClContext let checkResultByKeys (inputArray: (int * 'a) []) (actualValues: 'a []) = - let expectedValues = - Array.sortBy fst inputArray |> Array.map snd + let expectedValues = Seq.sortBy fst inputArray |> Seq.map snd "Values must be the same" |> Expect.sequenceEqual expectedValues actualValues let makeTestByKeys<'a when 'a: equality> sortFun (array: (int * 'a) []) = - // since Array.sort not stable - let array = Array.distinctBy fst array if array.Length > 0 then let keys = Array.map fst array @@ -35,7 +33,8 @@ module Radix = let clKeys = keys.ToDevice context let clValues = values.ToDevice context - let clActualValues: ClArray<'a> = sortFun processor clKeys clValues + let clActualValues: ClArray<'a> = + sortFun processor HostInterop clKeys clValues let actualValues = clActualValues.ToHostAndFree processor @@ -48,7 +47,7 @@ module Radix = makeTestByKeys<'a> sort |> testPropertyWithConfig config $"test on {typeof<'a>}" - let testFixturesByKeys = + let testByKeys = [ createTestByKeys createTestByKeys @@ -57,9 +56,7 @@ module Radix = createTestByKeys createTestByKeys ] - - let testsByKeys = - testList "Radix sort by keys" testFixturesByKeys + |> testList "Radix sort by keys" let makeTestKeysOnly sort (keys: uint []) = if keys.Length > 0 then diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 4182b57a..5144f0c7 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -38,12 +38,14 @@ module Generators = /// Generates empty matrices as well. /// let dimension2DGenerator = - Gen.sized - <| fun size -> Gen.choose (1, size) |> Gen.two + fun size -> Gen.choose (1, size) + |> Gen.sized + |> Gen.two let dimension3DGenerator = - Gen.sized - <| fun size -> Gen.choose (1, size) |> Gen.three + fun size -> Gen.choose (1, size) + |> Gen.sized + |> Gen.three let rec normalFloat32Generator (random: System.Random) = gen { diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 234c76a1..650caaea 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -17,6 +17,7 @@ + @@ -46,9 +47,10 @@ - + + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index c45a2674..08c2fc27 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -140,6 +140,11 @@ module Utils = result + let castMatrixToCSR = + function + | Matrix.CSR matrix -> matrix + | _ -> failwith "matrix format must be CSR" + module HostPrimitives = let prefixSumInclude zero add array = Array.scan add zero array @@ -186,6 +191,71 @@ module HostPrimitives = |> fun value -> key, value) |> Array.unzip + let reduceByKey2D firstKeys secondKeys values reduceOp = + Array.zip firstKeys secondKeys + |> fun compactedKeys -> reduceByKey compactedKeys values reduceOp + ||> Array.map2 (fun (fst, snd) value -> fst, snd, value) + |> Array.unzip3 + + let generalScatter getBitmap (positions: int array) (values: 'a array) (resultValues: 'a array) = + + if positions.Length <> values.Length then + failwith "Lengths must be the same" + + let bitmap = getBitmap positions + + Array.iteri2 + (fun index bit key -> + if bit = 1 && 0 <= key && key < resultValues.Length then + resultValues.[key] <- values.[index]) + bitmap + positions + + resultValues + + let scatterLastOccurrence positions = + generalScatter getUniqueBitmapLastOccurrence positions + + let scatterFirstOccurrence positions = + generalScatter getUniqueBitmapFirstOccurrence positions + + let gather (positions: int []) (values: 'a []) (result: 'a []) = + if positions.Length <> result.Length then + failwith "Lengths must be the same" + + Array.iteri + (fun index position -> + if position >= 0 && position < values.Length then + result.[index] <- values.[position]) + positions + + result + + let array2DMultiplication zero mul add leftArray rightArray = + if Array2D.length2 leftArray + <> Array2D.length1 rightArray then + failwith "Incompatible matrices" + + let add left right = + match left, right with + | Some left, Some right -> add left right + | Some value, None + | None, Some value -> Some value + | _ -> None + + Array2D.init + <| Array2D.length1 leftArray + <| Array2D.length2 rightArray + <| fun i j -> + (leftArray.[i, *], rightArray.[*, j]) + // multiply and filter + ||> Array.map2 mul + |> Array.choose id + // add and filter + |> Array.map Some + |> Array.fold add None + |> Option.defaultValue zero + let scanByKey scan keysAndValues = Array.groupBy fst keysAndValues |> Array.map (fun (_, array) -> Array.map snd array |> scan |> fst) diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs index 229271b7..b89042a4 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs @@ -108,7 +108,7 @@ let testFixturesMapNot case = [ let q = case.TestContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - createTestMap case false true (fun _ -> not) (=) (fun _ _ -> ArithmeticOperations.notQ) ] + createTestMap case false true (fun _ -> not) (=) (fun _ _ -> ArithmeticOperations.notOption) ] let notTests = operationGPUTests "Backend.Matrix.map not tests" testFixturesMapNot diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs index eeb1546f..ae5e0e22 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs @@ -113,13 +113,13 @@ let testFixturesMap2Add case = q.Error.Add(fun e -> failwithf "%A" e) creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSum Matrix.map2 - creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSum Matrix.map2 + creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumOption Matrix.map2 if Utils.isFloat64Available context.ClDevice then - creatTestMap2Add case 0.0 (+) Utils.floatIsEqual ArithmeticOperations.floatSum Matrix.map2 + creatTestMap2Add case 0.0 (+) Utils.floatIsEqual ArithmeticOperations.floatSumOption Matrix.map2 - creatTestMap2Add case 0.0f (+) Utils.float32IsEqual ArithmeticOperations.float32Sum Matrix.map2 - creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSum Matrix.map2 ] + creatTestMap2Add case 0.0f (+) Utils.float32IsEqual ArithmeticOperations.float32SumOption Matrix.map2 + creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSumOption Matrix.map2 ] let addTests = operationGPUTests "Backend.Matrix.map2 add tests" testFixturesMap2Add diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs new file mode 100644 index 00000000..00ce048d --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -0,0 +1,266 @@ +module GraphBLAS.FSharp.Tests.Matrix.SpGeMM.Expand + +open Expecto +open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Test +open Microsoft.FSharp.Collections +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Backend +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Objects.MatrixExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] + endSize = 100 + maxTest = 100 } + +let createCSRMatrix array isZero = + Utils.createMatrixFromArray2D CSR array isZero + |> Utils.castMatrixToCSR + +let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = + Array.map + (fun item -> + rightMatrix.RowPointers.[item + 1] + - rightMatrix.RowPointers.[item]) + leftMatrix.ColumnIndices + |> HostPrimitives.prefixSumExclude 0 (+) + +let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = createCSRMatrix leftArray isZero + + let rightMatrix = createCSRMatrix rightArray isZero + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + + let clLeftMatrix = leftMatrix.ToDevice context + + let clRightMatrix = rightMatrix.ToDevice context + + let actualLength, (clActual: ClArray) = + testFun processor clLeftMatrix clRightMatrix + + clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor + + let actualPointers = clActual.ToHostAndFree processor + + let expectedPointers, expectedLength = + getSegmentsPointers leftMatrix rightMatrix + + "Results lengths must be the same" + |> Expect.equal actualLength expectedLength + + "Result pointers must be the same" + |> Expect.sequenceEqual actualPointers expectedPointers + +let createTest<'a when 'a: struct> (isZero: 'a -> bool) = + + let testFun = + Expand.getSegmentPointers context Utils.defaultWorkGroupSize + + makeTest isZero testFun + |> testPropertyWithConfig config $"test on {typeof<'a>}" + +let getSegmentsTests = + [ createTest ((=) 0) + + if Utils.isFloat64Available context.ClDevice then + createTest ((=) 0.0) + + createTest ((=) 0f) + createTest ((=) false) + createTest ((=) 0uy) ] + |> testList "get segment pointers" + +let expand length segmentPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = + let extendPointers pointers = + Array.pairwise pointers + |> Array.map (fun (fst, snd) -> snd - fst) + |> Array.mapi (fun index length -> Array.create length index) + |> Array.concat + + let segmentsLengths = + Array.append segmentPointers [| length |] + |> Array.pairwise + |> Array.map (fun (fst, snd) -> snd - fst) + + let leftMatrixValues, expectedRows = + let tripleFst (fst, _, _) = fst + + Array.zip3 segmentsLengths leftMatrix.Values + <| extendPointers leftMatrix.RowPointers + // select items each segment length not zero + |> Array.filter (tripleFst >> ((=) 0) >> not) + |> Array.collect (fun (length, value, rowIndex) -> Array.create length (value, rowIndex)) + |> Array.unzip + + let rightMatrixValues, expectedColumns = + let valuesAndColumns = + Array.zip rightMatrix.Values rightMatrix.ColumnIndices + + Array.map2 + (fun column length -> + let rowStart = rightMatrix.RowPointers.[column] + Array.take length valuesAndColumns.[rowStart..]) + leftMatrix.ColumnIndices + segmentsLengths + |> Array.concat + |> Array.unzip + + leftMatrixValues, rightMatrixValues, expectedColumns, expectedRows + +let makeExpandTest isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = + createCSRMatrix leftArray <| isEqual zero + + let rightMatrix = + createCSRMatrix rightArray <| isEqual zero + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + + let segmentPointers, length = + getSegmentsPointers leftMatrix rightMatrix + + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + let clSegmentPointers = context.CreateClArray segmentPointers + + let ((clActualLeftValues: ClArray<'a>), + (clActualRightValues: ClArray<'a>), + (clActualColumns: ClArray), + (clActualRows: ClArray)) = + testFun processor length clSegmentPointers clLeftMatrix clRightMatrix + + clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor + clSegmentPointers.Free processor + + let actualLeftValues = + clActualLeftValues.ToHostAndFree processor + + let actualRightValues = + clActualRightValues.ToHostAndFree processor + + let actualColumns = clActualColumns.ToHostAndFree processor + let actualRows = clActualRows.ToHostAndFree processor + + let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns, expectedRows = + expand length segmentPointers leftMatrix rightMatrix + + "Left values must be the same" + |> Utils.compareArrays isEqual actualLeftValues expectedLeftMatrixValues + + "Right values must be the same" + |> Utils.compareArrays isEqual actualRightValues expectedRightMatrixValues + + "Columns must be the same" + |> Utils.compareArrays (=) actualColumns expectedColumns + + "Rows must be the same" + |> Utils.compareArrays (=) actualRows expectedRows + +let createExpandTest isEqual (zero: 'a) testFun = + + let testFun = + testFun context Utils.defaultWorkGroupSize + + makeExpandTest isEqual zero testFun + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +// expand phase tests +let expandTests = + [ createExpandTest (=) 0 Expand.expand + + if Utils.isFloat64Available context.ClDevice then + createExpandTest Utils.floatIsEqual 0.0 Expand.expand + + createExpandTest Utils.float32IsEqual 0f Expand.expand + createExpandTest (=) false Expand.expand + createExpandTest (=) 0uy Expand.expand ] + |> testList "Expand.expand" + +let checkGeneralResult zero isEqual (actualMatrix: Matrix<'a>) mul add (leftArray: 'a [,]) (rightArray: 'a [,]) = + + let expected = + HostPrimitives.array2DMultiplication zero mul add leftArray rightArray + |> fun array -> Utils.createMatrixFromArray2D COO array (isEqual zero) + + match actualMatrix, expected with + | Matrix.COO actualMatrix, Matrix.COO expected -> + + "Values must be the same" + |> Utils.compareArrays isEqual actualMatrix.Values expected.Values + + "Columns must be the same" + |> Utils.compareArrays (=) actualMatrix.Columns expected.Columns + + "Rows must be the same" + |> Utils.compareArrays (=) actualMatrix.Rows expected.Rows + | _ -> failwith "Matrix format are not matching" + +let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = + Utils.createMatrixFromArray2D CSR leftArray (isEqual zero) + + let rightMatrix = + Utils.createMatrixFromArray2D CSR rightArray (isEqual zero) + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + try + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + + let (clMatrixActual: ClMatrix<_>) = + testFun processor HostInterop clLeftMatrix clRightMatrix + + let matrixActual = clMatrixActual.ToHost processor + clMatrixActual.Dispose processor + + checkGeneralResult zero isEqual matrixActual opMul opAdd leftArray rightArray + with + | ex when ex.Message = "InvalidBufferSize" -> () + | _ -> reraise () + +let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = + + let testFun = + testFun context Utils.defaultWorkGroupSize opAddQ opMulQ + + makeGeneralTest zero isEqual opMul opAdd testFun + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let generalTests = + [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand + + if Utils.isFloat64Available context.ClDevice then + createGeneralTest + 0.0 + Utils.floatIsEqual + ArithmeticOperations.floatAdd + ArithmeticOperations.floatMul + Matrix.SpGeMM.expand + + createGeneralTest + 0.0f + Utils.float32IsEqual + ArithmeticOperations.float32Add + ArithmeticOperations.float32Mul + Matrix.SpGeMM.expand + createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Matrix.SpGeMM.expand ] + |> testList "general" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Masked.fs similarity index 91% rename from tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs rename to tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Masked.fs index 236f0973..7304b96e 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Mxm.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Masked.fs @@ -1,4 +1,4 @@ -module GraphBLAS.FSharp.Tests.Backend.Matrix.Mxm +module GraphBLAS.FSharp.Tests.Backend.Matrix.SpGeMM.Masked open Expecto open Expecto.Logging @@ -11,7 +11,7 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Test -let logger = Log.create "Mxm.Tests" +let logger = Log.create "SpGeMM.Masked.Tests" let context = defaultContext.ClContext let workGroupSize = Utils.defaultWorkGroupSize @@ -79,7 +79,7 @@ let tests = let mult = <@ fun x y -> Some(x * y) @> let mxmFun = - Matrix.mxm add mult context workGroupSize + Matrix.SpGeMM.masked add mult context workGroupSize makeTest context q 0 (=) (+) (*) mxmFun |> testPropertyWithConfig config (getCorrectnessTestName "int") @@ -105,8 +105,8 @@ let tests = res @> let mxmFun = - Matrix.mxm logicalOr logicalAnd context workGroupSize + Matrix.SpGeMM.masked logicalOr logicalAnd context workGroupSize makeTest context q false (=) (||) (&&) mxmFun |> testPropertyWithConfig config (getCorrectnessTestName "bool") ] - |> testList "Mxm tests" + |> testList "SpGeMM masked tests" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 8532df05..7ae1811f 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,5 +1,6 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend +open GraphBLAS.FSharp.Tests let matrixTests = testList @@ -12,8 +13,9 @@ let matrixTests = Matrix.Map.notTests Matrix.Map.addTests Matrix.Map.mulTests - Matrix.Mxm.tests - Matrix.Transpose.tests ] + Matrix.Transpose.tests + Matrix.SpGeMM.Masked.tests + Matrix.SpGeMM.Expand.generalTests ] |> testSequenced let commonTests = @@ -26,9 +28,7 @@ let commonTests = let reduceTests = testList "Reduce" - [ Common.Reduce.ByKey.sequentialTest - Common.Reduce.ByKey.sequentialSegmentTests - Common.Reduce.ByKey.oneWorkGroupTest + [ Common.Reduce.ByKey.allTests Common.Reduce.Reduce.tests Common.Reduce.Sum.tests ] @@ -42,22 +42,23 @@ let commonTests = Common.ClArray.Map.tests Common.ClArray.Map2.addTests Common.ClArray.Map2.mulTests - Common.ClArray.Choose.tests ] + Common.ClArray.Choose.allTests ] let sortTests = testList "Sort" [ Common.Sort.Bitonic.tests - Common.Sort.Radix.testsByKeys + Common.Sort.Radix.testByKeys Common.Sort.Radix.testKeysOnly ] testList "Common tests" - [ clArrayTests + [ Common.Scatter.allTests + Common.Gather.allTests + clArrayTests sortTests reduceTests - scanTests - Common.Scatter.tests ] + scanTests ] |> testSequenced let vectorTests = @@ -87,8 +88,8 @@ let allTests = testList "All tests" [ matrixTests - commonTests vectorTests + commonTests algorithmsTests ] |> testSequenced diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs index 33f4a693..0ff08e3f 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs @@ -101,14 +101,14 @@ let createTest case isEqual (zero: 'a) plus plusQ map2 = let addTestFixtures case = let context = case.TestContext.ClContext - [ createTest case (=) 0 (+) ArithmeticOperations.intSum Vector.map2 + [ createTest case (=) 0 (+) ArithmeticOperations.intSumOption Vector.map2 if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 (+) ArithmeticOperations.floatSum Vector.map2 + createTest case Utils.floatIsEqual 0.0 (+) ArithmeticOperations.floatSumOption Vector.map2 - createTest case Utils.float32IsEqual 0.0f (+) ArithmeticOperations.float32Sum Vector.map2 + createTest case Utils.float32IsEqual 0.0f (+) ArithmeticOperations.float32SumOption Vector.map2 createTest case (=) false (||) ArithmeticOperations.boolSum Vector.map2 - createTest case (=) 0uy (+) ArithmeticOperations.byteSum Vector.map2 ] + createTest case (=) 0uy (+) ArithmeticOperations.byteSumOption Vector.map2 ] let addTests = operationGPUTests "Backend.Vector.Map2 add tests" addTestFixtures @@ -116,14 +116,14 @@ let addTests = let mulTestFixtures case = let context = case.TestContext.ClContext - [ createTest case (=) 0 (*) ArithmeticOperations.intMul Vector.map2 + [ createTest case (=) 0 (*) ArithmeticOperations.intMulOption Vector.map2 if Utils.isFloat64Available context.ClDevice then - createTest case Utils.floatIsEqual 0.0 (*) ArithmeticOperations.floatMul Vector.map2 + createTest case Utils.floatIsEqual 0.0 (*) ArithmeticOperations.floatMulOption Vector.map2 - createTest case Utils.float32IsEqual 0.0f (*) ArithmeticOperations.float32Mul Vector.map2 - createTest case (=) false (&&) ArithmeticOperations.boolMul Vector.map2 - createTest case (=) 0uy (*) ArithmeticOperations.byteMul Vector.map2 ] + createTest case Utils.float32IsEqual 0.0f (*) ArithmeticOperations.float32MulOption Vector.map2 + createTest case (=) false (&&) ArithmeticOperations.boolMulOption Vector.map2 + createTest case (=) 0uy (*) ArithmeticOperations.byteMulOption Vector.map2 ] let mulTests = operationGPUTests "Backend.Vector.map2 mul tests" addTestFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs index 90d90ef4..db42fd9d 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs @@ -76,9 +76,8 @@ let correctnessGenericTest let res = spMV testContext.Queue HostInterop m v (ClMatrix.CSR m).Dispose q - v.Dispose q - let hostRes = res.ToHost q - res.Dispose q + v.Free q + let hostRes = res.ToHostAndFree q checkResult isEqual sumOp mulOp zero matrix vector hostRes | _ -> failwith "Impossible" @@ -105,8 +104,8 @@ let testFixturesSpMV (testContext: TestContext) = let q = testContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - createTest testContext false (=) (||) (&&) ArithmeticOperations.boolSum ArithmeticOperations.boolMul - createTest testContext 0 (=) (+) (*) ArithmeticOperations.intSum ArithmeticOperations.intMul + createTest testContext false (=) (||) (&&) ArithmeticOperations.boolSum ArithmeticOperations.boolMulOption + createTest testContext 0 (=) (+) (*) ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption if Utils.isFloat64Available context.ClDevice then createTest @@ -115,8 +114,8 @@ let testFixturesSpMV (testContext: TestContext) = Utils.floatIsEqual (+) (*) - ArithmeticOperations.floatSum - ArithmeticOperations.floatMul + ArithmeticOperations.floatSumOption + ArithmeticOperations.floatMulOption createTest testContext @@ -124,10 +123,10 @@ let testFixturesSpMV (testContext: TestContext) = Utils.float32IsEqual (+) (*) - ArithmeticOperations.float32Sum - ArithmeticOperations.float32Mul + ArithmeticOperations.float32SumOption + ArithmeticOperations.float32MulOption - createTest testContext 0uy (=) (+) (*) ArithmeticOperations.byteSum ArithmeticOperations.byteMul ] + createTest testContext 0uy (=) (+) (*) ArithmeticOperations.byteSumOption ArithmeticOperations.byteMulOption ] let tests = gpuTests "Backend.Vector.SpMV tests" testFixturesSpMV