From d55d34f7b6b5685a84245b48d1cc648560520e97 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sun, 12 Mar 2023 16:15:05 +0300 Subject: [PATCH 01/33] add: Gather --- src/GraphBLAS-sharp.Backend/Common/Gather.fs | 41 +++++++++++++++++++ .../GraphBLAS-sharp.Backend.fsproj | 1 + 2 files changed, 42 insertions(+) create mode 100644 src/GraphBLAS-sharp.Backend/Common/Gather.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs new file mode 100644 index 00000000..3d70bd3c --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -0,0 +1,41 @@ +namespace GraphBLAS.FSharp.Backend.Common.Gather + +open Brahma.FSharp + +module internal Gather = + /// + /// 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) (positions: ClArray) (inputArray: ClArray<'a>) (outputArray: ClArray<'a>) (size: int) -> + + let i = ndRange.GlobalID0 + + if i < size then + outputArray.[i] <- inputArray.[positions.[i]] @> + + let program = clContext.Compile(gather) + + fun (processor: MailboxProcessor<_>) (positions: ClArray) (inputArray: ClArray<'a>) (outputArray: ClArray<'a>) -> + + let size = outputArray.Length + + let kernel = program.GetKernel() + + let ndRange = Range1D.CreateValid(size, workGroupSize) + + processor.Post( + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange positions inputArray outputArray size) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 35d7e632..9d6cd576 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -32,6 +32,7 @@ + From a136bd3f8ffadc73b71427d627fa7de602f196b3 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 13 Mar 2023 09:54:42 +0300 Subject: [PATCH 02/33] add: Expand module --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 26 +- src/GraphBLAS-sharp.Backend/Common/Gather.fs | 2 +- .../GraphBLAS-sharp.Backend.fsproj | 1 + .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 260 ++++++++++++++++++ src/GraphBLAS-sharp.Backend/Objects/ClCell.fs | 3 + 5 files changed, 290 insertions(+), 2 deletions(-) create mode 100644 src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 23dbb71a..93dca1c0 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -33,6 +33,30 @@ module ClArray = outputArray + let assignManyInit (clContext: ClContext) workGroupSize (initializer: Expr 'a>) = + + let init = + <@ fun (range: Range1D) indicesLength (indices: ClArray) (outputBuffer: ClArray<'a>) -> + + let gid = range.GlobalID0 + + if gid < indicesLength then + let targetIndex = indices.[gid] + + outputBuffer.[targetIndex] <- (%initializer) gid @> + + let program = clContext.Compile(init) + + fun (processor: MailboxProcessor<_>) (indices: ClArray) (result: ClArray<'a>) -> + + let kernel = program.GetKernel() + + let ndRange = + Range1D.CreateValid(indices.Length, workGroupSize) + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange indices.Length indices result)) + processor.Post(Msg.CreateRunMsg<_, _> kernel) + let create (clContext: ClContext) workGroupSize = let create = @@ -62,7 +86,7 @@ module ClArray = outputArray - let zeroCreate (clContext: ClContext) workGroupSize = + let zeroCreate<'a> (clContext: ClContext) workGroupSize = let create = create clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs index 3d70bd3c..9898acee 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Gather.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Backend.Common.Gather +namespace GraphBLAS.FSharp.Backend.Common open Brahma.FSharp diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 9d6cd576..e7c11824 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -40,6 +40,7 @@ + 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..121a8ec0 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -0,0 +1,260 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.CSRMatrix.SpGEMM + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Predefined +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClCell + +type Indices = ClArray + +type Values<'a> = ClArray<'a> + +module Expand = + /// + /// Get the number of non-zero elements for each row of the right matrix for non-zero item in left matrix. + /// + let requiredRawsLengths = + <@ fun gid (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) -> + let columnIndex = leftMatrixColumnsIndices.[gid] + let startRawIndex = rightMatrixRawPointers.[columnIndex] + let exclusiveRawEndIndex = rightMatrixRawPointers.[columnIndex + 1] + + exclusiveRawEndIndex - startRawIndex @> + + /// + /// Get the pointer to right matrix raw for each non-zero in left matrix. + /// + let requiredRawPointers = + <@ fun gid (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) -> + let columnIndex = leftMatrixColumnsIndices.[gid] + let startRawIndex = rightMatrixRawPointers.[columnIndex] + + startRawIndex @> + + let processLeftMatrixColumnsAndRightMatrixRawPointers (clContext: ClContext) workGroupSize writeOperation = + + let kernel = + <@ fun (ndRange: Range1D) columnsLength (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) (result: Indices) -> + + let gid = ndRange.GlobalID0 + + if gid < columnsLength then + result.[gid] <- (%writeOperation) gid leftMatrixColumnsIndices rightMatrixRawPointers @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) -> + let resultLength = leftMatrixColumnsIndices.Length + + let requiredRawsLengths = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let kernel = kernel.GetKernel() + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + leftMatrixColumnsIndices + rightMatrixRawPointers + requiredRawsLengths) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + requiredRawsLengths + + let getGlobalPositions (clContext: ClContext) workGroupSize = + + let zeroCreate = ClArray.zeroCreate clContext workGroupSize + + let assignUnits = ClArray.assignManyInit clContext workGroupSize <@ fun _ -> 1 @> + + let prefixSum = PrefixSum.standardIncludeInplace clContext workGroupSize + + fun (processor: MailboxProcessor<_>) resultLength (globalRightMatrixValuesPositions: Indices) -> + + /// We get an array of zeros + let globalPositions = zeroCreate processor DeviceOnly resultLength + + // Insert units at the beginning of new lines (source positions) + assignUnits processor globalRightMatrixValuesPositions globalPositions + + // Apply the prefix sum, + // get an array where different sub-arrays of pointers to elements of the same row differ in values + (prefixSum processor globalPositions).Free processor + + globalPositions + + let getRightMatrixPointers (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) length (globalRightMatrixValuesPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) (result: Indices) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + // index corresponding to the position of pointers + let positionIndex = globalPositions.[gid] - 1 + + // the position of the beginning of a new line of pointers + let sourcePosition = globalRightMatrixValuesPositions.[positionIndex] + + // offset from the source pointer + let offsetFromSourcePosition = gid - sourcePosition + + // pointer to the first element in the row of the right matrix from which + // the offset will be counted to get pointers to subsequent elements in this row + let sourcePointer = requiredRightMatrixValuesPointers.[positionIndex] + + // adding up the mix with the source pointer, + // we get a pointer to a specific element in the raw + result.[gid] <- sourcePointer + offsetFromSourcePosition @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (resultLength: int) (globalRightMatrixValuesPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) -> + + let globalRightMatrixValuesPointers = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let kernel = kernel.GetKernel() + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + globalRightMatrixValuesPositions + requiredRightMatrixValuesPointers + globalPositions + globalRightMatrixValuesPointers) + ) + + processor.Post <| Msg.CreateRunMsg<_, _> kernel + processor.Post <| Msg.CreateFreeMsg globalPositions + + globalRightMatrixValuesPointers + + let getLeftMatrixValuesCorrespondinglyToPositionsPattern<'a> (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) globalLength (globalPositions: Indices) (rightMatrixValues: ClArray<'a>) (result: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + + if gid < globalLength then + let valuePosition = globalPositions.[gid] - 1 + + result.[gid] <- rightMatrixValues.[valuePosition]@> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (globalLength: int) (globalPositions: Indices) (rightMatrixValues: Values<'a>)-> + + // globalLength == globalPositions.Length + let resultLeftMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) + + let kernel = kernel.GetKernel() + + let ndRange = + Range1D.CreateValid(globalLength, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + globalLength + globalPositions + rightMatrixValues + resultLeftMatrixValues) + ) + + processor.Post <| Msg.CreateRunMsg<_, _> kernel + processor.Post <| Msg.CreateFreeMsg globalPositions + + resultLeftMatrixValues + + let run (clContext: ClContext) workGroupSize multiplication = + + let getRequiredRawsLengths = + processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawsLengths + + let prefixSumExclude = + PrefixSum.standardExcludeInplace clContext workGroupSize + + let getRequiredRightMatrixValuesPointers = + processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawPointers + + let getRightMatrixValuesPointers = + getRightMatrixPointers clContext workGroupSize + + let getGlobalPositions = getGlobalPositions clContext workGroupSize + + let gatherRightMatrixData = Gather.run clContext workGroupSize + + let gatherIndices = Gather.run clContext workGroupSize + + let getLeftMatrixValues = + getLeftMatrixValuesCorrespondinglyToPositionsPattern clContext workGroupSize + + let map2 = ClArray.map2 clContext workGroupSize multiplication + + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + + let requiredRawsLengths = + getRequiredRawsLengths processor leftMatrix.Columns rightMatrix.RowPointers + + // global expanded array length + let globalLength = + (prefixSumExclude processor requiredRawsLengths).ToHostAndFree processor + + // since prefix sum include + // positions in global array for right matrix + let globalRightMatrixValuesRawsStartPositions = requiredRawsLengths + + // pointers to required raws in right matrix values + let requiredRightMatrixValuesPointers = + getRequiredRightMatrixValuesPointers processor leftMatrix.Columns rightMatrix.RowPointers + + // bitmap to distinguish different raws in a general array + let globalPositions = + getGlobalPositions processor globalLength globalRightMatrixValuesRawsStartPositions + + // extended pointers to all required right matrix numbers + let globalRightMatrixValuesPointers = + getRightMatrixValuesPointers processor globalLength globalPositions globalRightMatrixValuesRawsStartPositions requiredRightMatrixValuesPointers + + // gather all required right matrix values + let extendedRightMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) + + gatherRightMatrixData processor globalRightMatrixValuesPointers rightMatrix.Values extendedRightMatrixValues + + // gather all required right matrix column indices + let extendedRightMatrixColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) + + gatherIndices processor globalRightMatrixValuesPointers rightMatrix.Columns extendedRightMatrixColumns + + // left matrix values correspondingly to right matrix values + let extendedLeftMatrixValues = + getLeftMatrixValues processor globalLength globalPositions rightMatrix.Values + + let multiplicationResult = + map2 processor DeviceOnly extendedLeftMatrixValues extendedRightMatrixValues + + multiplicationResult, extendedRightMatrixColumns diff --git a/src/GraphBLAS-sharp.Backend/Objects/ClCell.fs b/src/GraphBLAS-sharp.Backend/Objects/ClCell.fs index 5d6d1dc6..05b36efd 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ClCell.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ClCell.fs @@ -11,3 +11,6 @@ module ClCell = processor.Post(Msg.CreateFreeMsg<_>(this)) res.[0] + + member this.Free(processor: MailboxProcessor<_>) = + processor.Post(Msg.CreateFreeMsg<_>(this)) From f77b4d2487db0ac18dfcc293b1391264cc40a502 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 13 Mar 2023 11:13:15 +0300 Subject: [PATCH 03/33] add: requiredRawsLengths test --- .../GraphBLAS-sharp.Backend.fsproj | 2 +- .../Matrix/CSRMatrix/CSRMatrix.fs | 2 +- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 63 +++++++-- .../CSRMatrix/{SpGEMM.fs => SpGEMMMasked.fs} | 2 +- .../GraphBLAS-sharp.Tests.fsproj | 1 + .../Matrix/SpGEMM/Expand.fs | 66 ++++++++++ tests/GraphBLAS-sharp.Tests/Program.fs | 121 +++++++++--------- 7 files changed, 183 insertions(+), 74 deletions(-) rename src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/{SpGEMM.fs => SpGEMMMasked.fs} (99%) create mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index e7c11824..c88a73ff 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -38,7 +38,7 @@ - + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs index 21882051..f11d9fff 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/CSRMatrix.fs @@ -250,7 +250,7 @@ module CSRMatrix = = let run = - SpGEMM.run clContext workGroupSize opAdd opMul + SpGEMMMasked.run clContext workGroupSize opAdd opMul fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 121a8ec0..32298577 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Backend.Matrix.CSRMatrix.SpGEMM +namespace GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common @@ -6,6 +6,7 @@ open GraphBLAS.FSharp.Backend.Predefined open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClCell +open FSharp.Quotations type Indices = ClArray @@ -143,7 +144,6 @@ module Expand = ) processor.Post <| Msg.CreateRunMsg<_, _> kernel - processor.Post <| Msg.CreateFreeMsg globalPositions globalRightMatrixValuesPointers @@ -157,7 +157,7 @@ module Expand = if gid < globalLength then let valuePosition = globalPositions.[gid] - 1 - result.[gid] <- rightMatrixValues.[valuePosition]@> + result.[gid] <- rightMatrixValues.[valuePosition] @> let kernel = clContext.Compile kernel @@ -184,11 +184,51 @@ module Expand = ) processor.Post <| Msg.CreateRunMsg<_, _> kernel - processor.Post <| Msg.CreateFreeMsg globalPositions resultLeftMatrixValues - let run (clContext: ClContext) workGroupSize multiplication = + let getResultRowPointers (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) length (leftMatrixRowPointers: Indices) (globalArrayRightMatrixRawPointers: Indices) (result: Indices) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + let rowPointer = leftMatrixRowPointers.[gid] + let globalPointer = globalArrayRightMatrixRawPointers.[rowPointer] + + result.[gid] <- globalPointer + @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (leftMatrixRowPointers: Indices) (globalArrayRightMatrixRawPointers: Indices) -> + + let result = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrixRowPointers.Length) + + let kernel = kernel.GetKernel() + + let ndRange = + Range1D.CreateValid( leftMatrixRowPointers.Length, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + leftMatrixRowPointers.Length + leftMatrixRowPointers + globalArrayRightMatrixRawPointers + result) + ) + + processor.Post <| Msg.CreateRunMsg<_, _> kernel + + result + + let run (clContext: ClContext) workGroupSize (multiplication: Expr<'a -> 'b -> 'c>) = let getRequiredRawsLengths = processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawsLengths @@ -199,11 +239,11 @@ module Expand = let getRequiredRightMatrixValuesPointers = processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawPointers + let getGlobalPositions = getGlobalPositions clContext workGroupSize + let getRightMatrixValuesPointers = getRightMatrixPointers clContext workGroupSize - let getGlobalPositions = getGlobalPositions clContext workGroupSize - let gatherRightMatrixData = Gather.run clContext workGroupSize let gatherIndices = Gather.run clContext workGroupSize @@ -213,6 +253,8 @@ module Expand = let map2 = ClArray.map2 clContext workGroupSize multiplication + let getRawPointers = getResultRowPointers clContext workGroupSize + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> let requiredRawsLengths = @@ -252,9 +294,12 @@ module Expand = // left matrix values correspondingly to right matrix values let extendedLeftMatrixValues = - getLeftMatrixValues processor globalLength globalPositions rightMatrix.Values + getLeftMatrixValues processor globalLength globalPositions leftMatrix.Values let multiplicationResult = map2 processor DeviceOnly extendedLeftMatrixValues extendedRightMatrixValues - multiplicationResult, extendedRightMatrixColumns + let rowPointers = + getRawPointers processor leftMatrix.RowPointers globalRightMatrixValuesRawsStartPositions + + multiplicationResult, extendedRightMatrixColumns, rowPointers diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs similarity index 99% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs index cbcfbeb4..b2575e73 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs @@ -9,7 +9,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell -module internal SpGEMM = +module internal SpGEMMMasked = let private calculate (context: ClContext) workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 14bbf3ff..81d96de0 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -45,6 +45,7 @@ + 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..21639fee --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs @@ -0,0 +1,66 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM.Expand + +open GraphBLAS.FSharp.Objects.Matrix +open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open Expecto + +let context = Context.defaultContext + +/// +/// Left matrix +/// +/// +/// [ 0 0 2 3 0 +/// 0 0 0 0 0 +/// 0 8 0 5 4 +/// 0 0 2 0 0 +/// 1 7 0 0 0 ] +/// +let leftMatrix = + { RowCount = 5 + ColumnCount = 5 + RowPointers = [| 0; 2; 2; 5; 6; 8 |] + ColumnIndices = [| 2; 3; 1; 3; 4; 2; 0; 1|] + Values = [| 2; 3; 8; 5; 4; 2; 1; 7 |] } + +/// +/// Right matrix +/// +/// +/// [ 0 0 0 0 0 0 0 +/// 0 3 0 0 4 0 4 +/// 0 0 2 0 0 2 0 +/// 0 5 0 0 0 9 1 +/// 0 0 0 0 1 0 8 ] +/// +let rightMatrix = + { RowCount = 5 + ColumnCount = 7 + RowPointers = [| 0; 0; 3; 5; 8; 10 |] + ColumnIndices = [| 1; 4; 6; 2; 5; 1; 5; 6; 4; 6 |] + Values = [| 3; 4; 4; 2; 2; 5; 9; 1; 1; 8 |] } + +let requiredRowLength = + testCase "requiredRowLength" + <| fun () -> + let clContext = context.ClContext + let processor = context.Queue + + let deviceLeftMatrix = leftMatrix.ToDevice clContext + let deviceRightMatrix = rightMatrix.ToDevice clContext + + let getRequiredRawsLengths = + Expand.processLeftMatrixColumnsAndRightMatrixRawPointers clContext Utils.defaultWorkGroupSize Expand.requiredRawsLengths + + let requiredRawsLengths = + getRequiredRawsLengths processor deviceLeftMatrix.Columns deviceRightMatrix.RowPointers + + let requiredRawsLengthsHost = requiredRawsLengths.ToHost processor + + "Results must be the same" + |> Expect.equal requiredRawsLengthsHost [| 2; 3; 3; 3; 2; 2; 0; 3 |] + + + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 719aad6f..45e68ee1 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,73 +1,70 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend -let matrixTests = - testList - "Matrix tests" - [ Matrix.Convert.tests - Matrix.Map2.addTests - Matrix.Map2.addAtLeastOneTests - Matrix.Map2.mulAtLeastOneTests - Matrix.Map2.addAtLeastOneToCOOTests - Matrix.Mxm.tests - Matrix.Transpose.tests ] - |> testSequenced - -let commonTests = - let clArrayTests = - testList - "ClArray" - [ Common.ClArray.PrefixSum.tests - Common.ClArray.RemoveDuplicates.tests - Common.ClArray.Copy.tests - Common.ClArray.Replicate.tests - Common.ClArray.Exists.tests - Common.ClArray.Map.tests - Common.ClArray.Map2.addTests - Common.ClArray.Map2.mulTests - Common.ClArray.Choose.tests ] - - testList - "Common tests" - [ clArrayTests - Common.BitonicSort.tests - Common.Scatter.tests - Common.Reduce.tests - Common.Sum.tests ] - |> testSequenced - -let vectorTests = - testList - "Vector tests" - [ Vector.SpMV.tests - Vector.ZeroCreate.tests - Vector.OfList.tests - Vector.Copy.tests - Vector.Convert.tests - Vector.Map2.addTests - Vector.Map2.mulTests - Vector.Map2.addAtLeastOneTests - Vector.Map2.mulAtLeastOneTests - Vector.Map2.addGeneralTests - Vector.Map2.mulGeneralTests - Vector.Map2.complementedGeneralTests - Vector.AssignByMask.tests - Vector.AssignByMask.complementedTests - Vector.Reduce.tests ] - |> testSequenced - -let algorithmsTests = - testList "Algorithms tests" [ Algorithms.BFS.tests ] - |> testSequenced +// let matrixTests = +// testList +// "Matrix tests" +// [ Matrix.Convert.tests +// Matrix.Map2.addTests +// Matrix.Map2.addAtLeastOneTests +// Matrix.Map2.mulAtLeastOneTests +// Matrix.Map2.addAtLeastOneToCOOTests +// Matrix.Mxm.tests +// Matrix.Transpose.tests ] +// |> testSequenced +// +// let commonTests = +// let clArrayTests = +// testList +// "ClArray" +// [ Common.ClArray.PrefixSum.tests +// Common.ClArray.RemoveDuplicates.tests +// Common.ClArray.Copy.tests +// Common.ClArray.Replicate.tests +// Common.ClArray.Exists.tests +// Common.ClArray.Map.tests +// Common.ClArray.Map2.addTests +// Common.ClArray.Map2.mulTests +// Common.ClArray.Choose.tests ] +// +// testList +// "Common tests" +// [ clArrayTests +// Common.BitonicSort.tests +// Common.Scatter.tests +// Common.Reduce.tests +// Common.Sum.tests ] +// |> testSequenced +// +// let vectorTests = +// testList +// "Vector tests" +// [ Vector.SpMV.tests +// Vector.ZeroCreate.tests +// Vector.OfList.tests +// Vector.Copy.tests +// Vector.Convert.tests +// Vector.Map2.addTests +// Vector.Map2.mulTests +// Vector.Map2.addAtLeastOneTests +// Vector.Map2.mulAtLeastOneTests +// Vector.Map2.addGeneralTests +// Vector.Map2.mulGeneralTests +// Vector.Map2.complementedGeneralTests +// Vector.AssignByMask.tests +// Vector.AssignByMask.complementedTests +// Vector.Reduce.tests ] +// |> testSequenced +// +// let algorithmsTests = +// testList "Algorithms tests" [ Algorithms.BFS.tests ] +// |> testSequenced [] let allTests = testList "All tests" - [ commonTests - matrixTests - vectorTests - algorithmsTests ] + [ Matrix.SpGEMM.Expand.requiredRowLength ] |> testSequenced [] From d22621e6bcc782720e5c066e7670ac6a3a792882 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 13 Mar 2023 12:03:01 +0300 Subject: [PATCH 04/33] wip: module Expand test --- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 8 +- .../Objects/ArraysExtentions.fs | 6 ++ .../Matrix/SpGEMM/Expand.fs | 97 ++++++++++++++++--- tests/GraphBLAS-sharp.Tests/Program.fs | 7 +- 4 files changed, 102 insertions(+), 16 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 32298577..d61e0d28 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -266,7 +266,7 @@ module Expand = // since prefix sum include // positions in global array for right matrix - let globalRightMatrixValuesRawsStartPositions = requiredRawsLengths + let globalRightMatrixRawsStartPositions = requiredRawsLengths // pointers to required raws in right matrix values let requiredRightMatrixValuesPointers = @@ -274,11 +274,11 @@ module Expand = // bitmap to distinguish different raws in a general array let globalPositions = - getGlobalPositions processor globalLength globalRightMatrixValuesRawsStartPositions + getGlobalPositions processor globalLength globalRightMatrixRawsStartPositions // extended pointers to all required right matrix numbers let globalRightMatrixValuesPointers = - getRightMatrixValuesPointers processor globalLength globalPositions globalRightMatrixValuesRawsStartPositions requiredRightMatrixValuesPointers + getRightMatrixValuesPointers processor globalLength globalPositions globalRightMatrixRawsStartPositions requiredRightMatrixValuesPointers // gather all required right matrix values let extendedRightMatrixValues = @@ -300,6 +300,6 @@ module Expand = map2 processor DeviceOnly extendedLeftMatrixValues extendedRightMatrixValues let rowPointers = - getRawPointers processor leftMatrix.RowPointers globalRightMatrixValuesRawsStartPositions + getRawPointers processor leftMatrix.RowPointers globalRightMatrixRawsStartPositions multiplicationResult, extendedRightMatrixColumns, rowPointers diff --git a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs index d76b90b9..10cdd56b 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs @@ -13,6 +13,12 @@ module ArraysExtensions = let dst = Array.zeroCreate this.Length q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this, dst, ch)) + member this.ToHostAndFree(q: MailboxProcessor) = + let result = this.ToHost q + this.Dispose q + + result + member this.Size = this.Length type 'a ``[]`` with diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs index 21639fee..b8695f4f 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs @@ -5,9 +5,15 @@ open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open Expecto +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Predefined +open GraphBLAS.FSharp.Backend.Objects.ClCell let context = Context.defaultContext +let clContext = context.ClContext +let processor = context.Queue + /// /// Left matrix /// @@ -42,25 +48,94 @@ let rightMatrix = ColumnIndices = [| 1; 4; 6; 2; 5; 1; 5; 6; 4; 6 |] Values = [| 3; 4; 4; 2; 2; 5; 9; 1; 1; 8 |] } -let requiredRowLength = +let deviceLeftMatrix = leftMatrix.ToDevice clContext +let deviceRightMatrix = rightMatrix.ToDevice clContext + +let requiredRawsLengths () = + let getRequiredRawsLengths = + Expand.processLeftMatrixColumnsAndRightMatrixRawPointers clContext Utils.defaultWorkGroupSize Expand.requiredRawsLengths + + getRequiredRawsLengths processor deviceLeftMatrix.Columns deviceRightMatrix.RowPointers + +let requiredRowLengthTest = testCase "requiredRowLength" <| fun () -> - let clContext = context.ClContext - let processor = context.Queue + let actual = requiredRawsLengths().ToHostAndFree processor + + "Results must be the same" + |> Expect.equal actual [| 2; 3; 3; 3; 2; 2; 0; 3 |] + +let globalLength = + let prefixSumExclude = + PrefixSum.standardExcludeInplace clContext Utils.defaultWorkGroupSize - let deviceLeftMatrix = leftMatrix.ToDevice clContext - let deviceRightMatrix = rightMatrix.ToDevice clContext + let requiredRawsLengths = requiredRawsLengths () - let getRequiredRawsLengths = - Expand.processLeftMatrixColumnsAndRightMatrixRawPointers clContext Utils.defaultWorkGroupSize Expand.requiredRawsLengths + (prefixSumExclude processor requiredRawsLengths).ToHostAndFree processor - let requiredRawsLengths = - getRequiredRawsLengths processor deviceLeftMatrix.Columns deviceRightMatrix.RowPointers +let globalLengthTest = + testCase "global length test" + <| fun () -> Expect.equal globalLength 18 "Results must be the same" - let requiredRawsLengthsHost = requiredRawsLengths.ToHost processor +let getGlobalRightMatrixRawsStartPositions () = + let prefixSumExclude = + PrefixSum.standardExcludeInplace clContext Utils.defaultWorkGroupSize + + let requiredRawsLengths = requiredRawsLengths () + + (prefixSumExclude processor requiredRawsLengths).Free processor + + requiredRawsLengths + +let globalRightMatrixRawsStartPositionsTest = + testCase "global right matrix raws start positions" + <| fun () -> + let result = (getGlobalRightMatrixRawsStartPositions ()).ToHostAndFree processor "Results must be the same" - |> Expect.equal requiredRawsLengthsHost [| 2; 3; 3; 3; 2; 2; 0; 3 |] + |> Expect.equal result [| 0; 2; 5; 8; 11; 13; 15; 15; |] + +let getRequiredRightMatrixValuesPointers () = + let getRequiredRightMatrixValuesPointers = + Expand.processLeftMatrixColumnsAndRightMatrixRawPointers clContext Utils.defaultWorkGroupSize Expand.requiredRawPointers + getRequiredRightMatrixValuesPointers processor deviceLeftMatrix.Columns deviceRightMatrix.RowPointers +let getRequiredRightMatrixValuesPointersTest = + testCase "get required right matrix values pointers" + <| fun () -> + let result = (getRequiredRightMatrixValuesPointers ()).ToHostAndFree processor + + "Result must be the same" + |> Expect.equal result [| 3; 5; 0; 5; 8; 3; 0; 0; |] + +let getGlobalPositions () = + let getGlobalPositions = Expand.getGlobalPositions clContext Utils.defaultWorkGroupSize + + getGlobalPositions processor globalLength (getGlobalRightMatrixRawsStartPositions ()) + +let getGlobalPositionsTest = + testCase "getGlobalPositions test" + <| fun () -> + let result = (getGlobalPositions ()).ToHostAndFree processor + + "Result must be the same" + |> Expect.equal result [| 1; 1; 2; 2; 2; 3; 3; 3; 4; 4; 4; 5; 5; 6; 6; 7; 7; 7; |] + +let getRightMatrixValuesPointers () = + let getRightMatrixValuesPointers = + Expand.getRightMatrixPointers clContext Utils.defaultWorkGroupSize + + let globalPositions = getGlobalPositions () + let globalRightMatrixRawsStartPositions = getGlobalRightMatrixRawsStartPositions () + let requiredRightMatrixValuesPointers = getRequiredRightMatrixValuesPointers () + + getRightMatrixValuesPointers processor globalLength globalPositions globalRightMatrixRawsStartPositions requiredRightMatrixValuesPointers + +let rightMatrixValuesPointersTest = + testCase "RightMatrixValuesPointers" + <| fun () -> + let result = (getRightMatrixValuesPointers ()).ToHostAndFree processor + "Result must be the same" + |> Expect.equal result [| 3; 4; 5; 6; 7; 0; 1; 2; 5; 6; 7; 8; 9; 3; 4; 0; 1; 2; |] diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 45e68ee1..8c812f56 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -64,7 +64,12 @@ open GraphBLAS.FSharp.Tests.Backend let allTests = testList "All tests" - [ Matrix.SpGEMM.Expand.requiredRowLength ] + [ Matrix.SpGEMM.Expand.requiredRowLengthTest + Matrix.SpGEMM.Expand.globalLengthTest + Matrix.SpGEMM.Expand.globalRightMatrixRawsStartPositionsTest + Matrix.SpGEMM.Expand.getRequiredRightMatrixValuesPointersTest + Matrix.SpGEMM.Expand.getGlobalPositionsTest + Matrix.SpGEMM.Expand.rightMatrixValuesPointersTest ] |> testSequenced [] From 9d25601e8b314ab8d81bf06c8ae5df263a50de6a Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 13 Mar 2023 20:32:48 +0300 Subject: [PATCH 05/33] refactor: globalMap --- .../BenchmarksBFS.fs | 2 +- src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs | 2 +- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 283 +++++++++++------- .../Objects/ArraysExtentions.fs | 4 +- src/GraphBLAS-sharp.Backend/Objects/Vector.fs | 2 +- .../Matrix/SpGEMM/Expand.fs | 48 ++- tests/GraphBLAS-sharp.Tests/Program.fs | 4 +- tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs | 4 +- 8 files changed, 237 insertions(+), 112 deletions(-) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs index 618b99ca..c9e2d233 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.Free this.Processor member this.ReadMatrix() = let matrixReader = this.InputMatrixReader 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/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index d61e0d28..f7d0d2f0 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -7,6 +7,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClCell open FSharp.Quotations +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions type Indices = ClArray @@ -72,29 +73,7 @@ module Expand = requiredRawsLengths - let getGlobalPositions (clContext: ClContext) workGroupSize = - - let zeroCreate = ClArray.zeroCreate clContext workGroupSize - - let assignUnits = ClArray.assignManyInit clContext workGroupSize <@ fun _ -> 1 @> - - let prefixSum = PrefixSum.standardIncludeInplace clContext workGroupSize - - fun (processor: MailboxProcessor<_>) resultLength (globalRightMatrixValuesPositions: Indices) -> - - /// We get an array of zeros - let globalPositions = zeroCreate processor DeviceOnly resultLength - - // Insert units at the beginning of new lines (source positions) - assignUnits processor globalRightMatrixValuesPositions globalPositions - - // Apply the prefix sum, - // get an array where different sub-arrays of pointers to elements of the same row differ in values - (prefixSum processor globalPositions).Free processor - - globalPositions - - let getRightMatrixPointers (clContext: ClContext) workGroupSize = + let expandRightMatrixValuesIndices (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) length (globalRightMatrixValuesPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) (result: Indices) -> @@ -121,7 +100,7 @@ module Expand = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (resultLength: int) (globalRightMatrixValuesPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) -> + fun (processor: MailboxProcessor<_>) (resultLength: int) (globalRightMatrixRawsStartPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) -> let globalRightMatrixValuesPointers = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) @@ -137,7 +116,7 @@ module Expand = kernel.KernelFunc ndRange resultLength - globalRightMatrixValuesPositions + globalRightMatrixRawsStartPositions requiredRightMatrixValuesPointers globalPositions globalRightMatrixValuesPointers) @@ -147,46 +126,6 @@ module Expand = globalRightMatrixValuesPointers - let getLeftMatrixValuesCorrespondinglyToPositionsPattern<'a> (clContext: ClContext) workGroupSize = - - let kernel = - <@ fun (ndRange: Range1D) globalLength (globalPositions: Indices) (rightMatrixValues: ClArray<'a>) (result: ClArray<'a>) -> - - let gid = ndRange.GlobalID0 - - if gid < globalLength then - let valuePosition = globalPositions.[gid] - 1 - - result.[gid] <- rightMatrixValues.[valuePosition] @> - - let kernel = clContext.Compile kernel - - fun (processor: MailboxProcessor<_>) (globalLength: int) (globalPositions: Indices) (rightMatrixValues: Values<'a>)-> - - // globalLength == globalPositions.Length - let resultLeftMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) - - let kernel = kernel.GetKernel() - - let ndRange = - Range1D.CreateValid(globalLength, workGroupSize) - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - globalLength - globalPositions - rightMatrixValues - resultLeftMatrixValues) - ) - - processor.Post <| Msg.CreateRunMsg<_, _> kernel - - resultLeftMatrixValues - let getResultRowPointers (clContext: ClContext) workGroupSize = let kernel = @@ -228,78 +167,222 @@ module Expand = result - let run (clContext: ClContext) workGroupSize (multiplication: Expr<'a -> 'b -> 'c>) = + let getGlobalMap (clContext: ClContext) workGroupSize = - let getRequiredRawsLengths = - processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawsLengths + let zeroCreate = ClArray.zeroCreate clContext workGroupSize + + let assignUnits = ClArray.assignManyInit clContext workGroupSize <@ fun _ -> 1 @> + + let prefixSum = PrefixSum.standardIncludeInplace clContext workGroupSize + + fun (processor: MailboxProcessor<_>) resultLength (globalRightMatrixValuesPositions: Indices) -> + + /// We get an array of zeros + let globalPositions = zeroCreate processor DeviceOnly resultLength + + // Insert units at the beginning of new lines (source positions) + assignUnits processor globalRightMatrixValuesPositions globalPositions + + // Apply the prefix sum, + // get an array where different sub-arrays of pointers to elements of the same row differ in values + (prefixSum processor globalPositions).Free processor + + globalPositions + + let extractLeftMatrixRequiredValuesAndColumns (clContext: ClContext) workGroupSize = + + let getUniqueBitmap = + ClArray.getUniqueBitmap clContext workGroupSize let prefixSumExclude = PrefixSum.standardExcludeInplace clContext workGroupSize - let getRequiredRightMatrixValuesPointers = - processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawPointers + let indicesScatter = + Scatter.runInplace clContext workGroupSize - let getGlobalPositions = getGlobalPositions clContext workGroupSize + let dataScatter = + Scatter.runInplace clContext workGroupSize - let getRightMatrixValuesPointers = - getRightMatrixPointers clContext workGroupSize + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (globalRightMatrixRawsStartPositions: Indices) -> - let gatherRightMatrixData = Gather.run clContext workGroupSize + let leftMatrixRequiredPositions, resultLength = + let bitmap = + getUniqueBitmap processor DeviceOnly globalRightMatrixRawsStartPositions - let gatherIndices = Gather.run clContext workGroupSize + let length = (prefixSumExclude processor bitmap).ToHostAndFree processor - let getLeftMatrixValues = - getLeftMatrixValuesCorrespondinglyToPositionsPattern clContext workGroupSize + bitmap, length - let map2 = ClArray.map2 clContext workGroupSize multiplication + let requiredLeftMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - let getRawPointers = getResultRowPointers clContext workGroupSize + indicesScatter processor leftMatrixRequiredPositions leftMatrix.Values requiredLeftMatrixValues - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + let requiredLeftMatrixColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + dataScatter processor leftMatrixRequiredPositions leftMatrix.Columns requiredLeftMatrixColumns + + leftMatrixRequiredPositions.Free processor + + requiredLeftMatrixColumns, requiredLeftMatrixValues + + let processPositions (clContext: ClContext) workGroupSize = + + let getRequiredRawsLengths = + processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawsLengths + let removeDuplications = ClArray.removeDuplications clContext workGroupSize + + let prefixSumExclude = + PrefixSum.standardExcludeInplace clContext workGroupSize + + let extractLeftMatrixRequiredValuesAndColumns = + extractLeftMatrixRequiredValuesAndColumns clContext workGroupSize + + let getGlobalPositions = getGlobalMap clContext workGroupSize + + let getRequiredRightMatrixValuesPointers = + processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawPointers + + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + // array of required right matrix rows length obtained by left matrix columns let requiredRawsLengths = getRequiredRawsLengths processor leftMatrix.Columns rightMatrix.RowPointers - // global expanded array length + // global expanded array length (sum of previous length) let globalLength = (prefixSumExclude processor requiredRawsLengths).ToHostAndFree processor - // since prefix sum include - // positions in global array for right matrix - let globalRightMatrixRawsStartPositions = requiredRawsLengths + // rename array after side effect of prefix sum include + // positions in global array for right matrix raws with duplicates + let globalRightMatrixRowsStartPositions = requiredRawsLengths + + + /// Extract required left matrix columns and values by global right matrix pointers. + /// Then get required right matrix rows (pointers to rows) by required left matrix columns. + + // extract required left matrix columns and rows by right matrix rows positions + let requiredLeftMatrixColumns, requiredLeftMatrixValues = + extractLeftMatrixRequiredValuesAndColumns processor leftMatrix globalRightMatrixRowsStartPositions // pointers to required raws in right matrix values - let requiredRightMatrixValuesPointers = - getRequiredRightMatrixValuesPointers processor leftMatrix.Columns rightMatrix.RowPointers + // rows to be placed by globalRightMatrixRowsStartPositionsWithoutDuplicates + let requiredRightMatrixRawPointers = + getRequiredRightMatrixValuesPointers processor requiredLeftMatrixColumns rightMatrix.RowPointers - // bitmap to distinguish different raws in a general array - let globalPositions = - getGlobalPositions processor globalLength globalRightMatrixRawsStartPositions + requiredLeftMatrixColumns.Free processor - // extended pointers to all required right matrix numbers - let globalRightMatrixValuesPointers = - getRightMatrixValuesPointers processor globalLength globalPositions globalRightMatrixRawsStartPositions requiredRightMatrixValuesPointers + // remove duplications in right matrix rows positions in global extended array + let globalRightMatrixRawsPointersWithoutDuplicates = + removeDuplications processor globalRightMatrixRowsStartPositions + + globalRightMatrixRowsStartPositions.Free processor + + // int map to distinguish different raws in a general array. 1 for first, 2 for second and so forth... + let globalMap = + getGlobalPositions processor globalLength globalRightMatrixRawsPointersWithoutDuplicates + + globalMap, globalRightMatrixRawsPointersWithoutDuplicates, requiredLeftMatrixValues, requiredRightMatrixRawPointers + + let expandLeftMatrixValues (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) resultLength (globalBitmap: Indices) (leftMatrixValues: Values<'a>) (resultValues: Values<'a>) -> + + let gid = ndRange.GlobalID0 + + // globalBitmap.Length == resultValues.Length + if gid < resultLength then + let valueIndex = globalBitmap.[gid] - 1 + + resultValues.[gid] <- leftMatrixValues.[valueIndex] @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (globalMap: Indices) (leftMatrixValues: Values<'a>) -> + + let expandedLeftMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalMap.Length) + let kernel = kernel.GetKernel() + + let ndRange = + Range1D.CreateValid(globalMap.Length, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + globalMap.Length + globalMap + leftMatrixValues + expandedLeftMatrixValues) + ) + + processor.Post <| Msg.CreateRunMsg<_, _> kernel + + expandedLeftMatrixValues + + let getRightMatrixColumnsAndValues (clContext: ClContext) workGroupSize = + let gatherRightMatrixData = Gather.run clContext workGroupSize + + let gatherIndices = Gather.run clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (globalLength: int) (globalPositions: Indices) (rightMatrixValues: Values<'a>) (rightMatrixColumns: Indices) -> // gather all required right matrix values let extendedRightMatrixValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) - gatherRightMatrixData processor globalRightMatrixValuesPointers rightMatrix.Values extendedRightMatrixValues + gatherRightMatrixData processor globalPositions rightMatrixValues extendedRightMatrixValues // gather all required right matrix column indices let extendedRightMatrixColumns = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) - gatherIndices processor globalRightMatrixValuesPointers rightMatrix.Columns extendedRightMatrixColumns + gatherIndices processor globalPositions rightMatrixColumns extendedRightMatrixColumns - // left matrix values correspondingly to right matrix values + extendedRightMatrixValues, extendedRightMatrixColumns + + let run (clContext: ClContext) workGroupSize (multiplication: Expr<'a -> 'b -> 'c>) = + + let processPositions = processPositions clContext workGroupSize + + let getRightMatrixValuesPointers = + expandRightMatrixValuesIndices clContext workGroupSize + + let getRightMatrixColumnsAndValues = + getRightMatrixColumnsAndValues clContext workGroupSize + + let expandLeftMatrixValues = + expandLeftMatrixValues clContext workGroupSize + + let map2 = ClArray.map2 clContext workGroupSize multiplication + + let getRawPointers = getResultRowPointers clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers + = processPositions processor leftMatrix rightMatrix + + // left matrix values correspondingly to right matrix values // TODO() let extendedLeftMatrixValues = - getLeftMatrixValues processor globalLength globalPositions leftMatrix.Values + expandLeftMatrixValues processor globalMap leftMatrix.Values + let resultRowPointers = + getRawPointers processor leftMatrix.RowPointers globalRightMatrixRowsPointers + + // extended pointers to all required right matrix numbers + let globalRightMatrixValuesPointers = + getRightMatrixValuesPointers processor globalMap.Length globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap + + let extendedRightMatrixValues, extendedRightMatrixColumns = + getRightMatrixColumnsAndValues processor globalMap.Length globalRightMatrixValuesPointers rightMatrix.Values rightMatrix.Columns + + /// Multiplication let multiplicationResult = map2 processor DeviceOnly extendedLeftMatrixValues extendedRightMatrixValues - let rowPointers = - getRawPointers processor leftMatrix.RowPointers globalRightMatrixRawsStartPositions - - multiplicationResult, extendedRightMatrixColumns, rowPointers + multiplicationResult, extendedRightMatrixColumns, resultRowPointers diff --git a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs index 10cdd56b..d9f7a545 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs @@ -5,7 +5,7 @@ open Brahma.FSharp module ArraysExtensions = type ClArray<'a> with - member this.Dispose(q: MailboxProcessor) = + member this.Free(q: MailboxProcessor) = q.Post(Msg.CreateFreeMsg this) q.PostAndReply(Msg.MsgNotifyMe) @@ -15,7 +15,7 @@ module ArraysExtensions = member this.ToHostAndFree(q: MailboxProcessor) = let result = this.ToHost q - this.Dispose q + this.Free q result diff --git a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs index 4e9f3b33..c1d75282 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.Free(q) diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs index b8695f4f..7c0e3a55 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs @@ -8,6 +8,7 @@ open Expecto open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Predefined open GraphBLAS.FSharp.Backend.Objects.ClCell +open GraphBLAS.FSharp.Backend.Objects.ClContext let context = Context.defaultContext @@ -28,7 +29,7 @@ let leftMatrix = { RowCount = 5 ColumnCount = 5 RowPointers = [| 0; 2; 2; 5; 6; 8 |] - ColumnIndices = [| 2; 3; 1; 3; 4; 2; 0; 1|] + ColumnIndices = [| 2; 3; 1; 3; 4; 2; 0; 1 |] Values = [| 2; 3; 8; 5; 4; 2; 1; 7 |] } /// @@ -110,7 +111,7 @@ let getRequiredRightMatrixValuesPointersTest = |> Expect.equal result [| 3; 5; 0; 5; 8; 3; 0; 0; |] let getGlobalPositions () = - let getGlobalPositions = Expand.getGlobalPositions clContext Utils.defaultWorkGroupSize + let getGlobalPositions = Expand.getGlobalMap clContext Utils.defaultWorkGroupSize getGlobalPositions processor globalLength (getGlobalRightMatrixRawsStartPositions ()) @@ -124,13 +125,13 @@ let getGlobalPositionsTest = let getRightMatrixValuesPointers () = let getRightMatrixValuesPointers = - Expand.getRightMatrixPointers clContext Utils.defaultWorkGroupSize + Expand.expandRightMatrixValuesIndices clContext Utils.defaultWorkGroupSize let globalPositions = getGlobalPositions () let globalRightMatrixRawsStartPositions = getGlobalRightMatrixRawsStartPositions () let requiredRightMatrixValuesPointers = getRequiredRightMatrixValuesPointers () - getRightMatrixValuesPointers processor globalLength globalPositions globalRightMatrixRawsStartPositions requiredRightMatrixValuesPointers + getRightMatrixValuesPointers processor globalLength globalRightMatrixRawsStartPositions requiredRightMatrixValuesPointers globalPositions let rightMatrixValuesPointersTest = testCase "RightMatrixValuesPointers" @@ -139,3 +140,42 @@ let rightMatrixValuesPointersTest = "Result must be the same" |> Expect.equal result [| 3; 4; 5; 6; 7; 0; 1; 2; 5; 6; 7; 8; 9; 3; 4; 0; 1; 2; |] + +let gatherRightMatrixData () = + let getRightMatrixColumnsAndValues = + Expand.getRightMatrixColumnsAndValues clContext Utils.defaultWorkGroupSize + + let rightMatrixValuesPointers = getRightMatrixValuesPointers () + + getRightMatrixColumnsAndValues processor globalLength rightMatrixValuesPointers deviceRightMatrix.Values deviceRightMatrix.Columns + +let checkGatherRightMatrixData = + testCase "gather right matrix data test" + <| fun () -> + let values, columns = gatherRightMatrixData () + + let hostValues = values.ToHostAndFree processor + + "Result must be the same" + |> Expect.equal hostValues [| 2; 2; 5; 9; 1; 3; 4; 4; 5; 9; 1; 1; 8; 2; 2; 3; 4; 4; |] + + let hostColumns = columns.ToHostAndFree processor + + "Result must be the same" + |> Expect.equal hostColumns [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] + +let getLeftMatrixValues () = + let getLeftMatrixValues = + Expand.getLeftMatrixValuesCorrespondinglyToPositionsPattern clContext Utils.defaultWorkGroupSize + + let globalPositions = getGlobalPositions () + + getLeftMatrixValues processor globalLength globalPositions deviceLeftMatrix.Values + +let getLeftMatrixValuesTest = + testCase "get left matrix values" + <| fun () -> + let result = (getLeftMatrixValues ()).ToHostAndFree processor + + "Left matrix values must be the same" + |> Expect.equal result [| 2; 2; 3; 3; 3; 8; 8; 8; 5; 5; 5; 4; 4; 2; 2; 7; 7; 7 |] diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 8c812f56..1264d30b 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -69,7 +69,9 @@ let allTests = Matrix.SpGEMM.Expand.globalRightMatrixRawsStartPositionsTest Matrix.SpGEMM.Expand.getRequiredRightMatrixValuesPointersTest Matrix.SpGEMM.Expand.getGlobalPositionsTest - Matrix.SpGEMM.Expand.rightMatrixValuesPointersTest ] + Matrix.SpGEMM.Expand.rightMatrixValuesPointersTest + Matrix.SpGEMM.Expand.checkGatherRightMatrixData + Matrix.SpGEMM.Expand.getLeftMatrixValuesTest ] |> testSequenced [] diff --git a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs index 90d90ef4..1ce37add 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs @@ -76,9 +76,9 @@ let correctnessGenericTest let res = spMV testContext.Queue HostInterop m v (ClMatrix.CSR m).Dispose q - v.Dispose q + v.Free q let hostRes = res.ToHost q - res.Dispose q + res.Free q checkResult isEqual sumOp mulOp zero matrix vector hostRes | _ -> failwith "Impossible" From 54798164668146d43f29ee5d136de4ad4a883202 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 14 Mar 2023 00:01:19 +0300 Subject: [PATCH 06/33] add: Expand stage --- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 254 +++++++++--------- .../Matrix/SpGEMM/Expand.fs | 178 ++++++------ tests/GraphBLAS-sharp.Tests/Program.fs | 14 +- 3 files changed, 226 insertions(+), 220 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index f7d0d2f0..6f8681ae 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -73,99 +73,43 @@ module Expand = requiredRawsLengths - let expandRightMatrixValuesIndices (clContext: ClContext) workGroupSize = - - let kernel = - <@ fun (ndRange: Range1D) length (globalRightMatrixValuesPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) (result: Indices) -> + let extractLeftMatrixRequiredValuesAndColumns (clContext: ClContext) workGroupSize = - let gid = ndRange.GlobalID0 + let getUniqueBitmap = + ClArray.getUniqueBitmap clContext workGroupSize - if gid < length then - // index corresponding to the position of pointers - let positionIndex = globalPositions.[gid] - 1 + let prefixSumExclude = + PrefixSum.standardExcludeInplace clContext workGroupSize - // the position of the beginning of a new line of pointers - let sourcePosition = globalRightMatrixValuesPositions.[positionIndex] + let indicesScatter = + Scatter.runInplace clContext workGroupSize - // offset from the source pointer - let offsetFromSourcePosition = gid - sourcePosition + let dataScatter = + Scatter.runInplace clContext workGroupSize - // pointer to the first element in the row of the right matrix from which - // the offset will be counted to get pointers to subsequent elements in this row - let sourcePointer = requiredRightMatrixValuesPointers.[positionIndex] + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (globalRightMatrixRawsStartPositions: Indices) -> - // adding up the mix with the source pointer, - // we get a pointer to a specific element in the raw - result.[gid] <- sourcePointer + offsetFromSourcePosition @> + let leftMatrixRequiredPositions, resultLength = + let bitmap = + getUniqueBitmap processor DeviceOnly globalRightMatrixRawsStartPositions - let kernel = clContext.Compile kernel + let length = (prefixSumExclude processor bitmap).ToHostAndFree processor - fun (processor: MailboxProcessor<_>) (resultLength: int) (globalRightMatrixRawsStartPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) -> + bitmap, length - let globalRightMatrixValuesPointers = + let requiredLeftMatrixValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - let kernel = kernel.GetKernel() - - let ndRange = - Range1D.CreateValid(resultLength, workGroupSize) - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - globalRightMatrixRawsStartPositions - requiredRightMatrixValuesPointers - globalPositions - globalRightMatrixValuesPointers) - ) - - processor.Post <| Msg.CreateRunMsg<_, _> kernel - - globalRightMatrixValuesPointers - - let getResultRowPointers (clContext: ClContext) workGroupSize = - - let kernel = - <@ fun (ndRange: Range1D) length (leftMatrixRowPointers: Indices) (globalArrayRightMatrixRawPointers: Indices) (result: Indices) -> - - let gid = ndRange.GlobalID0 - - if gid < length then - let rowPointer = leftMatrixRowPointers.[gid] - let globalPointer = globalArrayRightMatrixRawPointers.[rowPointer] - - result.[gid] <- globalPointer - @> - - let kernel = clContext.Compile kernel - - fun (processor: MailboxProcessor<_>) (leftMatrixRowPointers: Indices) (globalArrayRightMatrixRawPointers: Indices) -> - - let result = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrixRowPointers.Length) - - let kernel = kernel.GetKernel() + indicesScatter processor leftMatrixRequiredPositions leftMatrix.Values requiredLeftMatrixValues - let ndRange = - Range1D.CreateValid( leftMatrixRowPointers.Length, workGroupSize) + let requiredLeftMatrixColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - leftMatrixRowPointers.Length - leftMatrixRowPointers - globalArrayRightMatrixRawPointers - result) - ) + dataScatter processor leftMatrixRequiredPositions leftMatrix.Columns requiredLeftMatrixColumns - processor.Post <| Msg.CreateRunMsg<_, _> kernel + leftMatrixRequiredPositions.Free processor - result + requiredLeftMatrixColumns, requiredLeftMatrixValues let getGlobalMap (clContext: ClContext) workGroupSize = @@ -183,49 +127,56 @@ module Expand = // Insert units at the beginning of new lines (source positions) assignUnits processor globalRightMatrixValuesPositions globalPositions - // Apply the prefix sum, + // Apply the prefix sum, SIDE EFFECT!!! // get an array where different sub-arrays of pointers to elements of the same row differ in values (prefixSum processor globalPositions).Free processor globalPositions - let extractLeftMatrixRequiredValuesAndColumns (clContext: ClContext) workGroupSize = - - let getUniqueBitmap = - ClArray.getUniqueBitmap clContext workGroupSize + let getResultRowPointers (clContext: ClContext) workGroupSize = - let prefixSumExclude = - PrefixSum.standardExcludeInplace clContext workGroupSize + let kernel = + <@ fun (ndRange: Range1D) length (leftMatrixRowPointers: Indices) (globalArrayRightMatrixRawPointers: Indices) (result: Indices) -> - let indicesScatter = - Scatter.runInplace clContext workGroupSize + let gid = ndRange.GlobalID0 - let dataScatter = - Scatter.runInplace clContext workGroupSize + // do not touch the last element + if gid < length - 1 then + let rowPointer = leftMatrixRowPointers.[gid] + let globalPointer = globalArrayRightMatrixRawPointers.[rowPointer] - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (globalRightMatrixRawsStartPositions: Indices) -> + result.[gid] <- globalPointer @> - let leftMatrixRequiredPositions, resultLength = - let bitmap = - getUniqueBitmap processor DeviceOnly globalRightMatrixRawsStartPositions + let kernel = clContext.Compile kernel - let length = (prefixSumExclude processor bitmap).ToHostAndFree processor + let createResultPointersBuffer = ClArray.create clContext workGroupSize - bitmap, length + fun (processor: MailboxProcessor<_>) (globalLength: int) (leftMatrixRowPointers: Indices) (globalRightMatrixRowPointers: Indices) -> - let requiredLeftMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + // The last element must be equal to the length of the global array. + let result = + createResultPointersBuffer processor DeviceOnly leftMatrixRowPointers.Length globalLength - indicesScatter processor leftMatrixRequiredPositions leftMatrix.Values requiredLeftMatrixValues + let kernel = kernel.GetKernel() - let requiredLeftMatrixColumns = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + // do not touch the last element + let ndRange = + Range1D.CreateValid(leftMatrixRowPointers.Length - 1, workGroupSize) - dataScatter processor leftMatrixRequiredPositions leftMatrix.Columns requiredLeftMatrixColumns + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + leftMatrixRowPointers.Length + leftMatrixRowPointers + globalRightMatrixRowPointers + result) + ) - leftMatrixRequiredPositions.Free processor + processor.Post <| Msg.CreateRunMsg<_, _> kernel - requiredLeftMatrixColumns, requiredLeftMatrixValues + result let processPositions (clContext: ClContext) workGroupSize = @@ -242,6 +193,8 @@ module Expand = let getGlobalPositions = getGlobalMap clContext workGroupSize + let getRowPointers = getResultRowPointers clContext workGroupSize + let getRequiredRightMatrixValuesPointers = processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawPointers @@ -250,7 +203,7 @@ module Expand = let requiredRawsLengths = getRequiredRawsLengths processor leftMatrix.Columns rightMatrix.RowPointers - // global expanded array length (sum of previous length) + // global expanded array length (sum of previous length) SIDE EFFECT!!! let globalLength = (prefixSumExclude processor requiredRawsLengths).ToHostAndFree processor @@ -258,7 +211,6 @@ module Expand = // positions in global array for right matrix raws with duplicates let globalRightMatrixRowsStartPositions = requiredRawsLengths - /// Extract required left matrix columns and values by global right matrix pointers. /// Then get required right matrix rows (pointers to rows) by required left matrix columns. @@ -277,13 +229,70 @@ module Expand = let globalRightMatrixRawsPointersWithoutDuplicates = removeDuplications processor globalRightMatrixRowsStartPositions + // RESULT row pointers into result expanded (obtained by multiplication) array + let resultRowPointers = + getRowPointers processor globalLength leftMatrix.RowPointers globalRightMatrixRowsStartPositions + globalRightMatrixRowsStartPositions.Free processor // int map to distinguish different raws in a general array. 1 for first, 2 for second and so forth... let globalMap = getGlobalPositions processor globalLength globalRightMatrixRawsPointersWithoutDuplicates - globalMap, globalRightMatrixRawsPointersWithoutDuplicates, requiredLeftMatrixValues, requiredRightMatrixRawPointers + globalMap, globalRightMatrixRawsPointersWithoutDuplicates, requiredLeftMatrixValues, requiredRightMatrixRawPointers, resultRowPointers + + let expandRightMatrixValuesIndices (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) length (globalRightMatrixValuesPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) (result: Indices) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + // index corresponding to the position of pointers + let positionIndex = globalPositions.[gid] - 1 + + // the position of the beginning of a new line of pointers + let sourcePosition = globalRightMatrixValuesPositions.[positionIndex] + + // offset from the source pointer + let offsetFromSourcePosition = gid - sourcePosition + + // pointer to the first element in the row of the right matrix from which + // the offset will be counted to get pointers to subsequent elements in this row + let sourcePointer = requiredRightMatrixValuesPointers.[positionIndex] + + // adding up the mix with the source pointer, + // we get a pointer to a specific element in the raw + result.[gid] <- sourcePointer + offsetFromSourcePosition @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) (globalRightMatrixRawsStartPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalMap: Indices) -> + + let globalRightMatrixValuesPointers = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalMap.Length) + + let kernel = kernel.GetKernel() + + let ndRange = + Range1D.CreateValid(globalMap.Length, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + globalMap.Length + globalRightMatrixRawsStartPositions + requiredRightMatrixValuesPointers + globalMap + globalRightMatrixValuesPointers) + ) + + processor.Post <| Msg.CreateRunMsg<_, _> kernel + + globalRightMatrixValuesPointers let expandLeftMatrixValues (clContext: ClContext) workGroupSize = @@ -330,18 +339,18 @@ module Expand = let gatherIndices = Gather.run clContext workGroupSize - fun (processor: MailboxProcessor<_>) (globalLength: int) (globalPositions: Indices) (rightMatrixValues: Values<'a>) (rightMatrixColumns: Indices) -> + fun (processor: MailboxProcessor<_>) (globalPositions: Indices) (rightMatrix: ClMatrix.CSR<'a>) -> // gather all required right matrix values let extendedRightMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalPositions.Length) - gatherRightMatrixData processor globalPositions rightMatrixValues extendedRightMatrixValues + gatherRightMatrixData processor globalPositions rightMatrix.Values extendedRightMatrixValues // gather all required right matrix column indices let extendedRightMatrixColumns = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalLength) + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalPositions.Length) - gatherIndices processor globalPositions rightMatrixColumns extendedRightMatrixColumns + gatherIndices processor globalPositions rightMatrix.Columns extendedRightMatrixColumns extendedRightMatrixValues, extendedRightMatrixColumns @@ -349,37 +358,32 @@ module Expand = let processPositions = processPositions clContext workGroupSize - let getRightMatrixValuesPointers = + let expandLeftMatrixValues = + expandLeftMatrixValues clContext workGroupSize + + let expandRightMatrixValuesPointers = expandRightMatrixValuesIndices clContext workGroupSize let getRightMatrixColumnsAndValues = getRightMatrixColumnsAndValues clContext workGroupSize - let expandLeftMatrixValues = - expandLeftMatrixValues clContext workGroupSize - let map2 = ClArray.map2 clContext workGroupSize multiplication - let getRawPointers = getResultRowPointers clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers = processPositions processor leftMatrix rightMatrix - // left matrix values correspondingly to right matrix values // TODO() + // left matrix values correspondingly to right matrix values let extendedLeftMatrixValues = - expandLeftMatrixValues processor globalMap leftMatrix.Values - - let resultRowPointers = - getRawPointers processor leftMatrix.RowPointers globalRightMatrixRowsPointers + expandLeftMatrixValues processor globalMap requiredLeftMatrixValues // extended pointers to all required right matrix numbers let globalRightMatrixValuesPointers = - getRightMatrixValuesPointers processor globalMap.Length globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap + expandRightMatrixValuesPointers processor globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap let extendedRightMatrixValues, extendedRightMatrixColumns = - getRightMatrixColumnsAndValues processor globalMap.Length globalRightMatrixValuesPointers rightMatrix.Values rightMatrix.Columns + getRightMatrixColumnsAndValues processor globalRightMatrixValuesPointers rightMatrix /// Multiplication let multiplicationResult = diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs index 7c0e3a55..0890b5d9 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs @@ -6,8 +6,6 @@ open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open Expecto open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Predefined -open GraphBLAS.FSharp.Backend.Objects.ClCell open GraphBLAS.FSharp.Backend.Objects.ClContext let context = Context.defaultContext @@ -52,130 +50,136 @@ let rightMatrix = let deviceLeftMatrix = leftMatrix.ToDevice clContext let deviceRightMatrix = rightMatrix.ToDevice clContext -let requiredRawsLengths () = - let getRequiredRawsLengths = - Expand.processLeftMatrixColumnsAndRightMatrixRawPointers clContext Utils.defaultWorkGroupSize Expand.requiredRawsLengths +let processPosition () = + let processPositions = Expand.processPositions clContext Utils.defaultWorkGroupSize - getRequiredRawsLengths processor deviceLeftMatrix.Columns deviceRightMatrix.RowPointers + processPositions processor deviceLeftMatrix deviceRightMatrix -let requiredRowLengthTest = - testCase "requiredRowLength" +let processPositionsTest = + testCase "ProcessPositions test" <| fun () -> - let actual = requiredRawsLengths().ToHostAndFree processor + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers + = processPosition () - "Results must be the same" - |> Expect.equal actual [| 2; 3; 3; 3; 2; 2; 0; 3 |] + "Global map must be the same" + |> Expect.equal (globalMap.ToHostAndFree processor) [| 1; 1; 2; 2; 2; 3; 3; 3; 4; 4; 4; 5; 5; 6; 6; 7; 7; 7; |] -let globalLength = - let prefixSumExclude = - PrefixSum.standardExcludeInplace clContext Utils.defaultWorkGroupSize + "global right matrix rows pointers must be the same" + |> Expect.equal (globalRightMatrixRowsPointers.ToHostAndFree processor) [| 0; 2; 5; 8; 11; 13; 15; |] - let requiredRawsLengths = requiredRawsLengths () + "required left matrix values must be the same" + |> Expect.equal (requiredLeftMatrixValues.ToHostAndFree processor) [| 2; 3; 8; 5; 4; 2; 7; |] - (prefixSumExclude processor requiredRawsLengths).ToHostAndFree processor + "required right matrix row pointers" + |> Expect.equal (requiredRightMatrixRowPointers.ToHostAndFree processor) [| 3; 5; 0; 5; 8; 3; 0; |] -let globalLengthTest = - testCase "global length test" - <| fun () -> Expect.equal globalLength 18 "Results must be the same" + "row pointers must be the same" + |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] -let getGlobalRightMatrixRawsStartPositions () = - let prefixSumExclude = - PrefixSum.standardExcludeInplace clContext Utils.defaultWorkGroupSize +let expandLeftMatrixValues () = + let expandLeftMatrixValues = Expand.expandLeftMatrixValues clContext Utils.defaultWorkGroupSize - let requiredRawsLengths = requiredRawsLengths () + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers + = processPosition () - (prefixSumExclude processor requiredRawsLengths).Free processor + let result = expandLeftMatrixValues processor globalMap requiredLeftMatrixValues - requiredRawsLengths + globalMap.Free processor + globalRightMatrixRowsPointers.Free processor + requiredLeftMatrixValues.Free processor + requiredRightMatrixRowPointers.Free processor + resultRowPointers.Free processor -let globalRightMatrixRawsStartPositionsTest = - testCase "global right matrix raws start positions" - <| fun () -> - let result = (getGlobalRightMatrixRawsStartPositions ()).ToHostAndFree processor + result - "Results must be the same" - |> Expect.equal result [| 0; 2; 5; 8; 11; 13; 15; 15; |] +let expandLeftMatrixValuesTest = + testCase "expandLeftMatrixValues test" + <| fun () -> + let expandedLeftMatrixValues = (expandLeftMatrixValues ()).ToHostAndFree processor -let getRequiredRightMatrixValuesPointers () = - let getRequiredRightMatrixValuesPointers = - Expand.processLeftMatrixColumnsAndRightMatrixRawPointers clContext Utils.defaultWorkGroupSize Expand.requiredRawPointers + "Expand left matrix values must be the same" + |> Expect.equal expandedLeftMatrixValues [| 2; 2; 3; 3; 3; 8; 8; 8; 5; 5; 5; 4; 4; 2; 2; 7; 7; 7 |] - getRequiredRightMatrixValuesPointers processor deviceLeftMatrix.Columns deviceRightMatrix.RowPointers +let expandGlobalRightMatrixPointers () = + let expandRightMatrixValuesPointers = + Expand.expandRightMatrixValuesIndices clContext Utils.defaultWorkGroupSize -let getRequiredRightMatrixValuesPointersTest = - testCase "get required right matrix values pointers" - <| fun () -> - let result = (getRequiredRightMatrixValuesPointers ()).ToHostAndFree processor + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers = processPosition () - "Result must be the same" - |> Expect.equal result [| 3; 5; 0; 5; 8; 3; 0; 0; |] + let globalRightMatrixValuesPointers = + expandRightMatrixValuesPointers processor globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap -let getGlobalPositions () = - let getGlobalPositions = Expand.getGlobalMap clContext Utils.defaultWorkGroupSize + globalMap.Free processor + globalRightMatrixRowsPointers.Free processor + requiredLeftMatrixValues.Free processor + requiredRightMatrixRowPointers.Free processor + resultRowPointers.Free processor - getGlobalPositions processor globalLength (getGlobalRightMatrixRawsStartPositions ()) + globalRightMatrixValuesPointers -let getGlobalPositionsTest = - testCase "getGlobalPositions test" +let extendGlobalRightMatrixPointersTest = + testCase "expandRightMatrixRowPointers test " <| fun () -> - let result = (getGlobalPositions ()).ToHostAndFree processor + let expandedRowPointers = (expandGlobalRightMatrixPointers ()).ToHostAndFree processor - "Result must be the same" - |> Expect.equal result [| 1; 1; 2; 2; 2; 3; 3; 3; 4; 4; 4; 5; 5; 6; 6; 7; 7; 7; |] + "row pointers must be the same" + |> Expect.equal expandedRowPointers [| 3; 4; 5; 6; 7; 0; 1; 2; 5; 6; 7; 8; 9; 3; 4; 0; 1; 2; |] -let getRightMatrixValuesPointers () = - let getRightMatrixValuesPointers = - Expand.expandRightMatrixValuesIndices clContext Utils.defaultWorkGroupSize +let getRightMatrixValuesAndColumns () = + let getRightMatrixColumnsAndValues = + Expand.getRightMatrixColumnsAndValues clContext Utils.defaultWorkGroupSize - let globalPositions = getGlobalPositions () - let globalRightMatrixRawsStartPositions = getGlobalRightMatrixRawsStartPositions () - let requiredRightMatrixValuesPointers = getRequiredRightMatrixValuesPointers () + let globalRightMatrixValuesPointers = expandGlobalRightMatrixPointers () - getRightMatrixValuesPointers processor globalLength globalRightMatrixRawsStartPositions requiredRightMatrixValuesPointers globalPositions + getRightMatrixColumnsAndValues processor globalRightMatrixValuesPointers deviceRightMatrix -let rightMatrixValuesPointersTest = - testCase "RightMatrixValuesPointers" +let getRightMatrixValuesAndPointersTest = + testCase "expandRightMatrixValuesAndColumns" <| fun () -> - let result = (getRightMatrixValuesPointers ()).ToHostAndFree processor + let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () - "Result must be the same" - |> Expect.equal result [| 3; 4; 5; 6; 7; 0; 1; 2; 5; 6; 7; 8; 9; 3; 4; 0; 1; 2; |] + "extendedRightMatrixValues must be the same" + |> Expect.equal (extendedRightMatrixValues.ToHostAndFree processor) [| 2; 2; 5; 9; 1; 3; 4; 4; 5; 9; 1; 1; 8; 2; 2; 3; 4; 4; |] -let gatherRightMatrixData () = - let getRightMatrixColumnsAndValues = - Expand.getRightMatrixColumnsAndValues clContext Utils.defaultWorkGroupSize + "extendedRightMatrixColumns must be the same" + |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] - let rightMatrixValuesPointers = getRightMatrixValuesPointers () +let multiplication () = + let map2 = ClArray.map2 clContext Utils.defaultWorkGroupSize <@ (*) @> - getRightMatrixColumnsAndValues processor globalLength rightMatrixValuesPointers deviceRightMatrix.Values deviceRightMatrix.Columns + let expandedLeftMatrixValues = expandLeftMatrixValues () -let checkGatherRightMatrixData = - testCase "gather right matrix data test" - <| fun () -> - let values, columns = gatherRightMatrixData () + let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () + extendedRightMatrixColumns.Free processor - let hostValues = values.ToHostAndFree processor + let multiplicationResult = + map2 processor DeviceOnly expandedLeftMatrixValues extendedRightMatrixValues - "Result must be the same" - |> Expect.equal hostValues [| 2; 2; 5; 9; 1; 3; 4; 4; 5; 9; 1; 1; 8; 2; 2; 3; 4; 4; |] + expandedLeftMatrixValues.Free processor + extendedRightMatrixValues.Free processor - let hostColumns = columns.ToHostAndFree processor + multiplicationResult - "Result must be the same" - |> Expect.equal hostColumns [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] +let multiplicationTest = + testCase "multiplication test" <| fun () -> + let result = (multiplication ()).ToHostAndFree processor -let getLeftMatrixValues () = - let getLeftMatrixValues = - Expand.getLeftMatrixValuesCorrespondinglyToPositionsPattern clContext Utils.defaultWorkGroupSize + "Results must be the same" + |> Expect.equal result [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] - let globalPositions = getGlobalPositions () +let runExtendTest = + testCase "Expand.run test" <| fun () -> + let run = Expand.run clContext Utils.defaultWorkGroupSize <@ (*) @> - getLeftMatrixValues processor globalLength globalPositions deviceLeftMatrix.Values + let multiplicationResult, extendedRightMatrixColumns, resultRowPointers = + run processor deviceLeftMatrix deviceRightMatrix -let getLeftMatrixValuesTest = - testCase "get left matrix values" - <| fun () -> - let result = (getLeftMatrixValues ()).ToHostAndFree processor + "Results must be the same" + |> Expect.equal (multiplicationResult.ToHostAndFree processor) [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] + + "extendedRightMatrixColumns must be the same" + |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] + + "row pointers must be the same" + |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] - "Left matrix values must be the same" - |> Expect.equal result [| 2; 2; 3; 3; 3; 8; 8; 8; 5; 5; 5; 4; 4; 2; 2; 7; 7; 7 |] diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 1264d30b..523f9612 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -64,14 +64,12 @@ open GraphBLAS.FSharp.Tests.Backend let allTests = testList "All tests" - [ Matrix.SpGEMM.Expand.requiredRowLengthTest - Matrix.SpGEMM.Expand.globalLengthTest - Matrix.SpGEMM.Expand.globalRightMatrixRawsStartPositionsTest - Matrix.SpGEMM.Expand.getRequiredRightMatrixValuesPointersTest - Matrix.SpGEMM.Expand.getGlobalPositionsTest - Matrix.SpGEMM.Expand.rightMatrixValuesPointersTest - Matrix.SpGEMM.Expand.checkGatherRightMatrixData - Matrix.SpGEMM.Expand.getLeftMatrixValuesTest ] + [ Matrix.SpGEMM.Expand.processPositionsTest + Matrix.SpGEMM.Expand.expandLeftMatrixValuesTest + Matrix.SpGEMM.Expand.extendGlobalRightMatrixPointersTest + Matrix.SpGEMM.Expand.getRightMatrixValuesAndPointersTest + Matrix.SpGEMM.Expand.multiplicationTest + Matrix.SpGEMM.Expand.runExtendTest ] |> testSequenced [] From be13d6eafac24c2df20b955141ff00448118094d Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 16 Mar 2023 14:29:24 +0300 Subject: [PATCH 07/33] add: Expand test --- src/GraphBLAS-sharp.Backend/Common/Gather.fs | 7 +- src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 14 +- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 8 +- src/GraphBLAS-sharp/Objects/Matrix.fs | 12 +- tests/GraphBLAS-sharp.Tests/Generators.fs | 13 +- .../GraphBLAS-sharp.Tests.fsproj | 1 + tests/GraphBLAS-sharp.Tests/Helpers.fs | 57 ++++ .../Matrix/SpGEMM/Example.fs | 185 ++++++++++++ .../Matrix/SpGEMM/Expand.fs | 273 +++++++++++------- tests/GraphBLAS-sharp.Tests/Program.fs | 29 +- 10 files changed, 466 insertions(+), 133 deletions(-) create mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs index 9898acee..65d5968d 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Gather.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -17,12 +17,15 @@ module internal Gather = let run (clContext: ClContext) workGroupSize = let gather = - <@ fun (ndRange: Range1D) (positions: ClArray) (inputArray: ClArray<'a>) (outputArray: ClArray<'a>) (size: int) -> + <@ fun (ndRange: Range1D) (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) (size: int) -> let i = ndRange.GlobalID0 if i < size then - outputArray.[i] <- inputArray.[positions.[i]] @> + let position = positions.[i] + let value = values.[position] + + outputArray.[i] <- value @> let program = clContext.Compile(gather) diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index a3d54dec..840f024f 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -27,17 +27,17 @@ module internal Scatter = let run = <@ fun (ndRange: Range1D) (positions: ClArray) (positionsLength: int) (values: ClArray<'a>) (result: ClArray<'a>) (resultLength: int) -> - let i = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if i < positionsLength then - let index = positions.[i] + if gid < positionsLength then + let index = positions.[gid] if 0 <= index && index < resultLength then - if i < positionsLength - 1 then - if index <> positions.[i + 1] then - result.[index] <- values.[i] + if gid < positionsLength - 1 then + if index <> positions.[gid + 1] then + result.[index] <- values.[gid] else - result.[index] <- values.[i] @> + result.[index] <- values.[gid] @> let program = clContext.Compile(run) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 6f8681ae..93fe923c 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -230,6 +230,8 @@ module Expand = removeDuplications processor globalRightMatrixRowsStartPositions // RESULT row pointers into result expanded (obtained by multiplication) array + // printfn "GLOBAL LENGTH: %A" globalLength + let resultRowPointers = getRowPointers processor globalLength leftMatrix.RowPointers globalRightMatrixRowsStartPositions @@ -239,6 +241,8 @@ module Expand = let globalMap = getGlobalPositions processor globalLength globalRightMatrixRawsPointersWithoutDuplicates + // printfn "global clmap: %A" <| globalMap.ToHost processor + globalMap, globalRightMatrixRawsPointersWithoutDuplicates, requiredLeftMatrixValues, requiredRightMatrixRawPointers, resultRowPointers let expandRightMatrixValuesIndices (clContext: ClContext) workGroupSize = @@ -250,7 +254,7 @@ module Expand = if gid < length then // index corresponding to the position of pointers - let positionIndex = globalPositions.[gid] - 1 + let positionIndex = globalPositions.[gid] - 1 // TODO() // the position of the beginning of a new line of pointers let sourcePosition = globalRightMatrixValuesPositions.[positionIndex] @@ -303,7 +307,7 @@ module Expand = // globalBitmap.Length == resultValues.Length if gid < resultLength then - let valueIndex = globalBitmap.[gid] - 1 + let valueIndex = globalBitmap.[gid] - 1 //TODO() resultValues.[gid] <- leftMatrixValues.[valueIndex] @> 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/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 2183d0b9..b473f345 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 { @@ -384,6 +386,9 @@ module Generators = valuesGenerator |> Gen.array2DOfDim (nColsA, nColsB) + printf $"left matrix column count: %A{Array2D.length1 matrixA}" + printf $"right matrix row count: %A{Array2D.length2 matrixA}" + return (matrixA, matrixB) } diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 81d96de0..a0fa7f90 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -45,6 +45,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index bfbe4450..765b40c1 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -129,6 +129,63 @@ module Utils = result + let prefixSumExclude (array: 'a []) zero plus = + let mutable sum = zero + + for i in 0 .. array.Length - 1 do + let currentItem = array.[i] + array.[i] <- sum + + sum <- plus currentItem sum + + sum + + let prefixSumInclude (array: 'a []) zero plus = + let mutable sum = zero + + for i in 0 .. array.Length - 1 do + sum <- plus array.[i] sum + + array.[i] <- sum + + sum + + let getUniqueBitmap<'a when 'a: equality> (array: 'a []) = + let bitmap = Array.zeroCreate array.Length + + for i in 0 .. array.Length - 2 do + if array.[i] <> array.[i + 1] then bitmap.[i] <- 1 + + // set last 1 + bitmap.[bitmap.Length - 1] <- 1 + + bitmap + + let scatter (positions: int array) (values: 'a array) (resultValues: 'a array) = + for i in 0 .. positions.Length - 2 do + if positions.[i] <> positions.[i + 1] then + let valuePosition = positions.[i] + let value = values.[i] + + resultValues.[valuePosition] <- value + + // set last value + let lastPosition = positions.[positions.Length - 1] + let lastValue = values.[values.Length - 1] + + resultValues.[lastPosition] <- lastValue + + let gather (positions: int []) (values: 'a []) (result: 'a []) = + for i in 0 .. positions.Length do + let position = positions.[i] + let value = values.[position] + + result.[position] <- value + + let castMatrixToCSR = function + | Matrix.CSR matrix -> matrix + | _ -> failwith "matrix format must be CSR" + module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs new file mode 100644 index 00000000..332c2c82 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs @@ -0,0 +1,185 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM.Example + +open GraphBLAS.FSharp.Objects.Matrix +open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open Expecto +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Objects.ClContext + +let context = Context.defaultContext + +let clContext = context.ClContext +let processor = context.Queue + +/// +/// Left matrix +/// +/// +/// [ 0 0 2 3 0 +/// 0 0 0 0 0 +/// 0 8 0 5 4 +/// 0 0 2 0 0 +/// 1 7 0 0 0 ] +/// +let leftMatrix = + { RowCount = 5 + ColumnCount = 5 + RowPointers = [| 0; 2; 2; 5; 6; 8 |] + ColumnIndices = [| 2; 3; 1; 3; 4; 2; 0; 1 |] + Values = [| 2; 3; 8; 5; 4; 2; 1; 7 |] } + +/// +/// Right matrix +/// +/// +/// [ 0 0 0 0 0 0 0 +/// 0 3 0 0 4 0 4 +/// 0 0 2 0 0 2 0 +/// 0 5 0 0 0 9 1 +/// 0 0 0 0 1 0 8 ] +/// +let rightMatrix = + { RowCount = 5 + ColumnCount = 7 + RowPointers = [| 0; 0; 3; 5; 8; 10 |] + ColumnIndices = [| 1; 4; 6; 2; 5; 1; 5; 6; 4; 6 |] + Values = [| 3; 4; 4; 2; 2; 5; 9; 1; 1; 8 |] } + +let deviceLeftMatrix = leftMatrix.ToDevice clContext +let deviceRightMatrix = rightMatrix.ToDevice clContext + +let processPosition () = + let processPositions = Expand.processPositions clContext Utils.defaultWorkGroupSize + + processPositions processor deviceLeftMatrix deviceRightMatrix + +let processPositionsTest = + testCase "ProcessPositions test" + <| fun () -> + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers + = processPosition () + + "Global map must be the same" + |> Expect.equal (globalMap.ToHostAndFree processor) [| 1; 1; 2; 2; 2; 3; 3; 3; 4; 4; 4; 5; 5; 6; 6; 7; 7; 7; |] + + "global right matrix rows pointers must be the same" + |> Expect.equal (globalRightMatrixRowsPointers.ToHostAndFree processor) [| 0; 2; 5; 8; 11; 13; 15; |] + + "required left matrix values must be the same" + |> Expect.equal (requiredLeftMatrixValues.ToHostAndFree processor) [| 2; 3; 8; 5; 4; 2; 7; |] + + "required right matrix row pointers" + |> Expect.equal (requiredRightMatrixRowPointers.ToHostAndFree processor) [| 3; 5; 0; 5; 8; 3; 0; |] + + "row pointers must be the same" + |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] + +let expandLeftMatrixValues () = + let expandLeftMatrixValues = Expand.expandLeftMatrixValues clContext Utils.defaultWorkGroupSize + + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers + = processPosition () + + let result = expandLeftMatrixValues processor globalMap requiredLeftMatrixValues + + globalMap.Free processor + globalRightMatrixRowsPointers.Free processor + requiredLeftMatrixValues.Free processor + requiredRightMatrixRowPointers.Free processor + resultRowPointers.Free processor + + result + +let expandLeftMatrixValuesTest = + testCase "expandLeftMatrixValues test" + <| fun () -> + let expandedLeftMatrixValues = (expandLeftMatrixValues ()).ToHostAndFree processor + + "Expand left matrix values must be the same" + |> Expect.equal expandedLeftMatrixValues [| 2; 2; 3; 3; 3; 8; 8; 8; 5; 5; 5; 4; 4; 2; 2; 7; 7; 7 |] + +let expandGlobalRightMatrixPointers () = + let expandRightMatrixValuesPointers = + Expand.expandRightMatrixValuesIndices clContext Utils.defaultWorkGroupSize + + let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers = processPosition () + + let globalRightMatrixValuesPointers = + expandRightMatrixValuesPointers processor globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap + + globalMap.Free processor + globalRightMatrixRowsPointers.Free processor + requiredLeftMatrixValues.Free processor + requiredRightMatrixRowPointers.Free processor + resultRowPointers.Free processor + + globalRightMatrixValuesPointers + +let extendGlobalRightMatrixPointersTest = + testCase "expandRightMatrixRowPointers test " + <| fun () -> + let expandedRowPointers = (expandGlobalRightMatrixPointers ()).ToHostAndFree processor + + "row pointers must be the same" + |> Expect.equal expandedRowPointers [| 3; 4; 5; 6; 7; 0; 1; 2; 5; 6; 7; 8; 9; 3; 4; 0; 1; 2; |] + +let getRightMatrixValuesAndColumns () = + let getRightMatrixColumnsAndValues = + Expand.getRightMatrixColumnsAndValues clContext Utils.defaultWorkGroupSize + + let globalRightMatrixValuesPointers = expandGlobalRightMatrixPointers () + + getRightMatrixColumnsAndValues processor globalRightMatrixValuesPointers deviceRightMatrix + +let getRightMatrixValuesAndPointersTest = + testCase "expandRightMatrixValuesAndColumns" + <| fun () -> + let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () + + "extendedRightMatrixValues must be the same" + |> Expect.equal (extendedRightMatrixValues.ToHostAndFree processor) [| 2; 2; 5; 9; 1; 3; 4; 4; 5; 9; 1; 1; 8; 2; 2; 3; 4; 4; |] + + "extendedRightMatrixColumns must be the same" + |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] + +let multiplication () = + let map2 = ClArray.map2 clContext Utils.defaultWorkGroupSize <@ (*) @> + + let expandedLeftMatrixValues = expandLeftMatrixValues () + + let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () + extendedRightMatrixColumns.Free processor + + let multiplicationResult = + map2 processor DeviceOnly expandedLeftMatrixValues extendedRightMatrixValues + + expandedLeftMatrixValues.Free processor + extendedRightMatrixValues.Free processor + + multiplicationResult + +let multiplicationTest = + testCase "multiplication test" <| fun () -> + let result = (multiplication ()).ToHostAndFree processor + + "Results must be the same" + |> Expect.equal result [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] + +let runExtendTest = + testCase "Expand.run test" <| fun () -> + let run = Expand.run clContext Utils.defaultWorkGroupSize <@ (*) @> + + let multiplicationResult, extendedRightMatrixColumns, resultRowPointers = + run processor deviceLeftMatrix deviceRightMatrix + + "Results must be the same" + |> Expect.equal (multiplicationResult.ToHostAndFree processor) [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] + + "extendedRightMatrixColumns must be the same" + |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] + + "row pointers must be the same" + |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] + diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs index 0890b5d9..8defec14 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs @@ -1,17 +1,14 @@ module GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM.Expand -open GraphBLAS.FSharp.Objects.Matrix open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Test open GraphBLAS.FSharp.Tests -open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.Matrix open Expecto -open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Objects.ClContext - -let context = Context.defaultContext - -let clContext = context.ClContext -let processor = context.Queue +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open Brahma.FSharp /// /// Left matrix @@ -47,139 +44,209 @@ let rightMatrix = ColumnIndices = [| 1; 4; 6; 2; 5; 1; 5; 6; 4; 6 |] Values = [| 3; 4; 4; 2; 2; 5; 9; 1; 1; 8 |] } -let deviceLeftMatrix = leftMatrix.ToDevice clContext -let deviceRightMatrix = rightMatrix.ToDevice clContext +type ExpandedResult<'a> = + { Values: 'a [] + Columns: int [] + RowPointers: int [] } + +let config = { Utils.defaultConfig with arbitrary = [ typeof ] } + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let hostExpand multiplication (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'a>) = + // Pointers to start positions for right matrix rows in global array + // With duplicates which means that there is no string in the global array + let rowsPointersToGlobalArray, globalLength = + let requiredRightMatrixRowsLength = + (fun index -> + let columnIndex = leftMatrix.ColumnIndices.[index] + + let startPointer = rightMatrix.RowPointers.[columnIndex] + let endPointer = rightMatrix.RowPointers.[columnIndex + 1] + + endPointer - startPointer) + |> Array.init leftMatrix.ColumnIndices.Length + + //printfn "requiredRightMatrixRowsLength: %A" requiredRightMatrixRowsLength + + // Get right matrix row positions in global array by side effect + let globalLength = + Utils.prefixSumExclude requiredRightMatrixRowsLength 0 (+) + + //printfn "requiredRightMatrixRowsLength after prefix sum: %A" requiredRightMatrixRowsLength + + requiredRightMatrixRowsLength, globalLength + + //printfn "global length: %A" globalLength + + let resultGlobalRowPointers = + (fun index -> + if index < leftMatrix.RowPointers.Length - 1 then + let rowPointer = leftMatrix.RowPointers.[index] + + // printfn "index: %A; lenght: %A" rowPointer rowsPointersToGlobalArray.Length + + rowsPointersToGlobalArray.[rowPointer] + else + globalLength) + |> Array.init leftMatrix.RowPointers.Length + + // Right matrix row positions in global array without duplicates + let globalRightMatrixRowPositions = Array.distinct rowsPointersToGlobalArray + + //printfn "global right matrix row positions without pointers: %A" globalRightMatrixRowPositions + + // Create global map + let globalMap = + let array = + (fun index -> if Array.contains index globalRightMatrixRowPositions then 1 else 0) + |> Array.init globalLength + + Utils.prefixSumInclude array 0 (+) |> ignore + + array + + //printfn "%A" globalMap + + // get required left matrix columns and values + let requiredLeftMatrixColumns, requireLeftMatrixValues = + let positions = + Utils.getUniqueBitmap rowsPointersToGlobalArray + + let length = Utils.prefixSumExclude positions 0 (+) -let processPosition () = - let processPositions = Expand.processPositions clContext Utils.defaultWorkGroupSize + let requiredLeftMatrixColumns = Array.zeroCreate length - processPositions processor deviceLeftMatrix deviceRightMatrix + Utils.scatter positions leftMatrix.ColumnIndices requiredLeftMatrixColumns -let processPositionsTest = - testCase "ProcessPositions test" - <| fun () -> - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers - = processPosition () + // printfn "required left matrix columns: %A" requiredLeftMatrixColumns - "Global map must be the same" - |> Expect.equal (globalMap.ToHostAndFree processor) [| 1; 1; 2; 2; 2; 3; 3; 3; 4; 4; 4; 5; 5; 6; 6; 7; 7; 7; |] + let requiredLeftMatrixValues = Array.zeroCreate length - "global right matrix rows pointers must be the same" - |> Expect.equal (globalRightMatrixRowsPointers.ToHostAndFree processor) [| 0; 2; 5; 8; 11; 13; 15; |] + Utils.scatter positions leftMatrix.Values requiredLeftMatrixValues - "required left matrix values must be the same" - |> Expect.equal (requiredLeftMatrixValues.ToHostAndFree processor) [| 2; 3; 8; 5; 4; 2; 7; |] + // printfn "required left matrix values: %A" requiredLeftMatrixValues - "required right matrix row pointers" - |> Expect.equal (requiredRightMatrixRowPointers.ToHostAndFree processor) [| 3; 5; 0; 5; 8; 3; 0; |] + requiredLeftMatrixColumns, requiredLeftMatrixValues - "row pointers must be the same" - |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] + // right matrix required row pointers + let rightMatrixRequiredRowsPointers = + (fun index -> + let requiredLeftMatrixColumn = requiredLeftMatrixColumns.[index] -let expandLeftMatrixValues () = - let expandLeftMatrixValues = Expand.expandLeftMatrixValues clContext Utils.defaultWorkGroupSize + rightMatrix.RowPointers.[requiredLeftMatrixColumn]) + |> Array.init globalRightMatrixRowPositions.Length - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers - = processPosition () + //printfn "right matrix required row pointers: %A" rightMatrixRequiredRowsPointers - let result = expandLeftMatrixValues processor globalMap requiredLeftMatrixValues + let globalRequiredRightMatrixValuesIndices = + (fun index -> + let rowID = globalMap.[index] - 1 + let sourcePosition = globalRightMatrixRowPositions.[rowID] + let offset = index - sourcePosition - globalMap.Free processor - globalRightMatrixRowsPointers.Free processor - requiredLeftMatrixValues.Free processor - requiredRightMatrixRowPointers.Free processor - resultRowPointers.Free processor + rightMatrixRequiredRowsPointers.[rowID] + offset) + |> Array.init globalLength - result + //printfn "global required right matrix values: %A" globalRequiredRightMatrixValuesIndices -let expandLeftMatrixValuesTest = - testCase "expandLeftMatrixValues test" - <| fun () -> - let expandedLeftMatrixValues = (expandLeftMatrixValues ()).ToHostAndFree processor + let globalRightMatrixRequiredValues = + (fun index -> + let valueIndex = globalRequiredRightMatrixValuesIndices.[index] + rightMatrix.Values.[valueIndex]) + |> Array.init globalLength - "Expand left matrix values must be the same" - |> Expect.equal expandedLeftMatrixValues [| 2; 2; 3; 3; 3; 8; 8; 8; 5; 5; 5; 4; 4; 2; 2; 7; 7; 7 |] + let globalRightMatrixRequiredColumnIndices = + (fun index -> + let valueIndex = globalRequiredRightMatrixValuesIndices.[index] + rightMatrix.ColumnIndices.[valueIndex]) + |> Array.init globalLength -let expandGlobalRightMatrixPointers () = - let expandRightMatrixValuesPointers = - Expand.expandRightMatrixValuesIndices clContext Utils.defaultWorkGroupSize + //printfn "global required right matrix columns: %A" globalRightMatrixRequiredColumnIndices - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers = processPosition () + let globalLeftMatrixRequiredValues = + (fun index -> + let valueIndex = globalMap.[index] - 1 - let globalRightMatrixValuesPointers = - expandRightMatrixValuesPointers processor globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap + requireLeftMatrixValues.[valueIndex]) + |> Array.init globalLength - globalMap.Free processor - globalRightMatrixRowsPointers.Free processor - requiredLeftMatrixValues.Free processor - requiredRightMatrixRowPointers.Free processor - resultRowPointers.Free processor + let resultValues = + Array.map2 multiplication globalRightMatrixRequiredValues globalLeftMatrixRequiredValues - globalRightMatrixValuesPointers + { Values = resultValues + Columns = globalRightMatrixRequiredColumnIndices + RowPointers = resultGlobalRowPointers } -let extendGlobalRightMatrixPointersTest = - testCase "expandRightMatrixRowPointers test " - <| fun () -> - let expandedRowPointers = (expandGlobalRightMatrixPointers ()).ToHostAndFree processor +let checkResult multiplication leftMatrix rightMatrix actualResult = + let expected = + hostExpand multiplication leftMatrix rightMatrix - "row pointers must be the same" - |> Expect.equal expandedRowPointers [| 3; 4; 5; 6; 7; 0; 1; 2; 5; 6; 7; 8; 9; 3; 4; 0; 1; 2; |] + "Values must be the same" + |> Expect.sequenceEqual expected.Values actualResult.Values -let getRightMatrixValuesAndColumns () = - let getRightMatrixColumnsAndValues = - Expand.getRightMatrixColumnsAndValues clContext Utils.defaultWorkGroupSize + "Columns must be the same" + |> Expect.sequenceEqual expected.Columns actualResult.Columns - let globalRightMatrixValuesPointers = expandGlobalRightMatrixPointers () + "Row pointers must be the same" + |> Expect.sequenceEqual expected.RowPointers actualResult.RowPointers - getRightMatrixColumnsAndValues processor globalRightMatrixValuesPointers deviceRightMatrix + printfn "SUCCESS" -let getRightMatrixValuesAndPointersTest = - testCase "expandRightMatrixValuesAndColumns" - <| fun () -> - let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () +let makeTest isZero multiplication expand (leftArray: 'a [,], rightArray: 'a [,]) = - "extendedRightMatrixValues must be the same" - |> Expect.equal (extendedRightMatrixValues.ToHostAndFree processor) [| 2; 2; 5; 9; 1; 3; 4; 4; 5; 9; 1; 1; 8; 2; 2; 3; 4; 4; |] + let leftMatrix = + Utils.createMatrixFromArray2D CSR leftArray isZero + |> Utils.castMatrixToCSR - "extendedRightMatrixColumns must be the same" - |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] + let rightMatrix = + Utils.createMatrixFromArray2D CSR rightArray isZero + |> Utils.castMatrixToCSR -let multiplication () = - let map2 = ClArray.map2 clContext Utils.defaultWorkGroupSize <@ (*) @> + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then - let expandedLeftMatrixValues = expandLeftMatrixValues () + try + //printfn $"left matrix: %A{leftArray}" + //printfn $"right matrix: %A{rightArray}" - let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () - extendedRightMatrixColumns.Free processor + if leftMatrix.ColumnCount <> rightMatrix.RowCount then + failwith "LOLO" - let multiplicationResult = - map2 processor DeviceOnly expandedLeftMatrixValues extendedRightMatrixValues + hostExpand multiplication leftMatrix rightMatrix |> ignore - expandedLeftMatrixValues.Free processor - extendedRightMatrixValues.Free processor + let deviceLeftMatrix = + leftMatrix.ToDevice context - multiplicationResult + let deviceRightMatrix = + rightMatrix.ToDevice context -let multiplicationTest = - testCase "multiplication test" <| fun () -> - let result = (multiplication ()).ToHostAndFree processor + let (multiplicationResult: ClArray<'a>), + (extendedRightMatrixColumns: ClArray), + (resultRowPointers: ClArray) = + expand processor deviceLeftMatrix deviceRightMatrix - "Results must be the same" - |> Expect.equal result [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] + { Values = multiplicationResult.ToHostAndFree processor + Columns = extendedRightMatrixColumns.ToHostAndFree processor + RowPointers = resultRowPointers.ToHostAndFree processor } + |> checkResult multiplication leftMatrix rightMatrix + with + | ex when ex.Message = "InvalidBufferSize" -> () + | _ -> reraise () -let runExtendTest = - testCase "Expand.run test" <| fun () -> - let run = Expand.run clContext Utils.defaultWorkGroupSize <@ (*) @> +let creatTest<'a when 'a : struct and 'a : equality> (isZero: 'a -> bool) multiplicationQ multiplication = + Expand.run context Utils.defaultWorkGroupSize multiplicationQ + |> makeTest isZero multiplication + |> testPropertyWithConfig config $"Expand.run on %A{typeof<'a>}" - let multiplicationResult, extendedRightMatrixColumns, resultRowPointers = - run processor deviceLeftMatrix deviceRightMatrix +let testFixtures = + creatTest ((=) 0) <@ (*) @> (*) - "Results must be the same" - |> Expect.equal (multiplicationResult.ToHostAndFree processor) [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] +let check = + let leftMatrix = Utils.createMatrixFromArray2D CSR <| array2D [[-2; 3; -1; -3]; [2; -1; 3; -1]] - "extendedRightMatrixColumns must be the same" - |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] + let rightMatrix = Utils.createMatrixFromArray2D CSR <| array2D [[3; 0; 3; 4]; [1; -4; 1; 0]] - "row pointers must be the same" - |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] + () diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 523f9612..d77e9b5b 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.Backend.Matrix.SpGEMM // let matrixTests = // testList @@ -60,17 +61,21 @@ open GraphBLAS.FSharp.Tests.Backend // testList "Algorithms tests" [ Algorithms.BFS.tests ] // |> testSequenced -[] -let allTests = - testList - "All tests" - [ Matrix.SpGEMM.Expand.processPositionsTest - Matrix.SpGEMM.Expand.expandLeftMatrixValuesTest - Matrix.SpGEMM.Expand.extendGlobalRightMatrixPointersTest - Matrix.SpGEMM.Expand.getRightMatrixValuesAndPointersTest - Matrix.SpGEMM.Expand.multiplicationTest - Matrix.SpGEMM.Expand.runExtendTest ] - |> testSequenced +// [] +// let allTests = +// testList +// "All tests" +// [ Matrix.SpGEMM.Expand.processPositionsTest +// Matrix.SpGEMM.Expand.expandLeftMatrixValuesTest +// Matrix.SpGEMM.Expand.extendGlobalRightMatrixPointersTest +// Matrix.SpGEMM.Expand.getRightMatrixValuesAndPointersTest +// Matrix.SpGEMM.Expand.multiplicationTest +// Matrix.SpGEMM.Expand.runExtendTest ] + // |> testSequenced + + [] -let main argv = allTests |> runTestsWithCLIArgs [] argv +let main argv = Expand.testFixtures |> runTestsWithCLIArgs [] argv + + From 6da457b53008d03a4e1fb5578253e5aceb8e2305 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 27 Mar 2023 23:18:45 +0300 Subject: [PATCH 08/33] add: reduceByKey2D --- src/GraphBLAS-sharp.Backend/Common/Sum.fs | 146 +++++++++++++++++ .../Matrix/CSRMatrix/Matrix.fs | 49 ++++++ .../Common/Reduce/ReduceByKey.fs | 154 ++++++++++++++++++ tests/GraphBLAS-sharp.Tests/Helpers.fs | 10 +- tests/GraphBLAS-sharp.Tests/Program.fs | 19 +-- 5 files changed, 366 insertions(+), 12 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index bbfa8af9..ca84fab9 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -470,3 +470,149 @@ 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 diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs index ebb33542..2dcccb74 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs @@ -8,6 +8,7 @@ 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 module Matrix = let private expandRowPointers (clContext: ClContext) workGroupSize = @@ -153,3 +154,51 @@ module Matrix = fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> run queue matrixLeft matrixRight mask + + let spgemm + (clContext: ClContext) + workGroupSize + (opAdd: Expr<'c -> 'c -> 'c>) + (opMul: Expr<'a -> 'b -> 'c>) + = + + let expand = SpGEMM.Expand.run clContext workGroupSize opMul + + let expandRowPointers = expandRowPointers clContext workGroupSize + + let sortData = Sort.Radix.runByKeysStandard clContext workGroupSize + + let sortKeys = Sort.Radix.runByKeysStandard clContext workGroupSize + + let reduceByKey = Reduce.ByKey.segmentSequential clContext workGroupSize opAdd + + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + let multiplicationResult, columns, rowPointers = + expand processor leftMatrix rightMatrix + + let rows = + expandRowPointers processor DeviceOnly rowPointers columns.Length leftMatrix.RowCount + + rowPointers.Free processor + + // sorting + let sortData = sortData processor + let sortKeys = sortKeys processor + + // by columns + let valuesSortedByColumns = sortData columns multiplicationResult + let byKeSortedRows = sortKeys columns rows + + multiplicationResult.Free processor + rows.Free processor + + // by rows + let values = sortData byKeSortedRows valuesSortedByColumns + let columns = sortKeys byKeSortedRows columns + + // reduce + + + + () + diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index 6ef76e26..b0f24510 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -2,6 +2,7 @@ module GraphBLAS.FSharp.Tests.Backend.Common.Reduce.ByKey open Expecto open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Test open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Backend.Objects.ClContext open Brahma.FSharp @@ -185,3 +186,156 @@ 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) []) = + + let firstKeys, secondKeys, values = + array + |> Array.sortBy (fun (fst, snd, _) -> fst, snd) + |> Array.unzip3 + + if firstKeys.Length > 0 then + 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 sequentialSegmentTests2D = + 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 ] diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index bde711fb..ca38bf69 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -233,8 +233,8 @@ module HostPrimitives = |> Array.mapi (fun index bit -> if bit = 1 then Some index else None) |> Array.choose id - let reduceByKey keys value reduceOp = - let zipped = Array.zip keys value + let reduceByKey keys values reduceOp = + let zipped = Array.zip keys values Array.distinct keys |> Array.map @@ -247,6 +247,12 @@ module HostPrimitives = |> Array.map (fun (key, values) -> key, Array.reduce reduceOp values) |> 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 + module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 491f3935..3f47eaa1 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -90,17 +90,16 @@ open GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM // testList "Algorithms tests" [ Algorithms.BFS.tests ] // |> testSequenced // -// [] -// let allTests = -// testList -// "All tests" -// [ matrixTests -// commonTests -// vectorTests -// algorithmsTests ] -// |> testSequenced +[] +let allTests = + testList + "All tests" + [ Common.Reduce.ByKey.sequential2DTest + Common.Reduce.ByKey.sequentialSegmentTests2D ] + + |> testSequenced [] -let main argv = Expand.testFixtures |> runTestsWithCLIArgs [] argv +let main argv = allTests |> runTestsWithCLIArgs [] argv From 66c2711cf23ba85b71a7ff666b26aa70ed3e4d28 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 1 Apr 2023 17:08:40 +0300 Subject: [PATCH 09/33] refactor: wip --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 54 +-- .../Matrix/CSRMatrix/Matrix.fs | 48 +-- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 375 ++---------------- src/GraphBLAS-sharp.Backend/Quotes/Map.fs | 4 + 4 files changed, 76 insertions(+), 405 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 8b241511..fe562625 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -5,6 +5,7 @@ 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 module ClArray = let init (clContext: ClContext) workGroupSize (initializer: Expr 'a>) = @@ -33,30 +34,6 @@ module ClArray = outputArray - let assignManyInit (clContext: ClContext) workGroupSize (initializer: Expr 'a>) = - - let init = - <@ fun (range: Range1D) indicesLength (indices: ClArray) (outputBuffer: ClArray<'a>) -> - - let gid = range.GlobalID0 - - if gid < indicesLength then - let targetIndex = indices.[gid] - - outputBuffer.[targetIndex] <- (%initializer) gid @> - - let program = clContext.Compile(init) - - fun (processor: MailboxProcessor<_>) (indices: ClArray) (result: ClArray<'a>) -> - - let kernel = program.GetKernel() - - let ndRange = - Range1D.CreateValid(indices.Length, workGroupSize) - - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange indices.Length indices result)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) - let create (clContext: ClContext) workGroupSize = let create = @@ -315,6 +292,24 @@ module ClArray = resultArray + let getUniqueBitmap2<'a when 'a: equality> (clContext: ClContext) workGroupSize = + + let map = map2 clContext workGroupSize <@ fun x y -> if x = 1 && y = 1 then 1 else 0 @> + + let getUniqueBitmap = getUniqueBitmap clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (firstArray: ClArray<'a>) (secondArray: ClArray<'a>) -> + let firstBitmap = getUniqueBitmap processor DeviceOnly firstArray + + let secondBitmap = getUniqueBitmap processor DeviceOnly secondArray + + let result = map processor allocationMode firstBitmap secondBitmap + + firstBitmap.Free processor + secondBitmap.Free processor + + result + let choose<'a, 'b> (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b option>) = let getBitmap = map<'a, int> clContext workGroupSize @@ -353,3 +348,14 @@ module ClArray = scatter processor positions values result result + + let iterate (clContext: ClContext) workGroupSize iterator = + + let create = create clContext workGroupSize iterator + + let scatter = Scatter.runInplace clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) -> + + let positions = create processor allocationMode + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs index 2dcccb74..f23db2f4 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs @@ -9,6 +9,7 @@ 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 = @@ -155,50 +156,3 @@ module Matrix = run queue matrixLeft matrixRight mask - let spgemm - (clContext: ClContext) - workGroupSize - (opAdd: Expr<'c -> 'c -> 'c>) - (opMul: Expr<'a -> 'b -> 'c>) - = - - let expand = SpGEMM.Expand.run clContext workGroupSize opMul - - let expandRowPointers = expandRowPointers clContext workGroupSize - - let sortData = Sort.Radix.runByKeysStandard clContext workGroupSize - - let sortKeys = Sort.Radix.runByKeysStandard clContext workGroupSize - - let reduceByKey = Reduce.ByKey.segmentSequential clContext workGroupSize opAdd - - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - let multiplicationResult, columns, rowPointers = - expand processor leftMatrix rightMatrix - - let rows = - expandRowPointers processor DeviceOnly rowPointers columns.Length leftMatrix.RowCount - - rowPointers.Free processor - - // sorting - let sortData = sortData processor - let sortKeys = sortKeys processor - - // by columns - let valuesSortedByColumns = sortData columns multiplicationResult - let byKeSortedRows = sortKeys columns rows - - multiplicationResult.Free processor - rows.Free processor - - // by rows - let values = sortData byKeSortedRows valuesSortedByColumns - let columns = sortKeys byKeSortedRows columns - - // reduce - - - - () - diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 14a97111..da373352 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -2,390 +2,97 @@ namespace GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM open Brahma.FSharp open GraphBLAS.FSharp.Backend.Common +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 -open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions type Indices = ClArray type Values<'a> = ClArray<'a> module Expand = - /// - /// Get the number of non-zero elements for each row of the right matrix for non-zero item in left matrix. - /// - let requiredRawsLengths = - <@ fun gid (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) -> - let columnIndex = leftMatrixColumnsIndices.[gid] - let startRawIndex = rightMatrixRawPointers.[columnIndex] - let exclusiveRawEndIndex = rightMatrixRawPointers.[columnIndex + 1] - - exclusiveRawEndIndex - startRawIndex @> - - /// - /// Get the pointer to right matrix raw for each non-zero in left matrix. - /// - let requiredRawPointers = - <@ fun gid (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) -> - let columnIndex = leftMatrixColumnsIndices.[gid] - let startRawIndex = rightMatrixRawPointers.[columnIndex] - - startRawIndex @> - - let processLeftMatrixColumnsAndRightMatrixRawPointers (clContext: ClContext) workGroupSize writeOperation = - - let kernel = - <@ fun (ndRange: Range1D) columnsLength (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) (result: Indices) -> - - let gid = ndRange.GlobalID0 - - if gid < columnsLength then - result.[gid] <- (%writeOperation) gid leftMatrixColumnsIndices rightMatrixRawPointers @> - - let kernel = clContext.Compile kernel - - fun (processor: MailboxProcessor<_>) (leftMatrixColumnsIndices: Indices) (rightMatrixRawPointers: Indices) -> - let resultLength = leftMatrixColumnsIndices.Length - - let requiredRawsLengths = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - - let kernel = kernel.GetKernel() - - let ndRange = - Range1D.CreateValid(resultLength, workGroupSize) - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - leftMatrixColumnsIndices - rightMatrixRawPointers - requiredRawsLengths) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - - requiredRawsLengths - - let extractLeftMatrixRequiredValuesAndColumns (clContext: ClContext) workGroupSize = - - let getUniqueBitmap = - ClArray.getUniqueBitmap clContext workGroupSize - - let prefixSumExclude = - PrefixSum.standardExcludeInplace clContext workGroupSize - - let indicesScatter = - Scatter.runInplace clContext workGroupSize - - let dataScatter = - Scatter.runInplace clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (globalRightMatrixRawsStartPositions: Indices) -> + let getRowsLengths (clContext: ClContext) workGroupSize = - let leftMatrixRequiredPositions, resultLength = - let bitmap = - getUniqueBitmap processor DeviceOnly globalRightMatrixRawsStartPositions + let create = + ClArray.init clContext workGroupSize Map.inc - let length = (prefixSumExclude processor bitmap).ToHostAndFree processor + let zeroCreate = ClArray.zeroCreate clContext workGroupSize - bitmap, length + let scatter = Scatter.runInplace clContext workGroupSize - let requiredLeftMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + let subtraction = ClArray.map2 clContext workGroupSize Map.subtraction - indicesScatter processor leftMatrixRequiredPositions leftMatrix.Values requiredLeftMatrixValues + fun (processor: MailboxProcessor<_>) allocationMode (rowPointers: Indices) -> - let requiredLeftMatrixColumns = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + let positions = create processor DeviceOnly rowPointers.Length - dataScatter processor leftMatrixRequiredPositions leftMatrix.Columns requiredLeftMatrixColumns + let shiftedPointers = zeroCreate processor DeviceOnly rowPointers.Length - leftMatrixRequiredPositions.Free processor + scatter processor positions rowPointers shiftedPointers - requiredLeftMatrixColumns, requiredLeftMatrixValues - - let getGlobalMap (clContext: ClContext) workGroupSize = - - let zeroCreate = ClArray.zeroCreate clContext workGroupSize - - let assignUnits = ClArray.assignManyInit clContext workGroupSize <@ fun _ -> 1 @> - - let prefixSum = PrefixSum.standardIncludeInplace clContext workGroupSize - - fun (processor: MailboxProcessor<_>) resultLength (globalRightMatrixValuesPositions: Indices) -> - - /// We get an array of zeros - let globalPositions = zeroCreate processor DeviceOnly resultLength - - // Insert units at the beginning of new lines (source positions) - assignUnits processor globalRightMatrixValuesPositions globalPositions - - // Apply the prefix sum, SIDE EFFECT!!! - // get an array where different sub-arrays of pointers to elements of the same row differ in values - (prefixSum processor globalPositions).Free processor - - globalPositions - - let getResultRowPointers (clContext: ClContext) workGroupSize = - - let kernel = - <@ fun (ndRange: Range1D) length (leftMatrixRowPointers: Indices) (globalArrayRightMatrixRawPointers: Indices) (result: Indices) -> - - let gid = ndRange.GlobalID0 - - // do not touch the last element - if gid < length - 1 then - let rowPointer = leftMatrixRowPointers.[gid] - let globalPointer = globalArrayRightMatrixRawPointers.[rowPointer] - - result.[gid] <- globalPointer @> - - let kernel = clContext.Compile kernel - - let createResultPointersBuffer = ClArray.create clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (globalLength: int) (leftMatrixRowPointers: Indices) (globalRightMatrixRowPointers: Indices) -> - - // The last element must be equal to the length of the global array. let result = - createResultPointersBuffer processor DeviceOnly leftMatrixRowPointers.Length globalLength - - let kernel = kernel.GetKernel() - - // do not touch the last element - let ndRange = - Range1D.CreateValid(leftMatrixRowPointers.Length - 1, workGroupSize) - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - leftMatrixRowPointers.Length - leftMatrixRowPointers - globalRightMatrixRowPointers - result) - ) + subtraction processor allocationMode shiftedPointers rowPointers - processor.Post <| Msg.CreateRunMsg<_, _> kernel + positions.Free processor + rowPointers.Free processor result - let processPositions (clContext: ClContext) workGroupSize = + let expand (clContext: ClContext) workGroupSize = + let init = ClArray.init clContext workGroupSize Map.id - let getRequiredRawsLengths = - processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawsLengths + let scatter = Scatter.runInplace clContext workGroupSize - let removeDuplications = ClArray.removeDuplications clContext workGroupSize + let zeroCreate = ClArray.zeroCreate clContext workGroupSize - let prefixSumExclude = - PrefixSum.standardExcludeInplace clContext workGroupSize + let maxPrefixSum = PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize - let extractLeftMatrixRequiredValuesAndColumns = - extractLeftMatrixRequiredValuesAndColumns clContext workGroupSize + let initWithUnits = ClArray.init clContext workGroupSize <@ fun _ -> 1 @> - let getGlobalPositions = getGlobalMap clContext workGroupSize + fun (processor: MailboxProcessor<_>) lengths (segmentLengths: Indices) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - let getRowPointers = getResultRowPointers clContext workGroupSize + // Compute A positions + let sequence = init processor DeviceOnly segmentLengths.Length - let getRequiredRightMatrixValuesPointers = - processLeftMatrixColumnsAndRightMatrixRawPointers clContext workGroupSize requiredRawPointers + let APositions = zeroCreate processor DeviceOnly lengths - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - // array of required right matrix rows length obtained by left matrix columns - let requiredRawsLengths = - getRequiredRawsLengths processor leftMatrix.Columns rightMatrix.RowPointers - - // global expanded array length (sum of previous length) SIDE EFFECT!!! - let globalLength = - (prefixSumExclude processor requiredRawsLengths).ToHostAndFree processor - - // rename array after side effect of prefix sum include - // positions in global array for right matrix raws with duplicates - let globalRightMatrixRowsStartPositions = requiredRawsLengths - - /// Extract required left matrix columns and values by global right matrix pointers. - /// Then get required right matrix rows (pointers to rows) by required left matrix columns. - - // extract required left matrix columns and rows by right matrix rows positions - let requiredLeftMatrixColumns, requiredLeftMatrixValues = - extractLeftMatrixRequiredValuesAndColumns processor leftMatrix globalRightMatrixRowsStartPositions - - // pointers to required raws in right matrix values - // rows to be placed by globalRightMatrixRowsStartPositionsWithoutDuplicates - let requiredRightMatrixRawPointers = - getRequiredRightMatrixValuesPointers processor requiredLeftMatrixColumns rightMatrix.RowPointers - - requiredLeftMatrixColumns.Free processor - - // remove duplications in right matrix rows positions in global extended array - let globalRightMatrixRawsPointersWithoutDuplicates = - removeDuplications processor globalRightMatrixRowsStartPositions - - // RESULT row pointers into result expanded (obtained by multiplication) array - let resultRowPointers = - getRowPointers processor globalLength leftMatrix.RowPointers globalRightMatrixRowsStartPositions - - globalRightMatrixRowsStartPositions.Free processor - - // int map to distinguish different raws in a general array. 1 for first, 2 for second and so forth... - let globalMap = - getGlobalPositions processor globalLength globalRightMatrixRawsPointersWithoutDuplicates - - globalMap, globalRightMatrixRawsPointersWithoutDuplicates, requiredLeftMatrixValues, requiredRightMatrixRawPointers, resultRowPointers - - let expandRightMatrixValuesIndices (clContext: ClContext) workGroupSize = - - let kernel = - <@ fun (ndRange: Range1D) length (globalRightMatrixValuesPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalPositions: Indices) (result: Indices) -> - - let gid = ndRange.GlobalID0 - - if gid < length then - // index corresponding to the position of pointers - let positionIndex = globalPositions.[gid] - 1 // TODO() - - // the position of the beginning of a new line of pointers - let sourcePosition = globalRightMatrixValuesPositions.[positionIndex] - - // offset from the source pointer - let offsetFromSourcePosition = gid - sourcePosition - - // pointer to the first element in the row of the right matrix from which - // the offset will be counted to get pointers to subsequent elements in this row - let sourcePointer = requiredRightMatrixValuesPointers.[positionIndex] - - // adding up the mix with the source pointer, - // we get a pointer to a specific element in the raw - result.[gid] <- sourcePointer + offsetFromSourcePosition @> - - let kernel = clContext.Compile kernel + scatter processor segmentLengths sequence APositions - fun (processor: MailboxProcessor<_>) (globalRightMatrixRawsStartPositions: Indices) (requiredRightMatrixValuesPointers: Indices) (globalMap: Indices) -> + sequence.Free processor - let globalRightMatrixValuesPointers = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalMap.Length) + maxPrefixSum processor APositions 0 - let kernel = kernel.GetKernel() + // Compute B positions - let ndRange = - Range1D.CreateValid(globalMap.Length, workGroupSize) - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - globalMap.Length - globalRightMatrixRawsStartPositions - requiredRightMatrixValuesPointers - globalMap - globalRightMatrixValuesPointers) - ) - processor.Post <| Msg.CreateRunMsg<_, _> kernel - globalRightMatrixValuesPointers - let expandLeftMatrixValues (clContext: ClContext) workGroupSize = + let run (clContext: ClContext) workGroupSize = - let kernel = - <@ fun (ndRange: Range1D) resultLength (globalBitmap: Indices) (leftMatrixValues: Values<'a>) (resultValues: Values<'a>) -> + let getRowsLengths = getRowsLengths clContext workGroupSize - let gid = ndRange.GlobalID0 + let zeroCreate = ClArray.zeroCreate clContext workGroupSize - // globalBitmap.Length == resultValues.Length - if gid < resultLength then - let valueIndex = globalBitmap.[gid] - 1 //TODO() + let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize - resultValues.[gid] <- leftMatrixValues.[valueIndex] @> + let gather = Gather.run clContext workGroupSize - let kernel = clContext.Compile kernel - - fun (processor: MailboxProcessor<_>) (globalMap: Indices) (leftMatrixValues: Values<'a>) -> - - let expandedLeftMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalMap.Length) - - let kernel = kernel.GetKernel() - - let ndRange = - Range1D.CreateValid(globalMap.Length, workGroupSize) - - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - globalMap.Length - globalMap - leftMatrixValues - expandedLeftMatrixValues) - ) - - processor.Post <| Msg.CreateRunMsg<_, _> kernel - - expandedLeftMatrixValues - - let getRightMatrixColumnsAndValues (clContext: ClContext) workGroupSize = - let gatherRightMatrixData = Gather.run clContext workGroupSize - - let gatherIndices = Gather.run clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (globalPositions: Indices) (rightMatrix: ClMatrix.CSR<'a>) -> - // gather all required right matrix values - let extendedRightMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalPositions.Length) - - gatherRightMatrixData processor globalPositions rightMatrix.Values extendedRightMatrixValues - - // gather all required right matrix column indices - let extendedRightMatrixColumns = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, globalPositions.Length) - - gatherIndices processor globalPositions rightMatrix.Columns extendedRightMatrixColumns - - extendedRightMatrixValues, extendedRightMatrixColumns - - let run (clContext: ClContext) workGroupSize (multiplication: Expr<'a -> 'b -> 'c>) = - - let processPositions = processPositions clContext workGroupSize - - let expandLeftMatrixValues = - expandLeftMatrixValues clContext workGroupSize - - let expandRightMatrixValuesPointers = - expandRightMatrixValuesIndices clContext workGroupSize - - let getRightMatrixColumnsAndValues = - getRightMatrixColumnsAndValues clContext workGroupSize + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - let map2 = ClArray.map2 clContext workGroupSize multiplication + let bRowsLengths = getRowsLengths processor DeviceOnly rightMatrix.RowPointers - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + let segmentsLengths = zeroCreate processor DeviceOnly leftMatrix.Columns.Length + gather processor leftMatrix.Columns bRowsLengths segmentsLengths - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers - = processPositions processor leftMatrix rightMatrix + bRowsLengths.Free processor - // left matrix values correspondingly to right matrix values - let extendedLeftMatrixValues = - expandLeftMatrixValues processor globalMap requiredLeftMatrixValues + let length = (prefixSum processor segmentsLengths).ToHostAndFree processor - // extended pointers to all required right matrix numbers - let globalRightMatrixValuesPointers = - expandRightMatrixValuesPointers processor globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap - let extendedRightMatrixValues, extendedRightMatrixColumns = - getRightMatrixColumnsAndValues processor globalRightMatrixValuesPointers rightMatrix - /// Multiplication - let multiplicationResult = - map2 processor DeviceOnly extendedLeftMatrixValues extendedRightMatrixValues + () - multiplicationResult, extendedRightMatrixColumns, resultRowPointers diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs index 2ec988d5..483c6c80 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs @@ -21,3 +21,7 @@ module Map = match (%map) item with | Some _ -> 1 | None -> 0 @> + + let inc = <@ fun item -> item + 1 @> + + let subtraction = <@ fun first second -> first - second @> From 91a72e21889fceaaf81345874df497479a8a17df Mon Sep 17 00:00:00 2001 From: IgorErin Date: Mon, 3 Apr 2023 20:15:25 +0300 Subject: [PATCH 10/33] add: Gather tests --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 10 - src/GraphBLAS-sharp.Backend/Common/Gather.fs | 18 +- .../Common/PrefixSum.fs | 72 +++++ src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 2 + .../Matrix/CSRMatrix/Matrix.fs | 42 +-- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 241 ++++++++++++++--- src/GraphBLAS-sharp.Backend/Matrix/Common.fs | 37 +++ src/GraphBLAS-sharp.Backend/Quotes/Map.fs | 4 + tests/GraphBLAS-sharp.Tests/Common/Gather.fs | 63 +++++ .../Common/Reduce/ReduceByKey.fs | 7 +- tests/GraphBLAS-sharp.Tests/Common/Scatter.fs | 24 +- .../GraphBLAS-sharp.Tests.fsproj | 4 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 79 ++---- .../Matrix/SpGEMM/Example.fs | 185 ------------- .../Matrix/SpGEMM/Expand.fs | 252 ------------------ tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 89 +++++++ tests/GraphBLAS-sharp.Tests/Program.fs | 6 +- 17 files changed, 529 insertions(+), 606 deletions(-) create mode 100644 tests/GraphBLAS-sharp.Tests/Common/Gather.fs delete mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs delete mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs create mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index fe562625..e8fba339 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -349,13 +349,3 @@ module ClArray = result - let iterate (clContext: ClContext) workGroupSize iterator = - - let create = create clContext workGroupSize iterator - - let scatter = Scatter.runInplace clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) (resultArray: ClArray<'a>) -> - - let positions = create processor allocationMode - diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs index 65d5968d..3f980651 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Gather.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -17,28 +17,28 @@ module internal Gather = let run (clContext: ClContext) workGroupSize = let gather = - <@ fun (ndRange: Range1D) (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) (size: int) -> + <@ fun (ndRange: Range1D) positionsLength valuesLength (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> let i = ndRange.GlobalID0 - if i < size then + if i < positionsLength then let position = positions.[i] - let value = values.[position] - outputArray.[i] <- value @> + if position >= 0 && position < valuesLength then + outputArray.[i] <- values.[position] @> - let program = clContext.Compile(gather) + let program = clContext.Compile gather - fun (processor: MailboxProcessor<_>) (positions: ClArray) (inputArray: ClArray<'a>) (outputArray: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> - let size = outputArray.Length + if positions.Length <> outputArray.Length then failwith "Lengths must be the same" let kernel = program.GetKernel() - let ndRange = Range1D.CreateValid(size, workGroupSize) + let ndRange = Range1D.CreateValid(positions.Length, workGroupSize) processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange positions inputArray outputArray size) + 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/PrefixSum.fs b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs index b25cd85e..591b9a28 100644 --- a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs @@ -270,3 +270,75 @@ module PrefixSum = fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> scan processor inputArray 0 + + + module ByKey = + let private sequentialSegments opWrite (clContext: ClContext) workGroupSize opAdd zero = + + let kernel = + <@ fun (ndRange: Range1D) lenght uniqueKeysCount (values: ClArray<'a>) (keys: ClArray) (offsets: ClArray) -> + let gid = ndRange.GlobalID0 + + if gid < uniqueKeysCount then + let sourcePosition = offsets.[gid] + let sourceKey = keys.[sourcePosition] + + let mutable currentSum = zero + let mutable previousSum = zero + + let mutable currentPosition = sourcePosition + + while currentPosition < lenght + && keys.[currentPosition] = sourceKey do + + previousSum <- currentSum + currentSum <- (%opAdd) currentSum values.[currentPosition] + + values.[currentPosition] <- (%opWrite) previousSum currentSum + + currentPosition <- currentPosition + 1 @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) uniqueKeysCount (values: ClArray<'a>) (keys: ClArray) (offsets: ClArray) -> + + let kernel = kernel.GetKernel() + + let ndRange = + Range1D.CreateValid(values.Length, workGroupSize) + + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange values.Length uniqueKeysCount values keys offsets) + ) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + /// + /// Exclude scan by key. + /// + /// + /// + /// let arr = [| 1; 1; 1; 1; 1; 1|] + /// let keys = [| 1; 2; 2; 2; 3; 3 |] + /// ... + /// > val result = [| 0; 0; 1; 2; 0; 1 |] + /// + /// + let sequentialExclude clContext = + sequentialSegments (Map.fst ()) clContext + + /// + /// Include scan by key. + /// + /// + /// + /// let arr = [| 1; 1; 1; 1; 1; 1|] + /// let keys = [| 1; 2; 2; 2; 3; 3 |] + /// ... + /// > val result = [| 1; 1; 2; 3; 1; 2 |] + /// + /// + let sequentialInclude clContext = + sequentialSegments (Map.snd ()) clContext + diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index 840f024f..e8c8b737 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -43,6 +43,8 @@ module internal Scatter = 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 = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs index f23db2f4..4f3f0f09 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs @@ -12,47 +12,9 @@ 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 @@ -77,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 = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index da373352..035f2758 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -1,7 +1,9 @@ -namespace GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM +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 @@ -13,35 +15,82 @@ type Indices = ClArray type Values<'a> = ClArray<'a> module Expand = - - let getRowsLengths (clContext: ClContext) workGroupSize = + let getSegmentPointers (clContext: ClContext) workGroupSize = let create = + ClArray.init clContext workGroupSize Map.id + + let createShifted = ClArray.init clContext workGroupSize Map.inc - let zeroCreate = ClArray.zeroCreate clContext workGroupSize + let subtract = ClArray.map2 clContext workGroupSize Map.subtraction - let scatter = Scatter.runInplace clContext workGroupSize + let gather = Gather.run clContext workGroupSize - let subtraction = ClArray.map2 clContext workGroupSize Map.subtraction + let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (rowPointers: Indices) -> + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - let positions = create processor DeviceOnly rowPointers.Length + let positionsLength = rightMatrix.RowPointers.Length - 1 - let shiftedPointers = zeroCreate processor DeviceOnly rowPointers.Length + // extract first rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers + // (right matrix row pointers without last item) + let positions = // TODO(fuse) + create processor DeviceOnly positionsLength - scatter processor positions rowPointers shiftedPointers + let firstPointers = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) - let result = - subtraction processor allocationMode shiftedPointers rowPointers + gather processor positions rightMatrix.RowPointers firstPointers positions.Free processor - rowPointers.Free processor - result + printfn $"first pointers gpu: %A{firstPointers.ToHost processor}" + + // extract last rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers + // (right matrix row pointers without first item) + let shiftedPositions = // TODO(fuse) + createShifted processor DeviceOnly positionsLength + + printfn "shifted positions gpu: %A" <| shiftedPositions.ToHost processor + + let lastPointers = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) + + gather processor shiftedPositions rightMatrix.RowPointers lastPointers + + printfn $"last pointers gpu: %A{lastPointers.ToHost processor}" + + shiftedPositions.Free processor + + // subtract + let rightMatrixRowsLengths = + subtract processor DeviceOnly lastPointers firstPointers + + printfn $"subtract result gpu: %A{rightMatrixRowsLengths.ToHost processor}" + + 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 + + printfn $"subtract after gather result gpu: %A{segmentsLengths.ToHost processor}" + + rightMatrixRowsLengths.Free processor + + // compute pointers + let length = (prefixSum processor segmentsLengths).ToHostAndFree processor + + printfn $"subtract after prefix sum gpu: %A{segmentsLengths.ToHost processor}" + + length, segmentsLengths + + let expand (clContext: ClContext) workGroupSize opMul = - let expand (clContext: ClContext) workGroupSize = let init = ClArray.init clContext workGroupSize Map.id let scatter = Scatter.runInplace clContext workGroupSize @@ -50,49 +99,179 @@ module Expand = let maxPrefixSum = PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize - let initWithUnits = ClArray.init clContext workGroupSize <@ fun _ -> 1 @> + 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 - fun (processor: MailboxProcessor<_>) lengths (segmentLengths: Indices) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + let AGather = Gather.run clContext workGroupSize + + let BGather = Gather.run clContext workGroupSize + + let mul = ClArray.map2 clContext workGroupSize opMul + + fun (processor: MailboxProcessor<_>) lengths (segmentsPointers: Indices) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> // Compute A positions - let sequence = init processor DeviceOnly segmentLengths.Length + let sequence = init processor DeviceOnly segmentsPointers.Length // TODO(fuse) let APositions = zeroCreate processor DeviceOnly lengths - scatter processor segmentLengths sequence APositions + scatter processor segmentsPointers sequence APositions sequence.Free processor - maxPrefixSum processor APositions 0 + (maxPrefixSum processor APositions 0).Free processor // Compute B positions + let BPositions = create processor DeviceOnly lengths 1 // TODO(fuse) + let requiredBPointers = zeroCreate processor DeviceOnly leftMatrix.Columns.Length + gather processor leftMatrix.Columns rightMatrix.RowPointers requiredBPointers + scatter processor segmentsPointers requiredBPointers BPositions + requiredBPointers.Free processor - let run (clContext: ClContext) workGroupSize = + // another way to get offsets ??? + let offsets = removeDuplicates processor segmentsPointers - let getRowsLengths = getRowsLengths clContext workGroupSize + segmentPrefixSum processor offsets.Length BPositions APositions offsets // TODO(offsets lengths in scan) - let zeroCreate = ClArray.zeroCreate clContext workGroupSize + offsets.Free processor + + // compute columns + let columns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + gather processor BPositions rightMatrix.Columns columns + + // compute rows + let ARows = expandRowPointers processor DeviceOnly leftMatrix.RowPointers leftMatrix.NNZ leftMatrix.RowCount + + let rows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + gather processor APositions ARows rows + + ARows.Free processor + + // compute leftMatrix values + let AValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + AGather processor APositions leftMatrix.Values AValues + + APositions.Free processor + + // compute right matrix values + let BValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) + + BGather processor BPositions rightMatrix.Values BValues + + BPositions.Free processor + + // multiply values TODO(filter values) + let values = mul processor DeviceOnly AValues BValues + + AValues.Free processor + BValues.Free processor + + values, 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 columns values + + let rowsSortedByColumns = sortByKeyIndices processor columns rows + + let sortedColumns = sortKeys processor columns + + // sort by rows + let valuesSortedByRows = sortByKeyValues processor rows valuesSortedByColumns + + let columnsSortedByRows = sortByKeyIndices processor rows 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.segmentSequential clContext workGroupSize opAdd + + let getUniqueBitmap = + ClArray.getUniqueBitmap2 clContext workGroupSize let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize - let gather = Gather.run clContext workGroupSize + let removeDuplicates = ClArray.removeDuplications clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> - let bRowsLengths = getRowsLengths processor DeviceOnly rightMatrix.RowPointers + let bitmap = getUniqueBitmap processor DeviceOnly columns rows - let segmentsLengths = zeroCreate processor DeviceOnly leftMatrix.Columns.Length - gather processor leftMatrix.Columns bRowsLengths segmentsLengths + let uniqueKeysCount = (prefixSum processor bitmap).ToHostAndFree processor - bRowsLengths.Free processor + let offsets = removeDuplicates processor bitmap - let length = (prefixSum processor segmentsLengths).ToHostAndFree processor + bitmap.Free processor + + let reducedColumns, reducedRows, reducedValues = + reduce processor allocationMode uniqueKeysCount offsets columns rows values + + offsets.Free processor + + reducedValues, reducedColumns, reducedRows + + let run (clContext: ClContext) workGroupSize opMul opAdd = + + let getSegmentPointers = getSegmentPointers clContext workGroupSize + + let expand = expand 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 + + let values, columns, rows = + expand processor length segmentPointers leftMatrix rightMatrix + + let sortedValues, sortedColumns, sortedRows = + sort processor values columns rows + values.Free processor + columns.Free processor + rows.Free processor + 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/Common.fs b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs index 1300b3cb..eaca8906 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs @@ -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/Quotes/Map.fs b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs index 483c6c80..a697d5e0 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs @@ -25,3 +25,7 @@ module Map = 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/tests/GraphBLAS-sharp.Tests/Common/Gather.fs b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs new file mode 100644 index 00000000..a3569ab5 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs @@ -0,0 +1,63 @@ +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 + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let check isEqual actual positions values target = + + HostPrimitives.gather positions values target + + "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" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index b0f24510..6a7f66f3 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -269,12 +269,9 @@ let sequential2DTest = let makeTestSequentialSegments2D isEqual reduce reduceOp (array: (int * int * 'a) []) = - let firstKeys, secondKeys, values = - array - |> Array.sortBy (fun (fst, snd, _) -> fst, snd) - |> Array.unzip3 + if array.Length > 0 then + let array = Array.sortBy (fun (fst, snd, _) -> fst, snd) array - if firstKeys.Length > 0 then let offsets = array |> Array.map (fun (fst, snd, _) -> fst, snd) diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs index 5730ca2e..9bb976b3 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs @@ -3,9 +3,11 @@ 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.Common +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions let logger = Log.create "Scatter.Tests" @@ -21,22 +23,12 @@ let q = defaultContext.Queue let makeTest scatter (array: (int * 'a) []) (result: 'a []) = if array.Length > 0 then - let expected = Array.copy result - - 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 + |> HostPrimitives.scatter positions values + let actual = use clPositions = context.CreateClArray positions use clValues = context.CreateClArray values @@ -44,7 +36,7 @@ let makeTest scatter (array: (int * 'a) []) (result: 'a []) = scatter q clPositions clValues clResult - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clResult, Array.zeroCreate result.Length, ch)) + clResult.ToHostAndFree q $"Arrays should be equal. Actual is \n%A{actual}, expected \n%A{expected}" |> Tests.Utils.compareArrays (=) actual expected @@ -52,7 +44,7 @@ let makeTest scatter (array: (int * 'a) []) (result: 'a []) = let testFixtures<'a when 'a: equality> = Scatter.runInplace<'a> context wgSize |> makeTest - |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" + |> testPropertyWithConfig { config with endSize = 10 } $"Correctness on %A{typeof<'a>}" let tests = q.Error.Add(fun e -> failwithf $"%A{e}") diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 17381aca..502969bf 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -17,6 +17,7 @@ + @@ -47,9 +48,8 @@ - - + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index ca38bf69..370155b2 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -140,59 +140,6 @@ module Utils = result - let prefixSumExclude (array: 'a []) zero plus = - let mutable sum = zero - - for i in 0 .. array.Length - 1 do - let currentItem = array.[i] - array.[i] <- sum - - sum <- plus currentItem sum - - sum - - let prefixSumInclude (array: 'a []) zero plus = - let mutable sum = zero - - for i in 0 .. array.Length - 1 do - sum <- plus array.[i] sum - - array.[i] <- sum - - sum - - let getUniqueBitmap<'a when 'a: equality> (array: 'a []) = - let bitmap = Array.zeroCreate array.Length - - for i in 0 .. array.Length - 2 do - if array.[i] <> array.[i + 1] then bitmap.[i] <- 1 - - // set last 1 - bitmap.[bitmap.Length - 1] <- 1 - - bitmap - - let scatter (positions: int array) (values: 'a array) (resultValues: 'a array) = - for i in 0 .. positions.Length - 2 do - if positions.[i] <> positions.[i + 1] then - let valuePosition = positions.[i] - let value = values.[i] - - resultValues.[valuePosition] <- value - - // set last value - let lastPosition = positions.[positions.Length - 1] - let lastValue = values.[values.Length - 1] - - resultValues.[lastPosition] <- lastValue - - let gather (positions: int []) (values: 'a []) (result: 'a []) = - for i in 0 .. positions.Length do - let position = positions.[i] - let value = values.[position] - - result.[position] <- value - let castMatrixToCSR = function | Matrix.CSR matrix -> matrix | _ -> failwith "matrix format must be CSR" @@ -253,6 +200,32 @@ module HostPrimitives = ||> Array.map2 (fun (fst, snd) value -> fst, snd, value) |> Array.unzip3 + let scatter (positions: int array) (values: 'a array) (resultValues: 'a array) = + + if positions.Length <> values.Length then failwith "Lengths must be the same" + + let bitmap = getUniqueBitmapLastOccurrence positions + + Array.iteri2 + (fun index bit key -> + if bit = 1 + && 0 <= key + && key < resultValues.Length then + resultValues.[key] <- values.[index]) bitmap positions + + resultValues + + 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 + + module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs deleted file mode 100644 index 332c2c82..00000000 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Example.fs +++ /dev/null @@ -1,185 +0,0 @@ -module GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM.Example - -open GraphBLAS.FSharp.Objects.Matrix -open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM -open GraphBLAS.FSharp.Tests -open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -open Expecto -open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Objects.ClContext - -let context = Context.defaultContext - -let clContext = context.ClContext -let processor = context.Queue - -/// -/// Left matrix -/// -/// -/// [ 0 0 2 3 0 -/// 0 0 0 0 0 -/// 0 8 0 5 4 -/// 0 0 2 0 0 -/// 1 7 0 0 0 ] -/// -let leftMatrix = - { RowCount = 5 - ColumnCount = 5 - RowPointers = [| 0; 2; 2; 5; 6; 8 |] - ColumnIndices = [| 2; 3; 1; 3; 4; 2; 0; 1 |] - Values = [| 2; 3; 8; 5; 4; 2; 1; 7 |] } - -/// -/// Right matrix -/// -/// -/// [ 0 0 0 0 0 0 0 -/// 0 3 0 0 4 0 4 -/// 0 0 2 0 0 2 0 -/// 0 5 0 0 0 9 1 -/// 0 0 0 0 1 0 8 ] -/// -let rightMatrix = - { RowCount = 5 - ColumnCount = 7 - RowPointers = [| 0; 0; 3; 5; 8; 10 |] - ColumnIndices = [| 1; 4; 6; 2; 5; 1; 5; 6; 4; 6 |] - Values = [| 3; 4; 4; 2; 2; 5; 9; 1; 1; 8 |] } - -let deviceLeftMatrix = leftMatrix.ToDevice clContext -let deviceRightMatrix = rightMatrix.ToDevice clContext - -let processPosition () = - let processPositions = Expand.processPositions clContext Utils.defaultWorkGroupSize - - processPositions processor deviceLeftMatrix deviceRightMatrix - -let processPositionsTest = - testCase "ProcessPositions test" - <| fun () -> - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers - = processPosition () - - "Global map must be the same" - |> Expect.equal (globalMap.ToHostAndFree processor) [| 1; 1; 2; 2; 2; 3; 3; 3; 4; 4; 4; 5; 5; 6; 6; 7; 7; 7; |] - - "global right matrix rows pointers must be the same" - |> Expect.equal (globalRightMatrixRowsPointers.ToHostAndFree processor) [| 0; 2; 5; 8; 11; 13; 15; |] - - "required left matrix values must be the same" - |> Expect.equal (requiredLeftMatrixValues.ToHostAndFree processor) [| 2; 3; 8; 5; 4; 2; 7; |] - - "required right matrix row pointers" - |> Expect.equal (requiredRightMatrixRowPointers.ToHostAndFree processor) [| 3; 5; 0; 5; 8; 3; 0; |] - - "row pointers must be the same" - |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] - -let expandLeftMatrixValues () = - let expandLeftMatrixValues = Expand.expandLeftMatrixValues clContext Utils.defaultWorkGroupSize - - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers - = processPosition () - - let result = expandLeftMatrixValues processor globalMap requiredLeftMatrixValues - - globalMap.Free processor - globalRightMatrixRowsPointers.Free processor - requiredLeftMatrixValues.Free processor - requiredRightMatrixRowPointers.Free processor - resultRowPointers.Free processor - - result - -let expandLeftMatrixValuesTest = - testCase "expandLeftMatrixValues test" - <| fun () -> - let expandedLeftMatrixValues = (expandLeftMatrixValues ()).ToHostAndFree processor - - "Expand left matrix values must be the same" - |> Expect.equal expandedLeftMatrixValues [| 2; 2; 3; 3; 3; 8; 8; 8; 5; 5; 5; 4; 4; 2; 2; 7; 7; 7 |] - -let expandGlobalRightMatrixPointers () = - let expandRightMatrixValuesPointers = - Expand.expandRightMatrixValuesIndices clContext Utils.defaultWorkGroupSize - - let globalMap, globalRightMatrixRowsPointers, requiredLeftMatrixValues, requiredRightMatrixRowPointers, resultRowPointers = processPosition () - - let globalRightMatrixValuesPointers = - expandRightMatrixValuesPointers processor globalRightMatrixRowsPointers requiredRightMatrixRowPointers globalMap - - globalMap.Free processor - globalRightMatrixRowsPointers.Free processor - requiredLeftMatrixValues.Free processor - requiredRightMatrixRowPointers.Free processor - resultRowPointers.Free processor - - globalRightMatrixValuesPointers - -let extendGlobalRightMatrixPointersTest = - testCase "expandRightMatrixRowPointers test " - <| fun () -> - let expandedRowPointers = (expandGlobalRightMatrixPointers ()).ToHostAndFree processor - - "row pointers must be the same" - |> Expect.equal expandedRowPointers [| 3; 4; 5; 6; 7; 0; 1; 2; 5; 6; 7; 8; 9; 3; 4; 0; 1; 2; |] - -let getRightMatrixValuesAndColumns () = - let getRightMatrixColumnsAndValues = - Expand.getRightMatrixColumnsAndValues clContext Utils.defaultWorkGroupSize - - let globalRightMatrixValuesPointers = expandGlobalRightMatrixPointers () - - getRightMatrixColumnsAndValues processor globalRightMatrixValuesPointers deviceRightMatrix - -let getRightMatrixValuesAndPointersTest = - testCase "expandRightMatrixValuesAndColumns" - <| fun () -> - let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () - - "extendedRightMatrixValues must be the same" - |> Expect.equal (extendedRightMatrixValues.ToHostAndFree processor) [| 2; 2; 5; 9; 1; 3; 4; 4; 5; 9; 1; 1; 8; 2; 2; 3; 4; 4; |] - - "extendedRightMatrixColumns must be the same" - |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] - -let multiplication () = - let map2 = ClArray.map2 clContext Utils.defaultWorkGroupSize <@ (*) @> - - let expandedLeftMatrixValues = expandLeftMatrixValues () - - let extendedRightMatrixValues, extendedRightMatrixColumns = getRightMatrixValuesAndColumns () - extendedRightMatrixColumns.Free processor - - let multiplicationResult = - map2 processor DeviceOnly expandedLeftMatrixValues extendedRightMatrixValues - - expandedLeftMatrixValues.Free processor - extendedRightMatrixValues.Free processor - - multiplicationResult - -let multiplicationTest = - testCase "multiplication test" <| fun () -> - let result = (multiplication ()).ToHostAndFree processor - - "Results must be the same" - |> Expect.equal result [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] - -let runExtendTest = - testCase "Expand.run test" <| fun () -> - let run = Expand.run clContext Utils.defaultWorkGroupSize <@ (*) @> - - let multiplicationResult, extendedRightMatrixColumns, resultRowPointers = - run processor deviceLeftMatrix deviceRightMatrix - - "Results must be the same" - |> Expect.equal (multiplicationResult.ToHostAndFree processor) [| 4; 4; 15; 27; 3; 24; 32; 32; 25; 45; 5; 4; 32; 4; 4; 21; 28; 28 |] - - "extendedRightMatrixColumns must be the same" - |> Expect.equal (extendedRightMatrixColumns.ToHostAndFree processor) [| 2; 5; 1; 5; 6; 1; 4; 6; 1; 5; 6; 4; 6; 2; 5; 1; 4; 6; |] - - "row pointers must be the same" - |> Expect.equal (resultRowPointers.ToHostAndFree processor) [| 0; 5; 5; 13; 15; 18 |] - diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs deleted file mode 100644 index 8defec14..00000000 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGEMM/Expand.fs +++ /dev/null @@ -1,252 +0,0 @@ -module GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM.Expand - -open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGEMM -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Test -open GraphBLAS.FSharp.Tests -open GraphBLAS.FSharp.Objects.Matrix -open Expecto -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -open Brahma.FSharp - -/// -/// Left matrix -/// -/// -/// [ 0 0 2 3 0 -/// 0 0 0 0 0 -/// 0 8 0 5 4 -/// 0 0 2 0 0 -/// 1 7 0 0 0 ] -/// -let leftMatrix = - { RowCount = 5 - ColumnCount = 5 - RowPointers = [| 0; 2; 2; 5; 6; 8 |] - ColumnIndices = [| 2; 3; 1; 3; 4; 2; 0; 1 |] - Values = [| 2; 3; 8; 5; 4; 2; 1; 7 |] } - -/// -/// Right matrix -/// -/// -/// [ 0 0 0 0 0 0 0 -/// 0 3 0 0 4 0 4 -/// 0 0 2 0 0 2 0 -/// 0 5 0 0 0 9 1 -/// 0 0 0 0 1 0 8 ] -/// -let rightMatrix = - { RowCount = 5 - ColumnCount = 7 - RowPointers = [| 0; 0; 3; 5; 8; 10 |] - ColumnIndices = [| 1; 4; 6; 2; 5; 1; 5; 6; 4; 6 |] - Values = [| 3; 4; 4; 2; 2; 5; 9; 1; 1; 8 |] } - -type ExpandedResult<'a> = - { Values: 'a [] - Columns: int [] - RowPointers: int [] } - -let config = { Utils.defaultConfig with arbitrary = [ typeof ] } - -let context = Context.defaultContext.ClContext - -let processor = Context.defaultContext.Queue - -let hostExpand multiplication (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'a>) = - // Pointers to start positions for right matrix rows in global array - // With duplicates which means that there is no string in the global array - let rowsPointersToGlobalArray, globalLength = - let requiredRightMatrixRowsLength = - (fun index -> - let columnIndex = leftMatrix.ColumnIndices.[index] - - let startPointer = rightMatrix.RowPointers.[columnIndex] - let endPointer = rightMatrix.RowPointers.[columnIndex + 1] - - endPointer - startPointer) - |> Array.init leftMatrix.ColumnIndices.Length - - //printfn "requiredRightMatrixRowsLength: %A" requiredRightMatrixRowsLength - - // Get right matrix row positions in global array by side effect - let globalLength = - Utils.prefixSumExclude requiredRightMatrixRowsLength 0 (+) - - //printfn "requiredRightMatrixRowsLength after prefix sum: %A" requiredRightMatrixRowsLength - - requiredRightMatrixRowsLength, globalLength - - //printfn "global length: %A" globalLength - - let resultGlobalRowPointers = - (fun index -> - if index < leftMatrix.RowPointers.Length - 1 then - let rowPointer = leftMatrix.RowPointers.[index] - - // printfn "index: %A; lenght: %A" rowPointer rowsPointersToGlobalArray.Length - - rowsPointersToGlobalArray.[rowPointer] - else - globalLength) - |> Array.init leftMatrix.RowPointers.Length - - // Right matrix row positions in global array without duplicates - let globalRightMatrixRowPositions = Array.distinct rowsPointersToGlobalArray - - //printfn "global right matrix row positions without pointers: %A" globalRightMatrixRowPositions - - // Create global map - let globalMap = - let array = - (fun index -> if Array.contains index globalRightMatrixRowPositions then 1 else 0) - |> Array.init globalLength - - Utils.prefixSumInclude array 0 (+) |> ignore - - array - - //printfn "%A" globalMap - - // get required left matrix columns and values - let requiredLeftMatrixColumns, requireLeftMatrixValues = - let positions = - Utils.getUniqueBitmap rowsPointersToGlobalArray - - let length = Utils.prefixSumExclude positions 0 (+) - - let requiredLeftMatrixColumns = Array.zeroCreate length - - Utils.scatter positions leftMatrix.ColumnIndices requiredLeftMatrixColumns - - // printfn "required left matrix columns: %A" requiredLeftMatrixColumns - - let requiredLeftMatrixValues = Array.zeroCreate length - - Utils.scatter positions leftMatrix.Values requiredLeftMatrixValues - - // printfn "required left matrix values: %A" requiredLeftMatrixValues - - requiredLeftMatrixColumns, requiredLeftMatrixValues - - // right matrix required row pointers - let rightMatrixRequiredRowsPointers = - (fun index -> - let requiredLeftMatrixColumn = requiredLeftMatrixColumns.[index] - - rightMatrix.RowPointers.[requiredLeftMatrixColumn]) - |> Array.init globalRightMatrixRowPositions.Length - - //printfn "right matrix required row pointers: %A" rightMatrixRequiredRowsPointers - - let globalRequiredRightMatrixValuesIndices = - (fun index -> - let rowID = globalMap.[index] - 1 - let sourcePosition = globalRightMatrixRowPositions.[rowID] - let offset = index - sourcePosition - - rightMatrixRequiredRowsPointers.[rowID] + offset) - |> Array.init globalLength - - //printfn "global required right matrix values: %A" globalRequiredRightMatrixValuesIndices - - let globalRightMatrixRequiredValues = - (fun index -> - let valueIndex = globalRequiredRightMatrixValuesIndices.[index] - rightMatrix.Values.[valueIndex]) - |> Array.init globalLength - - let globalRightMatrixRequiredColumnIndices = - (fun index -> - let valueIndex = globalRequiredRightMatrixValuesIndices.[index] - rightMatrix.ColumnIndices.[valueIndex]) - |> Array.init globalLength - - //printfn "global required right matrix columns: %A" globalRightMatrixRequiredColumnIndices - - let globalLeftMatrixRequiredValues = - (fun index -> - let valueIndex = globalMap.[index] - 1 - - requireLeftMatrixValues.[valueIndex]) - |> Array.init globalLength - - let resultValues = - Array.map2 multiplication globalRightMatrixRequiredValues globalLeftMatrixRequiredValues - - { Values = resultValues - Columns = globalRightMatrixRequiredColumnIndices - RowPointers = resultGlobalRowPointers } - -let checkResult multiplication leftMatrix rightMatrix actualResult = - let expected = - hostExpand multiplication leftMatrix rightMatrix - - "Values must be the same" - |> Expect.sequenceEqual expected.Values actualResult.Values - - "Columns must be the same" - |> Expect.sequenceEqual expected.Columns actualResult.Columns - - "Row pointers must be the same" - |> Expect.sequenceEqual expected.RowPointers actualResult.RowPointers - - printfn "SUCCESS" - -let makeTest isZero multiplication expand (leftArray: 'a [,], rightArray: 'a [,]) = - - let leftMatrix = - Utils.createMatrixFromArray2D CSR leftArray isZero - |> Utils.castMatrixToCSR - - let rightMatrix = - Utils.createMatrixFromArray2D CSR rightArray isZero - |> Utils.castMatrixToCSR - - if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then - - try - //printfn $"left matrix: %A{leftArray}" - //printfn $"right matrix: %A{rightArray}" - - if leftMatrix.ColumnCount <> rightMatrix.RowCount then - failwith "LOLO" - - hostExpand multiplication leftMatrix rightMatrix |> ignore - - let deviceLeftMatrix = - leftMatrix.ToDevice context - - let deviceRightMatrix = - rightMatrix.ToDevice context - - let (multiplicationResult: ClArray<'a>), - (extendedRightMatrixColumns: ClArray), - (resultRowPointers: ClArray) = - expand processor deviceLeftMatrix deviceRightMatrix - - { Values = multiplicationResult.ToHostAndFree processor - Columns = extendedRightMatrixColumns.ToHostAndFree processor - RowPointers = resultRowPointers.ToHostAndFree processor } - |> checkResult multiplication leftMatrix rightMatrix - with - | ex when ex.Message = "InvalidBufferSize" -> () - | _ -> reraise () - -let creatTest<'a when 'a : struct and 'a : equality> (isZero: 'a -> bool) multiplicationQ multiplication = - Expand.run context Utils.defaultWorkGroupSize multiplicationQ - |> makeTest isZero multiplication - |> testPropertyWithConfig config $"Expand.run on %A{typeof<'a>}" - -let testFixtures = - creatTest ((=) 0) <@ (*) @> (*) - -let check = - let leftMatrix = Utils.createMatrixFromArray2D CSR <| array2D [[-2; 3; -1; -3]; [2; -1; 3; -1]] - - let rightMatrix = Utils.createMatrixFromArray2D CSR <| array2D [[3; 0; 3; 4]; [1; -4; 1; 0]] - - () - diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs new file mode 100644 index 00000000..181df0c9 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs @@ -0,0 +1,89 @@ +module GraphBLAS.FSharp.Tests.Matrix.SpGeMM + +open Expecto +open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM +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 + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = + printfn $"all: %A{rightMatrix.RowPointers}" + + let firstRowPointers = + rightMatrix.RowPointers.[..rightMatrix.RowPointers.Length - 2] + + printfn $"first pointers: %A{firstRowPointers}" + + let lastRowPointers = rightMatrix.RowPointers.[1..] + + printfn $"last pointers: %A{lastRowPointers}" + + let rowsLengths = Array.map2 (-) lastRowPointers firstRowPointers + + printfn $"all row lengths %A{rowsLengths}" + + let neededLengths = Array.init leftMatrix.ColumnIndices.Length (fun index -> Array.item index rowsLengths) + + printfn $"needed lengths %A{neededLengths}" + + HostPrimitives.prefixSumExclude neededLengths + +let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,], _: bool [,]) = + + let leftMatrix = + Utils.createMatrixFromArray2D CSR leftArray isZero + |> Utils.castMatrixToCSR + + let rightMatrix = + Utils.createMatrixFromArray2D CSR rightArray isZero + |> Utils.castMatrixToCSR + + 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 + + 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) testFun = + + let testFun = testFun context Utils.defaultWorkGroupSize + + makeTest isZero testFun + |> testPropertyWithConfig { Utils.defaultConfig with endSize = 10 } $"test on {typeof<'a>}" + +let getSegmentsTests = + [ createTest ((=) 0) Expand.getSegmentPointers + + if Utils.isFloat64Available context.ClDevice then + createTest ((=) 0.0) Expand.getSegmentPointers + + createTest ((=) 0f) Expand.getSegmentPointers + createTest ((=) false) Expand.getSegmentPointers + createTest ((=) 0u) Expand.getSegmentPointers ] + |> testList "get segment pointers" + + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 3f47eaa1..f773301e 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,6 +1,6 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend -open GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM +open GraphBLAS.FSharp.Tests.Matrix // [] @@ -94,8 +94,8 @@ open GraphBLAS.FSharp.Tests.Backend.Matrix.SpGEMM let allTests = testList "All tests" - [ Common.Reduce.ByKey.sequential2DTest - Common.Reduce.ByKey.sequentialSegmentTests2D ] + [ Common.Scatter.tests + Common.Gather.tests ] |> testSequenced From b6796500836a81bb4aa7cee30818e1b29d539a31 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 4 Apr 2023 15:09:21 +0300 Subject: [PATCH 11/33] wip: segments computing tests --- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 14 +---- src/GraphBLAS-sharp.Backend/Objects/Matrix.fs | 14 ++++- tests/GraphBLAS-sharp.Tests/Common/Gather.fs | 1 + tests/GraphBLAS-sharp.Tests/Generators.fs | 3 - tests/GraphBLAS-sharp.Tests/Helpers.fs | 1 - tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 58 ++++++++++++------- tests/GraphBLAS-sharp.Tests/Program.fs | 3 +- 7 files changed, 51 insertions(+), 43 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 035f2758..b94de138 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -45,30 +45,22 @@ module Expand = positions.Free processor - printfn $"first pointers gpu: %A{firstPointers.ToHost processor}" - // extract last rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers // (right matrix row pointers without first item) let shiftedPositions = // TODO(fuse) createShifted processor DeviceOnly positionsLength - printfn "shifted positions gpu: %A" <| shiftedPositions.ToHost processor - let lastPointers = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) gather processor shiftedPositions rightMatrix.RowPointers lastPointers - printfn $"last pointers gpu: %A{lastPointers.ToHost processor}" - shiftedPositions.Free processor // subtract let rightMatrixRowsLengths = subtract processor DeviceOnly lastPointers firstPointers - printfn $"subtract result gpu: %A{rightMatrixRowsLengths.ToHost processor}" - firstPointers.Free processor lastPointers.Free processor @@ -78,17 +70,15 @@ module Expand = // extract needed lengths by left matrix nnz gather processor leftMatrix.Columns rightMatrixRowsLengths segmentsLengths - printfn $"subtract after gather result gpu: %A{segmentsLengths.ToHost processor}" - rightMatrixRowsLengths.Free processor // compute pointers let length = (prefixSum processor segmentsLengths).ToHostAndFree processor - printfn $"subtract after prefix sum gpu: %A{segmentsLengths.ToHost processor}" - length, segmentsLengths + let + let expand (clContext: ClContext) workGroupSize opMul = let init = ClArray.init clContext workGroupSize Map.id 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/tests/GraphBLAS-sharp.Tests/Common/Gather.fs b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs index a3569ab5..f991d0a4 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Gather.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs @@ -14,6 +14,7 @@ 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 diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 42e28f3e..5144f0c7 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -389,9 +389,6 @@ module Generators = valuesGenerator |> Gen.array2DOfDim (nColsA, nColsB) - printf $"left matrix column count: %A{Array2D.length1 matrixA}" - printf $"right matrix row count: %A{Array2D.length2 matrixA}" - return (matrixA, matrixB) } diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 370155b2..ebd82453 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -225,7 +225,6 @@ module HostPrimitives = result - module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs index 181df0c9..bf277298 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs @@ -2,6 +2,7 @@ module GraphBLAS.FSharp.Tests.Matrix.SpGeMM open Expecto open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM +open GraphBLAS.FSharp.Test open Microsoft.FSharp.Collections open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Backend.Matrix @@ -16,29 +17,14 @@ let context = Context.defaultContext.ClContext let processor = Context.defaultContext.Queue -let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = - printfn $"all: %A{rightMatrix.RowPointers}" - - let firstRowPointers = - rightMatrix.RowPointers.[..rightMatrix.RowPointers.Length - 2] - - printfn $"first pointers: %A{firstRowPointers}" - - let lastRowPointers = rightMatrix.RowPointers.[1..] - - printfn $"last pointers: %A{lastRowPointers}" - - let rowsLengths = Array.map2 (-) lastRowPointers firstRowPointers - - printfn $"all row lengths %A{rowsLengths}" - - let neededLengths = Array.init leftMatrix.ColumnIndices.Length (fun index -> Array.item index rowsLengths) - - printfn $"needed lengths %A{neededLengths}" +let config = { Utils.defaultConfig with arbitrary = [ typeof ] } - HostPrimitives.prefixSumExclude neededLengths +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 -let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,], _: bool [,]) = +let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = let leftMatrix = Utils.createMatrixFromArray2D CSR leftArray isZero @@ -57,6 +43,8 @@ let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,], _: bool [,]) let actualLength, (clActual: ClArray) = testFun processor clLeftMatrix clRightMatrix + clLeftMatrix.Dispose processor + let actualPointers = clActual.ToHostAndFree processor let expectedPointers, expectedLength = @@ -73,7 +61,7 @@ let createTest<'a when 'a : struct> (isZero: 'a -> bool) testFun = let testFun = testFun context Utils.defaultWorkGroupSize makeTest isZero testFun - |> testPropertyWithConfig { Utils.defaultConfig with endSize = 10 } $"test on {typeof<'a>}" + |> testPropertyWithConfig { config with endSize = 10 } $"test on {typeof<'a>}" let getSegmentsTests = [ createTest ((=) 0) Expand.getSegmentPointers @@ -86,4 +74,30 @@ let getSegmentsTests = createTest ((=) 0u) Expand.getSegmentPointers ] |> testList "get segment pointers" +let makeExpandTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = + Utils.createMatrixFromArray2D CSR leftArray isZero + |> Utils.castMatrixToCSR + + let rightMatrix = + Utils.createMatrixFromArray2D CSR rightArray isZero + |> Utils.castMatrixToCSR + + 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 (actualValues: ClArray<'a>), (actualColumns: ClArray), (actualRows: ClArray) = + testFun processor length clSegmentPointers clLeftMatrix clRightMatrix + + clLeftMatrix.Free processor + clRightMatrix. processor + clSegmentPointers diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index f773301e..d49deff2 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,8 +94,7 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ Common.Scatter.tests - Common.Gather.tests ] + [ SpGeMM.getSegmentsTests ] |> testSequenced From 7e09219f7e2fb3d37b76c177fa0a38bb3cef29b8 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Tue, 4 Apr 2023 18:56:10 +0300 Subject: [PATCH 12/33] wip: expand tests passed --- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 2 - tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 102 ++++++++++++++---- tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 3 files changed, 84 insertions(+), 22 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index b94de138..a5e8f90f 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -77,8 +77,6 @@ module Expand = length, segmentsLengths - let - let expand (clContext: ClContext) workGroupSize opMul = let init = ClArray.init clContext workGroupSize Map.id diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs index bf277298..8ded29f0 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs @@ -19,6 +19,10 @@ let processor = Context.defaultContext.Queue let config = { Utils.defaultConfig with arbitrary = [ typeof ] } +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 @@ -26,13 +30,9 @@ let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = - let leftMatrix = - Utils.createMatrixFromArray2D CSR leftArray isZero - |> Utils.castMatrixToCSR + let leftMatrix = createCSRMatrix leftArray isZero - let rightMatrix = - Utils.createMatrixFromArray2D CSR rightArray isZero - |> Utils.castMatrixToCSR + let rightMatrix = createCSRMatrix rightArray isZero if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then @@ -44,6 +44,7 @@ let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = testFun processor clLeftMatrix clRightMatrix clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor let actualPointers = clActual.ToHostAndFree processor @@ -61,7 +62,7 @@ let createTest<'a when 'a : struct> (isZero: 'a -> bool) testFun = let testFun = testFun context Utils.defaultWorkGroupSize makeTest isZero testFun - |> testPropertyWithConfig { config with endSize = 10 } $"test on {typeof<'a>}" + |> testPropertyWithConfig config $"test on {typeof<'a>}" let getSegmentsTests = [ createTest ((=) 0) Expand.getSegmentPointers @@ -71,18 +72,48 @@ let getSegmentsTests = createTest ((=) 0f) Expand.getSegmentPointers createTest ((=) false) Expand.getSegmentPointers - createTest ((=) 0u) Expand.getSegmentPointers ] + createTest ((=) 0uy) Expand.getSegmentPointers ] |> testList "get segment pointers" -let makeExpandTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = +let expand length segmentPointers mulOp (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 // TODO(expand row pointers) + // 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 - let leftMatrix = - Utils.createMatrixFromArray2D CSR leftArray isZero - |> Utils.castMatrixToCSR + Array.map2 (fun column length -> + let rowStart = rightMatrix.RowPointers.[column] + Array.take length valuesAndColumns.[rowStart..]) leftMatrix.ColumnIndices segmentsLengths + |> Array.concat + |> Array.unzip - let rightMatrix = - Utils.createMatrixFromArray2D CSR rightArray isZero - |> Utils.castMatrixToCSR + let expectedValues = Array.map2 mulOp leftMatrixValues rightMatrixValues + + expectedValues, expectedColumns, expectedRows + +let makeExpandTest isEqual zero opMul 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 @@ -94,10 +125,43 @@ let makeExpandTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = let clRightMatrix = rightMatrix.ToDevice context let clSegmentPointers = context.CreateClArray segmentPointers - let (actualValues: ClArray<'a>), (actualColumns: ClArray), (actualRows: ClArray) = + let (clActualValues: ClArray<'a>), (clActualColumns: ClArray), (clActualRows: ClArray) = testFun processor length clSegmentPointers clLeftMatrix clRightMatrix - clLeftMatrix.Free processor - clRightMatrix. processor - clSegmentPointers + clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor + clSegmentPointers.Free processor + + let actualValues = clActualValues.ToHostAndFree processor + let actualColumns = clActualColumns.ToHostAndFree processor + let actualRows = clActualRows.ToHostAndFree processor + + let expectedValues, expectedColumns, expectedRows = + expand length segmentPointers opMul leftMatrix rightMatrix + + "Values must be the same" + |> Utils.compareArrays isEqual actualValues expectedValues + + "Columns must be the same" + |> Utils.compareArrays (=) actualColumns expectedColumns + + "Rows must be the same" + |> Utils.compareArrays (=) actualRows expectedRows + +let createExpandTest isEqual (zero: 'a) opMul opMulQ testFun = + + let testFun = testFun context Utils.defaultWorkGroupSize opMulQ + + makeExpandTest isEqual zero opMul testFun + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +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" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index d49deff2..befa7b96 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,7 +94,7 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ SpGeMM.getSegmentsTests ] + [ SpGeMM.expandTests ] |> testSequenced From 84fb950071c50a64c710097ca4be36304c351389 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Wed, 5 Apr 2023 21:53:02 +0300 Subject: [PATCH 13/33] wip: getUniqueBitmap{first/last} occurrence --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 49 ++++++++++---- .../Common/Sort/Radix.fs | 11 ++-- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 44 ++++++++++--- .../Common/Sort/Radix.fs | 14 ++-- tests/GraphBLAS-sharp.Tests/Helpers.fs | 12 ++++ tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 65 +++++++++++++++++++ tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 7 files changed, 162 insertions(+), 35 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index e8fba339..761e56ea 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -130,18 +130,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) @@ -163,6 +165,18 @@ module ClArray = bitmap + let getUniqueBitmapFirstOccurrence clContext = + getUniqueBitmapGeneral + <| <@ fun (gid: int) (_: int) (inputArray: ClArray<'a>) -> + gid = 0 || inputArray.[gid - 1] <> inputArray.[gid] @> + <| clContext + + let getUniqueBitmapLastOccurrence clContext = + getUniqueBitmapGeneral + <| <@ fun (gid: int) (length: int) (inputArray: ClArray<'a>) -> + gid = length - 1 || inputArray.[gid] <> inputArray.[gid + 1] @> + <| clContext + ///Remove duplicates form the given array. ///Computational context ///Should be a power of 2 and greater than 1. @@ -172,7 +186,7 @@ module ClArray = let scatter = Scatter.runInplace clContext workGroupSize - let getUniqueBitmap = getUniqueBitmap clContext workGroupSize + let getUniqueBitmap = getUniqueBitmapLastOccurrence clContext workGroupSize let prefixSumExclude = PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize @@ -292,24 +306,33 @@ module ClArray = resultArray - let getUniqueBitmap2<'a when 'a: equality> (clContext: ClContext) workGroupSize = + let getUniqueBitmap2General<'a when 'a: equality> getUniqueBitmap (clContext: ClContext) workGroupSize = - let map = map2 clContext workGroupSize <@ fun x y -> if x = 1 && y = 1 then 1 else 0 @> + let map = map2 clContext workGroupSize <@ fun x y -> x ||| y @> - let getUniqueBitmap = getUniqueBitmap clContext workGroupSize + let firstGetBitmap = getUniqueBitmap clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (firstArray: ClArray<'a>) (secondArray: ClArray<'a>) -> - let firstBitmap = getUniqueBitmap processor DeviceOnly firstArray + let firstBitmap = firstGetBitmap processor DeviceOnly firstArray - let secondBitmap = getUniqueBitmap processor DeviceOnly secondArray + let secondBitmap = firstGetBitmap processor DeviceOnly secondArray let result = map processor allocationMode firstBitmap secondBitmap + printfn $"first bitmap: %A{firstBitmap.ToHost processor}" + printfn $"second bitmap: %A{secondBitmap.ToHost processor}" + firstBitmap.Free processor secondBitmap.Free processor result + let getUniqueBitmap2FirstOccurrence clContext = + getUniqueBitmap2General getUniqueBitmapFirstOccurrence clContext + + let getUniqueBitmap2LastOccurrence clContext = + getUniqueBitmap2General getUniqueBitmapLastOccurrence clContext + let choose<'a, 'b> (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b option>) = let getBitmap = map<'a, int> clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs index d2055b6e..5b9e606e 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs @@ -264,25 +264,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/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index a5e8f90f..4e46dbbb 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -184,16 +184,16 @@ module Expand = fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> // sort by columns - let valuesSortedByColumns = sortByKeyValues processor columns values + let valuesSortedByColumns = sortByKeyValues processor DeviceOnly columns values - let rowsSortedByColumns = sortByKeyIndices processor columns rows + let rowsSortedByColumns = sortByKeyIndices processor DeviceOnly columns rows let sortedColumns = sortKeys processor columns // sort by rows - let valuesSortedByRows = sortByKeyValues processor rows valuesSortedByColumns + let valuesSortedByRows = sortByKeyValues processor DeviceOnly rows valuesSortedByColumns - let columnsSortedByRows = sortByKeyIndices processor rows sortedColumns + let columnsSortedByRows = sortByKeyIndices processor DeviceOnly rows sortedColumns let sortedRows = sortKeys processor rowsSortedByColumns @@ -208,21 +208,36 @@ module Expand = let reduce = Reduce.ByKey2D.segmentSequential clContext workGroupSize opAdd let getUniqueBitmap = - ClArray.getUniqueBitmap2 clContext workGroupSize + ClArray.getUniqueBitmap2FirstOccurrence clContext workGroupSize let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize - let removeDuplicates = ClArray.removeDuplications clContext workGroupSize + let init = ClArray.init clContext workGroupSize Map.id // TODO(fuse) + + let scatter = Scatter.runInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> let bitmap = getUniqueBitmap processor DeviceOnly columns rows + printfn $"key bitmap: %A{bitmap.ToHost processor}" + let uniqueKeysCount = (prefixSum processor bitmap).ToHostAndFree processor - let offsets = removeDuplicates processor bitmap + printfn $"key bitmap after prefix sum: %A{bitmap.ToHost processor}" + + let positions = init processor DeviceOnly bitmap.Length + + printfn $"positions: %A{positions.ToHost processor}" + + let offsets = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) + + scatter processor bitmap positions offsets + + printfn $"offsets: %A{offsets.ToHost processor}" bitmap.Free processor + positions.Free processor let reducedColumns, reducedRows, reducedValues = reduce processor allocationMode uniqueKeysCount offsets columns rows values @@ -231,7 +246,7 @@ module Expand = reducedValues, reducedColumns, reducedRows - let run (clContext: ClContext) workGroupSize opMul opAdd = + let run (clContext: ClContext) workGroupSize opAdd opMul = let getSegmentPointers = getSegmentPointers clContext workGroupSize @@ -248,9 +263,17 @@ module Expand = let values, columns, rows = expand processor length segmentPointers leftMatrix rightMatrix + printfn $"expanded values: %A{values.ToHost processor}" + printfn $"expanded columns: %A{columns.ToHost processor}" + printfn $"expanded rows: %A{rows.ToHost processor}" + let sortedValues, sortedColumns, sortedRows = sort processor values columns rows + printfn $"sorted values: %A{sortedValues.ToHost processor}" + printfn $"sorted columns: %A{sortedColumns.ToHost processor}" + printfn $"sorted rows: %A{sortedRows.ToHost processor}" + values.Free processor columns.Free processor rows.Free processor @@ -258,8 +281,13 @@ module Expand = let reducedValues, reducedColumns, reducedRows = reduce processor allocationMode sortedValues sortedColumns sortedRows + printfn $"reduced values: %A{reducedValues.ToHost processor}" + printfn $"reduced columns: %A{reducedColumns.ToHost processor}" + printfn $"reduced rows: %A{reducedRows.ToHost processor}" + sortedValues.Free processor sortedColumns.Free processor sortedRows.Free processor reducedValues, reducedColumns, reducedRows + diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs index 56add17c..f0a9df92 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,7 @@ 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 +46,7 @@ module Radix = makeTestByKeys<'a> sort |> testPropertyWithConfig config $"test on {typeof<'a>}" - let testFixturesByKeys = + let testByKeys = [ createTestByKeys createTestByKeys @@ -57,9 +55,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/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index ebd82453..e7c76c0f 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -225,6 +225,18 @@ module HostPrimitives = result + let array2DMultiplication mul add leftArray rightArray = + if Array2D.length2 leftArray <> Array2D.length1 rightArray then + failwith "Incompatible matrices" + + Array2D.init + <| Array2D.length1 leftArray + <| Array2D.length2 rightArray + <| fun i j -> + (leftArray.[i, *], rightArray.[*, j]) + ||> Array.map2 mul + |> Array.reduce add + module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs index 8ded29f0..f26474e7 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs @@ -12,6 +12,7 @@ open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects.ClContext let context = Context.defaultContext.ClContext @@ -165,3 +166,67 @@ let expandTests = createExpandTest (=) false (&&) <@ (&&) @> Expand.expand createExpandTest (=) 0uy (*) <@ (*) @> Expand.expand ] |> testList "Expand.expand" + +let checkGeneralResult zero isEqual actualValues actualColumns actualRows mul add (leftArray: 'a [,]) (rightArray: 'a [,]) = + + let expected = + HostPrimitives.array2DMultiplication mul add leftArray rightArray + |> fun array -> Utils.createMatrixFromArray2D COO array (isEqual zero) + |> function Matrix.COO matrix -> matrix | _ -> failwith "format miss" + + printfn $"leftMatrix \n %A{leftArray}" + printfn $"rightMatrix \n %A{rightArray}" + + printfn $"actual values: %A{actualValues}" + printfn $"expected values: %A{expected.Values}" + + printfn $"actualColumns: %A{actualColumns}" + printfn $"expectedColumns: %A{expected.Columns}" + + printfn $"actualRows: %A{actualRows}" + printfn $"expectedRows: %A{expected.Rows}" + + "Values must be the same" + |> Utils.compareArrays isEqual actualValues expected.Values + + "Columns must be the same" + |> Utils.compareArrays (=) actualColumns expected.Columns + + "Rows must be the same" + |> Utils.compareArrays (=) actualRows expected.Rows + +let makeGeneralTest zero isEqual opMul opAdd 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 clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + + let (clActualValues: ClArray<'a>), (clActualColumns: ClArray), (clActualRows: ClArray) = + testFun processor HostInterop clLeftMatrix clRightMatrix + + clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor + + let actualValues = clActualValues.ToHostAndFree processor + let actualColumns = clActualColumns.ToHostAndFree processor + let actualRows = clActualRows.ToHostAndFree processor + + checkGeneralResult zero isEqual actualValues actualColumns actualRows opMul opAdd leftArray rightArray + +let createGeneralTest (zero: 'a) isEqual opAdd opAddQ opMul opMulQ testFun = + + let testFun = testFun context Utils.defaultWorkGroupSize opAddQ opMulQ + + makeGeneralTest zero isEqual opMul opAdd testFun + |> testPropertyWithConfig { config with endSize = 10 } $"test on %A{typeof<'a>}" + +let generalTests = + [ createGeneralTest 0 (=) (+) <@ (+) @> (*) <@ (*) @> Expand.run ] + |> testList "general" + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index befa7b96..5a590c3f 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,7 +94,7 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ SpGeMM.expandTests ] + [ SpGeMM.generalTests ] |> testSequenced From 8ec7fd750a11213b009aff3d46726f7eae259039 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Wed, 5 Apr 2023 22:22:16 +0300 Subject: [PATCH 14/33] add: Scatter.firstOccurrence --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 4 +- src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 89 +++++++++++++------ .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 4 +- .../Matrix/CSRMatrix/SpGEMMMasked.fs | 4 +- src/GraphBLAS-sharp.Backend/Matrix/Common.fs | 4 +- .../Vector/DenseVector/DenseVector.fs | 4 +- .../Vector/SparseVector/Common.fs | 4 +- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 2 +- tests/GraphBLAS-sharp.Tests/Common/Scatter.fs | 32 +++++-- tests/GraphBLAS-sharp.Tests/Helpers.fs | 8 +- tests/GraphBLAS-sharp.Tests/Program.fs | 4 +- 11 files changed, 107 insertions(+), 52 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 761e56ea..b8c25e8b 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -184,7 +184,7 @@ module ClArray = let removeDuplications (clContext: ClContext) workGroupSize = let scatter = - Scatter.runInplace clContext workGroupSize + Scatter.scatterLastOccurrence clContext workGroupSize let getUniqueBitmap = getUniqueBitmapLastOccurrence clContext workGroupSize @@ -349,7 +349,7 @@ module ClArray = PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize let scatter = - Scatter.runInplace clContext workGroupSize + Scatter.scatterLastOccurrence clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (array: ClArray<'a>) -> diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index e8c8b737..ac680e35 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -3,26 +3,7 @@ namespace GraphBLAS.FSharp.Backend.Common open Brahma.FSharp module internal Scatter = - - /// - /// 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 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 - /// ... - /// > val result = [| 2.8; 5.5; 6.4; 8.2; 9.1 |] - /// - /// - let runInplace<'a> (clContext: ClContext) workGroupSize = + 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) -> @@ -30,14 +11,11 @@ module internal Scatter = let gid = ndRange.GlobalID0 if gid < positionsLength then - let index = positions.[gid] + // positions lengths == values length + let predicateResult = (%predicate) gid positionsLength positions resultLength - if 0 <= index && index < resultLength then - if gid < positionsLength - 1 then - if index <> positions.[gid + 1] then - result.[index] <- values.[gid] - else - result.[index] <- values.[gid] @> + if predicateResult then + result.[positions.[gid]] <- values.[gid] @> let program = clContext.Compile(run) @@ -58,3 +36,60 @@ module internal Scatter = ) 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 |] + /// let result = run clContext 32 processor positions values result + /// ... + /// > val result = [| 1,9; 3.7; 6.4; 7.3; 9.1 |] + /// + /// + let scatterFirstOccurrence clContext = + general + <| <@ fun gid _ (positions: ClArray) resultLength -> + let currentKey = positions.[gid] + // first occurrence condition + (gid = 0 || positions.[gid - 1] <> positions.[gid]) + // result position in valid range + && (0 <= currentKey && currentKey < resultLength) @> + <| 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 + /// 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 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 + /// ... + /// > val result = [| 2.8; 5.5; 6.4; 8.2; 9.1 |] + /// + /// + let scatterLastOccurrence clContext = + general + <| <@ fun gid positionsLength (positions: ClArray) resultLength -> + let index = positions.[gid] + // last occurrence condition + (gid = positionsLength - 1 || index <> positions.[gid + 1]) + // result position in valid range + && (0 <= index && index < resultLength) @> + <| clContext + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 4e46dbbb..45b8bce1 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -81,7 +81,7 @@ module Expand = let init = ClArray.init clContext workGroupSize Map.id - let scatter = Scatter.runInplace clContext workGroupSize + let scatter = Scatter.scatterLastOccurrence clContext workGroupSize let zeroCreate = ClArray.zeroCreate clContext workGroupSize @@ -214,7 +214,7 @@ module Expand = let init = ClArray.init clContext workGroupSize Map.id // TODO(fuse) - let scatter = Scatter.runInplace clContext workGroupSize + let scatter = Scatter.scatterLastOccurrence clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs index ad034f91..52297150 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs @@ -151,8 +151,8 @@ module internal SpGEMMMasked = let calculate = calculate context workGroupSize opAdd opMul - let scatter = Scatter.runInplace context workGroupSize - let scatterData = Scatter.runInplace context workGroupSize + let scatter = Scatter.scatterLastOccurrence context workGroupSize + let scatterData = Scatter.scatterLastOccurrence 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 eaca8906..3fab5f9c 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.scatterLastOccurrence clContext workGroupSize let valuesScatter = - Scatter.runInplace clContext workGroupSize + Scatter.scatterLastOccurrence clContext workGroupSize let sum = PrefixSum.standardExcludeInplace clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index 5aca4a57..af6ceff2 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.scatterLastOccurrence clContext workGroupSize let scatterIndices = - Scatter.runInplace clContext workGroupSize + Scatter.scatterLastOccurrence 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..2f781406 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.scatterLastOccurrence clContext workGroupSize let indicesScatter = - Scatter.runInplace clContext workGroupSize + Scatter.scatterLastOccurrence 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..d6c2dc96 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.scatterLastOccurrence clContext workGroupSize let zeroCreate = ClArray.zeroCreate clContext workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs index 9bb976b3..221088ff 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs @@ -21,13 +21,13 @@ let wgSize = Tests.Utils.defaultWorkGroupSize let q = defaultContext.Queue -let makeTest scatter (array: (int * 'a) []) (result: 'a []) = +let makeTest hostScatter scatter (array: (int * 'a) []) (result: 'a []) = if array.Length > 0 then let positions, values = Array.unzip array let expected = Array.copy result - |> HostPrimitives.scatter positions values + |> hostScatter positions values let actual = use clPositions = context.CreateClArray positions @@ -41,15 +41,29 @@ let makeTest scatter (array: (int * 'a) []) (result: 'a []) = $"Arrays should be equal. Actual is \n%A{actual}, expected \n%A{expected}" |> Tests.Utils.compareArrays (=) actual expected -let testFixtures<'a when 'a: equality> = - Scatter.runInplace<'a> context wgSize - |> makeTest +let testFixturesLast<'a when 'a: equality> hostScatter = + Scatter.scatterLastOccurrence<'a> context wgSize + |> makeTest hostScatter + |> testPropertyWithConfig { config with endSize = 10 } $"Correctness on %A{typeof<'a>}" + +let testFixturesFirst<'a when 'a: equality> hostScatter = + Scatter.scatterFirstOccurrence<'a> context wgSize + |> makeTest hostScatter |> testPropertyWithConfig { config with endSize = 10 } $"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 HostPrimitives.scatterLastOccurrence + testFixturesLast HostPrimitives.scatterLastOccurrence + testFixturesLast HostPrimitives.scatterLastOccurrence ] + |> testList "Last Occurrence" + + let first = + [ testFixturesFirst HostPrimitives.scatterFirstOccurrence + testFixturesFirst HostPrimitives.scatterFirstOccurrence + testFixturesFirst HostPrimitives.scatterFirstOccurrence ] + |> testList "First Occurrence" + + testList "Scatter tests" [first; last] diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index e7c76c0f..c941d7ec 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -200,11 +200,11 @@ module HostPrimitives = ||> Array.map2 (fun (fst, snd) value -> fst, snd, value) |> Array.unzip3 - let scatter (positions: int array) (values: 'a array) (resultValues: 'a array) = + 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 = getUniqueBitmapLastOccurrence positions + let bitmap = getBitmap positions Array.iteri2 (fun index bit key -> @@ -215,6 +215,10 @@ module HostPrimitives = 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" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 5a590c3f..a044bf8b 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,7 +94,9 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ SpGeMM.generalTests ] + [ // SpGeMM.generalTests + Common.Scatter.tests + ] |> testSequenced From 63037b677c7623a7ab8bfd0c50c6538c7df6c559 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 09:44:13 +0300 Subject: [PATCH 15/33] spgemm: left filtering --- .../Common/Sort/Radix.fs | 3 ++- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 12 ++++++--- tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 27 +++++++++---------- tests/GraphBLAS-sharp.Tests/Program.fs | 3 +-- 4 files changed, 24 insertions(+), 21 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs index 5b9e606e..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 = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 45b8bce1..5e77b9c7 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -191,9 +191,9 @@ module Expand = let sortedColumns = sortKeys processor columns // sort by rows - let valuesSortedByRows = sortByKeyValues processor DeviceOnly rows valuesSortedByColumns + let valuesSortedByRows = sortByKeyValues processor DeviceOnly rowsSortedByColumns valuesSortedByColumns - let columnsSortedByRows = sortByKeyIndices processor DeviceOnly rows sortedColumns + let columnsSortedByRows = sortByKeyIndices processor DeviceOnly rowsSortedByColumns sortedColumns let sortedRows = sortKeys processor rowsSortedByColumns @@ -206,15 +206,16 @@ module Expand = let reduce (clContext: ClContext) workGroupSize opAdd = let reduce = Reduce.ByKey2D.segmentSequential clContext workGroupSize opAdd + //let reduce = Reduce.ByKey2D.sequential clContext workGroupSize opAdd let getUniqueBitmap = - ClArray.getUniqueBitmap2FirstOccurrence clContext workGroupSize + ClArray.getUniqueBitmap2LastOccurrence clContext workGroupSize let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize let init = ClArray.init clContext workGroupSize Map.id // TODO(fuse) - let scatter = Scatter.scatterLastOccurrence clContext workGroupSize + let scatter = Scatter.scatterFirstOccurrence clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> @@ -242,6 +243,9 @@ module Expand = let reducedColumns, reducedRows, reducedValues = reduce processor allocationMode uniqueKeysCount offsets columns rows values + // let reducedColumns, reducedRows, reducedValues = + // reduce processor DeviceOnly uniqueKeysCount columns rows values + offsets.Free processor reducedValues, reducedColumns, reducedRows diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs index f26474e7..8102d533 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs @@ -203,30 +203,29 @@ let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightAr if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + try + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context - let clLeftMatrix = leftMatrix.ToDevice context - let clRightMatrix = rightMatrix.ToDevice context + let (clActualValues: ClArray<'a>), (clActualColumns: ClArray), (clActualRows: ClArray) = + testFun processor HostInterop clLeftMatrix clRightMatrix - let (clActualValues: ClArray<'a>), (clActualColumns: ClArray), (clActualRows: ClArray) = - testFun processor HostInterop clLeftMatrix clRightMatrix + let actualValues = clActualValues.ToHostAndFree processor + let actualColumns = clActualColumns.ToHostAndFree processor + let actualRows = clActualRows.ToHostAndFree processor - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor - - let actualValues = clActualValues.ToHostAndFree processor - let actualColumns = clActualColumns.ToHostAndFree processor - let actualRows = clActualRows.ToHostAndFree processor - - checkGeneralResult zero isEqual actualValues actualColumns actualRows opMul opAdd leftArray rightArray + checkGeneralResult zero isEqual actualValues actualColumns actualRows opMul opAdd leftArray rightArray + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex let createGeneralTest (zero: 'a) isEqual opAdd opAddQ opMul opMulQ testFun = let testFun = testFun context Utils.defaultWorkGroupSize opAddQ opMulQ makeGeneralTest zero isEqual opMul opAdd testFun - |> testPropertyWithConfig { config with endSize = 10 } $"test on %A{typeof<'a>}" + |> testPropertyWithConfig { config with endSize = 10; maxTest = 1000 } $"test on %A{typeof<'a>}" let generalTests = [ createGeneralTest 0 (=) (+) <@ (+) @> (*) <@ (*) @> Expand.run ] |> testList "general" - diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index a044bf8b..01ba9564 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,8 +94,7 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ // SpGeMM.generalTests - Common.Scatter.tests + [ SpGeMM.generalTests ] |> testSequenced From 03e7e95a9b3f30b04235651256354071790b80a2 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 10:22:48 +0300 Subject: [PATCH 16/33] add: init gather --- src/GraphBLAS-sharp.Backend/Common/Gather.fs | 36 +++++++++-- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 10 ++-- tests/GraphBLAS-sharp.Tests/Common/Gather.fs | 60 +++++++++++++++++++ tests/GraphBLAS-sharp.Tests/Program.fs | 4 +- 4 files changed, 98 insertions(+), 12 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs index 3f980651..9837b9c1 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Gather.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -3,6 +3,34 @@ 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). /// @@ -19,13 +47,13 @@ module internal Gather = let gather = <@ fun (ndRange: Range1D) positionsLength valuesLength (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> - let i = ndRange.GlobalID0 + let gid = ndRange.GlobalID0 - if i < positionsLength then - let position = positions.[i] + if gid < positionsLength then + let position = positions.[gid] if position >= 0 && position < valuesLength then - outputArray.[i] <- values.[position] @> + outputArray.[gid] <- values.[position] @> let program = clContext.Compile gather diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 5e77b9c7..bd6b2d23 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -27,6 +27,8 @@ module Expand = let gather = Gather.run clContext workGroupSize + let shiftedGather = Gather.runInit Map.inc clContext workGroupSize + let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> @@ -130,7 +132,7 @@ module Expand = // another way to get offsets ??? let offsets = removeDuplicates processor segmentsPointers - segmentPrefixSum processor offsets.Length BPositions APositions offsets // TODO(offsets lengths in scan) + segmentPrefixSum processor offsets.Length BPositions APositions offsets offsets.Free processor @@ -206,7 +208,6 @@ module Expand = let reduce (clContext: ClContext) workGroupSize opAdd = let reduce = Reduce.ByKey2D.segmentSequential clContext workGroupSize opAdd - //let reduce = Reduce.ByKey2D.sequential clContext workGroupSize opAdd let getUniqueBitmap = ClArray.getUniqueBitmap2LastOccurrence clContext workGroupSize @@ -240,12 +241,9 @@ module Expand = bitmap.Free processor positions.Free processor - let reducedColumns, reducedRows, reducedValues = + let reducedColumns, reducedRows, reducedValues = // by size variance TODO() reduce processor allocationMode uniqueKeysCount offsets columns rows values - // let reducedColumns, reducedRows, reducedValues = - // reduce processor DeviceOnly uniqueKeysCount columns rows values - offsets.Free processor reducedValues, reducedColumns, reducedRows diff --git a/tests/GraphBLAS-sharp.Tests/Common/Gather.fs b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs index f991d0a4..96ff6527 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Gather.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs @@ -6,6 +6,7 @@ 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 @@ -62,3 +63,62 @@ let tests = 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] + + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 01ba9564..cd8e3659 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,8 +94,8 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ SpGeMM.generalTests - ] + [ // SpGeMM.generalTests + Common.Gather.initTests ] |> testSequenced From 6f02570415f1241c4a2731fd18baf27c956c923f Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 11:25:45 +0300 Subject: [PATCH 17/33] add: init scatter --- src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 51 +++++++++- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 24 +---- tests/GraphBLAS-sharp.Tests/Common/Scatter.fs | 93 ++++++++++++++----- tests/GraphBLAS-sharp.Tests/Program.fs | 5 +- 4 files changed, 127 insertions(+), 46 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index ac680e35..d34393be 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -50,7 +50,7 @@ module internal Scatter = /// /// 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 = [| 1,9; 3.7; 6.4; 7.3; 9.1 |] /// @@ -78,7 +78,7 @@ module internal Scatter = /// /// 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 |] /// @@ -93,3 +93,50 @@ module internal Scatter = && (0 <= index && index < resultLength) @> <| clContext + /// + /// Writes elements from the array of values to the array at the positions indicated by the global id map. + /// + /// + /// If index is out of bounds, the value will be ignored. + /// + /// + /// + /// let positionMap = fun x -> x + 1 + /// let values = [| 1.9; 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; 8.2; 9.1 |] + /// let result = ... // create result + /// run positionMap clContext 32 processor positions values result + /// ... + /// > val result = [| 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; 8.2; 9.1 |] + /// + /// + /// Should be injective in order to avoid race conditions. + let init<'a> positionMap (clContext: ClContext) workGroupSize = + + let run = + <@ fun (ndRange: Range1D) (valuesLength: int) (values: ClArray<'a>) (result: ClArray<'a>) resultLength -> + + let gid = ndRange.GlobalID0 + + if gid < valuesLength then + let position = (%positionMap) gid + + // may be race condition + if 0 <= position && position < resultLength then + result.[position] <- values.[gid] @> + + let program = clContext.Compile(run) + + fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (result: ClArray<'a>) -> + + let ndRange = + Range1D.CreateValid(values.Length, workGroupSize) + + let kernel = program.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange values.Length values result result.Length) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index bd6b2d23..ee9439bf 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -17,18 +17,14 @@ type Values<'a> = ClArray<'a> module Expand = let getSegmentPointers (clContext: ClContext) workGroupSize = - let create = - ClArray.init clContext workGroupSize Map.id + let subtract = ClArray.map2 clContext workGroupSize Map.subtraction - let createShifted = - ClArray.init clContext workGroupSize Map.inc + let idGather = Gather.runInit Map.id clContext workGroupSize - let subtract = ClArray.map2 clContext workGroupSize Map.subtraction + let incGather = Gather.runInit Map.inc clContext workGroupSize let gather = Gather.run clContext workGroupSize - let shiftedGather = Gather.runInit Map.inc clContext workGroupSize - let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> @@ -37,27 +33,17 @@ module Expand = // extract first rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers // (right matrix row pointers without last item) - let positions = // TODO(fuse) - create processor DeviceOnly positionsLength - let firstPointers = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) - gather processor positions rightMatrix.RowPointers firstPointers - - positions.Free processor + idGather processor rightMatrix.RowPointers firstPointers // extract last rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers // (right matrix row pointers without first item) - let shiftedPositions = // TODO(fuse) - createShifted processor DeviceOnly positionsLength - let lastPointers = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) - gather processor shiftedPositions rightMatrix.RowPointers lastPointers - - shiftedPositions.Free processor + incGather processor rightMatrix.RowPointers lastPointers // subtract let rightMatrixRowsLengths = diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs index 221088ff..7ffc2d34 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs @@ -5,7 +5,7 @@ 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 @@ -13,15 +13,13 @@ let logger = Log.create "Scatter.Tests" let context = defaultContext.ClContext -let config = - { Tests.Utils.defaultConfig with - endSize = 1000000 } +let config = { Utils.defaultConfig with endSize = 10000 } -let wgSize = Tests.Utils.defaultWorkGroupSize +let wgSize = Utils.defaultWorkGroupSize let q = defaultContext.Queue -let makeTest hostScatter 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 positions, values = Array.unzip array @@ -30,7 +28,7 @@ let makeTest hostScatter scatter (array: (int * 'a) []) (result: 'a []) = |> hostScatter positions values let actual = - use clPositions = context.CreateClArray positions + let clPositions = context.CreateClArray positions use clValues = context.CreateClArray values use clResult = context.CreateClArray result @@ -38,32 +36,81 @@ let makeTest hostScatter scatter (array: (int * 'a) []) (result: 'a []) = 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 testFixturesLast<'a when 'a: equality> hostScatter = - Scatter.scatterLastOccurrence<'a> context wgSize - |> makeTest hostScatter - |> testPropertyWithConfig { config with endSize = 10 } $"Correctness on %A{typeof<'a>}" +let testFixturesLast<'a when 'a: equality> = + Scatter.scatterLastOccurrence context wgSize + |> makeTest<'a> HostPrimitives.scatterLastOccurrence + |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" -let testFixturesFirst<'a when 'a: equality> hostScatter = - Scatter.scatterFirstOccurrence<'a> context wgSize - |> makeTest hostScatter - |> testPropertyWithConfig { config with endSize = 10 } $"Correctness on %A{typeof<'a>}" +let testFixturesFirst<'a when 'a: equality> = + Scatter.scatterFirstOccurrence context wgSize + |> makeTest<'a> HostPrimitives.scatterFirstOccurrence + |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" let tests = q.Error.Add(fun e -> failwithf $"%A{e}") let last = - [ testFixturesLast HostPrimitives.scatterLastOccurrence - testFixturesLast HostPrimitives.scatterLastOccurrence - testFixturesLast HostPrimitives.scatterLastOccurrence ] + [ testFixturesLast + testFixturesLast + testFixturesLast ] |> testList "Last Occurrence" let first = - [ testFixturesFirst HostPrimitives.scatterFirstOccurrence - testFixturesFirst HostPrimitives.scatterFirstOccurrence - testFixturesFirst HostPrimitives.scatterFirstOccurrence ] + [ testFixturesFirst + testFixturesFirst + testFixturesFirst ] |> testList "First Occurrence" testList "Scatter tests" [first; last] + +let makeTestInit<'a when 'a: equality> positionsMap scatter (values: 'a []) (result: 'a []) = + if values.Length > 0 then + + let positionsAndValues = + Array.mapi (fun index value -> positionsMap index, value) values + + let expected = + Array.init result.Length (fun index -> + match Array.tryFind (fst >> ((=) index)) positionsAndValues with + | Some (_, value) -> value + | None -> result.[index]) + + let actual = + let values = Array.map snd positionsAndValues + + use clValues = context.CreateClArray values + use clResult = context.CreateClArray result + + scatter q clValues clResult + + clResult.ToHostAndFree q + + $"Arrays should be equal." + |> Utils.compareArrays (=) actual expected + +let createInitTest<'a when 'a: equality> indexMap indexMapQ = + Scatter.init<'a> indexMapQ context Utils.defaultWorkGroupSize + |> makeTestInit<'a> indexMap + |> testPropertyWithConfig config $"test on {typeof<'a>}" + +let initTests = + q.Error.Add(fun e -> failwithf $"%A{e}") + + let idTest = + [ createInitTest id Map.id + createInitTest id Map.id + createInitTest id Map.id ] + |> testList "id" + + let inc = ((+) 1) + + let incTest = + [ createInitTest inc Map.inc + createInitTest inc Map.inc + createInitTest inc Map.inc ] + |> testList "increment" + + testList "Scatter init tests" [idTest; incTest] diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index cd8e3659..f274004f 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,8 +94,9 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ // SpGeMM.generalTests - Common.Gather.initTests ] + [ // SpGeMM.getSegmentsTests + // Common.Gather.initTests + Common.Scatter.initTests ] |> testSequenced From 29c564ce443302b124fff15ca188f18528194276 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 13:23:39 +0300 Subject: [PATCH 18/33] add: scatter init value --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 4 +- src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 122 +++++++++++------- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 4 +- .../Matrix/CSRMatrix/SpGEMMMasked.fs | 4 +- src/GraphBLAS-sharp.Backend/Matrix/Common.fs | 4 +- .../Vector/DenseVector/DenseVector.fs | 4 +- .../Vector/SparseVector/Common.fs | 4 +- src/GraphBLAS-sharp.Backend/Vector/Vector.fs | 2 +- tests/GraphBLAS-sharp.Tests/Common/Scatter.fs | 78 +++++------ tests/GraphBLAS-sharp.Tests/Program.fs | 2 +- 10 files changed, 132 insertions(+), 96 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index b8c25e8b..d39d5ec4 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -184,7 +184,7 @@ module ClArray = let removeDuplications (clContext: ClContext) workGroupSize = let scatter = - Scatter.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let getUniqueBitmap = getUniqueBitmapLastOccurrence clContext workGroupSize @@ -349,7 +349,7 @@ module ClArray = PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize let scatter = - Scatter.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (array: ClArray<'a>) -> diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index d34393be..7a73fd2c 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -3,6 +3,17 @@ namespace GraphBLAS.FSharp.Backend.Common open Brahma.FSharp module internal Scatter = + let firstOccurencePredicate () = + <@ fun gid _ (positions: ClArray) -> + // first occurrence condition + (gid = 0 || positions.[gid - 1] <> positions.[gid]) @> + + let lastOccurrencePredicate () = + <@ fun gid positionsLength (positions: ClArray) -> + // last occurrence condition + (gid = positionsLength - 1 || positions.[gid] <> positions.[gid + 1]) @> + + let private general<'a> predicate (clContext: ClContext) workGroupSize = let run = @@ -12,9 +23,12 @@ module internal Scatter = if gid < positionsLength then // positions lengths == values length - let predicateResult = (%predicate) gid positionsLength positions resultLength + let predicateResult = (%predicate) gid positionsLength positions + let position = positions.[gid] + + if predicateResult + && 0 <= position && position < resultLength then - if predicateResult then result.[positions.[gid]] <- values.[gid] @> let program = clContext.Compile(run) @@ -55,14 +69,9 @@ module internal Scatter = /// > val result = [| 1,9; 3.7; 6.4; 7.3; 9.1 |] /// /// - let scatterFirstOccurrence clContext = + let firstOccurrence clContext = general - <| <@ fun gid _ (positions: ClArray) resultLength -> - let currentKey = positions.[gid] - // first occurrence condition - (gid = 0 || positions.[gid - 1] <> positions.[gid]) - // result position in valid range - && (0 <= currentKey && currentKey < resultLength) @> + <| firstOccurencePredicate () <| clContext /// @@ -71,7 +80,7 @@ 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. /// /// @@ -83,60 +92,85 @@ module internal Scatter = /// > val result = [| 2.8; 5.5; 6.4; 8.2; 9.1 |] /// /// - let scatterLastOccurrence clContext = + let lastOccurrence clContext = general - <| <@ fun gid positionsLength (positions: ClArray) resultLength -> - let index = positions.[gid] - // last occurrence condition - (gid = positionsLength - 1 || index <> positions.[gid + 1]) - // result position in valid range - && (0 <= index && index < resultLength) @> + <| lastOccurrencePredicate () <| clContext - /// - /// Writes elements from the array of values to the array at the positions indicated by the global id map. - /// - /// - /// If index is out of bounds, the value will be ignored. - /// - /// - /// - /// let positionMap = fun x -> x + 1 - /// let values = [| 1.9; 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; 8.2; 9.1 |] - /// let result = ... // create result - /// run positionMap clContext 32 processor positions values result - /// ... - /// > val result = [| 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; 8.2; 9.1 |] - /// - /// - /// Should be injective in order to avoid race conditions. - let init<'a> positionMap (clContext: ClContext) workGroupSize = + let private generalInit<'a> predicate valueMap (clContext: ClContext) workGroupSize = let run = - <@ fun (ndRange: Range1D) (valuesLength: int) (values: ClArray<'a>) (result: ClArray<'a>) resultLength -> + <@ fun (ndRange: Range1D) (positions: ClArray) (positionsLength: int) (result: ClArray<'a>) (resultLength: int) -> let gid = ndRange.GlobalID0 - if gid < valuesLength then - let position = (%positionMap) gid + 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 - // may be race condition - if 0 <= position && position < resultLength then - result.[position] <- values.[gid] @> + result.[positions.[gid]] <- (%valueMap) gid @> let program = clContext.Compile(run) - fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (result: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) (positions: ClArray) (result: ClArray<'a>) -> + + let positionsLength = positions.Length let ndRange = - Range1D.CreateValid(values.Length, workGroupSize) + Range1D.CreateValid(positionsLength, workGroupSize) let kernel = program.GetKernel() processor.Post( Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange values.Length values result result.Length) + (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> <| firstOccurencePredicate () <| 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> <| lastOccurrencePredicate () <| valueMap diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index ee9439bf..c56ffc01 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -69,7 +69,7 @@ module Expand = let init = ClArray.init clContext workGroupSize Map.id - let scatter = Scatter.scatterLastOccurrence clContext workGroupSize + let scatter = Scatter.lastOccurrence clContext workGroupSize let zeroCreate = ClArray.zeroCreate clContext workGroupSize @@ -202,7 +202,7 @@ module Expand = let init = ClArray.init clContext workGroupSize Map.id // TODO(fuse) - let scatter = Scatter.scatterFirstOccurrence clContext workGroupSize + let scatter = Scatter.firstOccurrence clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs index 52297150..c4c1b4d7 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs @@ -151,8 +151,8 @@ module internal SpGEMMMasked = let calculate = calculate context workGroupSize opAdd opMul - let scatter = Scatter.scatterLastOccurrence context workGroupSize - let scatterData = Scatter.scatterLastOccurrence 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 3fab5f9c..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.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let valuesScatter = - Scatter.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let sum = PrefixSum.standardExcludeInplace clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs index af6ceff2..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.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let scatterIndices = - Scatter.scatterLastOccurrence 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 2f781406..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.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let indicesScatter = - Scatter.scatterLastOccurrence 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 d6c2dc96..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.scatterLastOccurrence clContext workGroupSize + Scatter.lastOccurrence clContext workGroupSize let zeroCreate = ClArray.zeroCreate clContext workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs index 7ffc2d34..bd2629cb 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs @@ -13,7 +13,7 @@ let logger = Log.create "Scatter.Tests" let context = defaultContext.ClContext -let config = { Utils.defaultConfig with endSize = 10000 } +let config = Utils.defaultConfig let wgSize = Utils.defaultWorkGroupSize @@ -21,7 +21,9 @@ let q = defaultContext.Queue let makeTest<'a when 'a: equality> hostScatter scatter (array: (int * 'a) []) (result: 'a []) = if array.Length > 0 then - let positions, values = Array.unzip array + let positions, values = + Array.sortBy fst array + |> Array.unzip let expected = Array.copy result @@ -29,23 +31,25 @@ let makeTest<'a when 'a: equality> hostScatter scatter (array: (int * 'a) []) (r let actual = let clPositions = context.CreateClArray positions - use clValues = context.CreateClArray values - use clResult = context.CreateClArray result + let clValues = context.CreateClArray values + let clResult = context.CreateClArray result scatter q clPositions clValues clResult + clValues.Free q + clValues.Free q clResult.ToHostAndFree q $"Arrays should be equal." |> Utils.compareArrays (=) actual expected let testFixturesLast<'a when 'a: equality> = - Scatter.scatterLastOccurrence context wgSize + Scatter.lastOccurrence context wgSize |> makeTest<'a> HostPrimitives.scatterLastOccurrence |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" let testFixturesFirst<'a when 'a: equality> = - Scatter.scatterFirstOccurrence context wgSize + Scatter.firstOccurrence context wgSize |> makeTest<'a> HostPrimitives.scatterFirstOccurrence |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" @@ -64,53 +68,51 @@ let tests = testFixturesFirst ] |> testList "First Occurrence" - testList "Scatter tests" [first; last] + testList "ones occurrence" [first; last] -let makeTestInit<'a when 'a: equality> positionsMap scatter (values: 'a []) (result: 'a []) = - if values.Length > 0 then +let makeTestInit<'a when 'a: equality> hostScatter valueMap scatter (positions: int []) (result: 'a []) = + if positions.Length > 0 then - let positionsAndValues = - Array.mapi (fun index value -> positionsMap index, value) values + let values = Array.init positions.Length valueMap + let positions = Array.sort positions let expected = - Array.init result.Length (fun index -> - match Array.tryFind (fst >> ((=) index)) positionsAndValues with - | Some (_, value) -> value - | None -> result.[index]) - - let actual = - let values = Array.map snd positionsAndValues + Array.copy result + |> hostScatter positions values - use clValues = context.CreateClArray values - use clResult = context.CreateClArray result + let clPositions = context.CreateClArray positions + let clResult = context.CreateClArray result - scatter q clValues clResult + scatter q clPositions clResult - clResult.ToHostAndFree q + let actual = clResult.ToHostAndFree q + clPositions.Free q + clResult.Free q $"Arrays should be equal." |> Utils.compareArrays (=) actual expected -let createInitTest<'a when 'a: equality> indexMap indexMapQ = - Scatter.init<'a> indexMapQ context Utils.defaultWorkGroupSize - |> makeTestInit<'a> indexMap - |> testPropertyWithConfig config $"test on {typeof<'a>}" +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 idTest = - [ createInitTest id Map.id - createInitTest id Map.id - createInitTest id Map.id ] - |> testList "id" - let inc = ((+) 1) - let incTest = - [ createInitTest inc Map.inc - createInitTest inc Map.inc - createInitTest inc Map.inc ] - |> testList "increment" + 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 ] - testList "Scatter init tests" [idTest; incTest] +let allTests = testList "Scatter" [ tests; initTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index f274004f..3b1194a8 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -96,7 +96,7 @@ let allTests = "All tests" [ // SpGeMM.getSegmentsTests // Common.Gather.initTests - Common.Scatter.initTests ] + Common.Scatter.allTests ] |> testSequenced From 972b3924c99d55bf7e5914edc19b19d3a23f380d Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 13:35:16 +0300 Subject: [PATCH 19/33] refactor: init in spgemm --- src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 4 ++-- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 21 ++++++------------- tests/GraphBLAS-sharp.Tests/Program.fs | 5 +++-- 3 files changed, 11 insertions(+), 19 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index 7a73fd2c..5109a7b1 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -3,12 +3,12 @@ namespace GraphBLAS.FSharp.Backend.Common open Brahma.FSharp module internal Scatter = - let firstOccurencePredicate () = + let private firstOccurencePredicate () = <@ fun gid _ (positions: ClArray) -> // first occurrence condition (gid = 0 || positions.[gid - 1] <> positions.[gid]) @> - let lastOccurrencePredicate () = + let private lastOccurrencePredicate () = <@ fun gid positionsLength (positions: ClArray) -> // last occurrence condition (gid = positionsLength - 1 || positions.[gid] <> positions.[gid + 1]) @> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index c56ffc01..d12c3bcb 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -69,6 +69,8 @@ module Expand = let init = ClArray.init clContext workGroupSize Map.id + let idScatter = Scatter.initLastOccurrence Map.id clContext workGroupSize + let scatter = Scatter.lastOccurrence clContext workGroupSize let zeroCreate = ClArray.zeroCreate clContext workGroupSize @@ -94,18 +96,14 @@ module Expand = fun (processor: MailboxProcessor<_>) lengths (segmentsPointers: Indices) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> // Compute A positions - let sequence = init processor DeviceOnly segmentsPointers.Length // TODO(fuse) - let APositions = zeroCreate processor DeviceOnly lengths - scatter processor segmentsPointers sequence APositions - - sequence.Free processor + idScatter processor segmentsPointers APositions (maxPrefixSum processor APositions 0).Free processor // Compute B positions - let BPositions = create processor DeviceOnly lengths 1 // TODO(fuse) + let BPositions = create processor DeviceOnly lengths 1 let requiredBPointers = zeroCreate processor DeviceOnly leftMatrix.Columns.Length @@ -200,9 +198,7 @@ module Expand = let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize - let init = ClArray.init clContext workGroupSize Map.id // TODO(fuse) - - let scatter = Scatter.firstOccurrence clContext workGroupSize + let idScatter = Scatter.initFirsOccurrence Map.id clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> @@ -214,18 +210,13 @@ module Expand = printfn $"key bitmap after prefix sum: %A{bitmap.ToHost processor}" - let positions = init processor DeviceOnly bitmap.Length - - printfn $"positions: %A{positions.ToHost processor}" - let offsets = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) - scatter processor bitmap positions offsets + idScatter processor bitmap offsets printfn $"offsets: %A{offsets.ToHost processor}" bitmap.Free processor - positions.Free processor let reducedColumns, reducedRows, reducedValues = // by size variance TODO() reduce processor allocationMode uniqueKeysCount offsets columns rows values diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 3b1194a8..4976895a 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,9 +94,10 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ // SpGeMM.getSegmentsTests + [ SpGeMM.generalTests // Common.Gather.initTests - Common.Scatter.allTests ] + //Common.Scatter.allTests ] + ] |> testSequenced From 73d755f7f5e202ef90919c94bd5f1e642f2be16e Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 14:31:12 +0300 Subject: [PATCH 20/33] refactor: deforestation in ClArray.choose --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 67 ++++++++++++------- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 2 - tests/GraphBLAS-sharp.Tests/Program.fs | 3 +- 3 files changed, 43 insertions(+), 29 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index d39d5ec4..1983899a 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -319,9 +319,6 @@ module ClArray = let result = map processor allocationMode firstBitmap secondBitmap - printfn $"first bitmap: %A{firstBitmap.ToHost processor}" - printfn $"second bitmap: %A{secondBitmap.ToHost processor}" - firstBitmap.Free processor secondBitmap.Free processor @@ -333,42 +330,60 @@ module ClArray = 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>) -> + + 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.standardExcludeInplace clContext workGroupSize - let prefixSum = - PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize - - let scatter = - Scatter.lastOccurrence 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 values = - getValues processor DeviceOnly optionValues - - let result = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let result = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - scatter processor positions values result + assignValues processor sourceValues positions result result diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index d12c3bcb..9e8518be 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -67,8 +67,6 @@ module Expand = let expand (clContext: ClContext) workGroupSize opMul = - let init = ClArray.init clContext workGroupSize Map.id - let idScatter = Scatter.initLastOccurrence Map.id clContext workGroupSize let scatter = Scatter.lastOccurrence clContext workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 4976895a..c8950c2e 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,9 +94,10 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ SpGeMM.generalTests + [ // SpGeMM.generalTests // Common.Gather.initTests //Common.Scatter.allTests ] + Common.ClArray.Choose.tests ] |> testSequenced From f34e590482333fa46a3a16b5e0b7242e7428a049 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 18:20:17 +0300 Subject: [PATCH 21/33] add: ClArray.choose2 --- .../BenchmarksBFS.fs | 2 +- .../BenchmarksEWiseAdd.fs | 6 +- .../VectorEWiseAddGen.fs | 16 ++--- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 64 +++++++++++++++++++ .../Quotes/Arithmetic.fs | 42 +++++++++--- src/GraphBLAS-sharp.Backend/Quotes/Map.fs | 6 ++ tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs | 2 +- .../Common/ClArray/Choose.fs | 47 +++++++++++++- tests/GraphBLAS-sharp.Tests/Matrix/Map.fs | 2 +- tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs | 8 +-- tests/GraphBLAS-sharp.Tests/Program.fs | 4 +- tests/GraphBLAS-sharp.Tests/Vector/Map2.fs | 18 +++--- tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs | 14 ++-- 13 files changed, 182 insertions(+), 49 deletions(-) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs index c9e2d233..95d25fc9 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs @@ -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/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/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 1983899a..e2dbb88f 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -352,6 +352,8 @@ module ClArray = 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) @@ -387,3 +389,65 @@ module ClArray = result + let private 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 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) + + assignValues processor firstValues secondValues positions result + + result diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 8aa72db5..32e3d5b9 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,30 @@ 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 + + let intAdd = createPair 0 (+) <@ (+) @> + + let boolAdd = createPair false (||) <@ (||) @> + + let floatAdd = createPair 0.0 (+) <@ (+) @> + + let float32Add = createPair 0.0f (+) <@ (+) @> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs index a697d5e0..f0750dac 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs @@ -22,6 +22,12 @@ 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 @> diff --git a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs b/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs index 1590f142..65bfb8f9 100644 --- a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs +++ b/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs @@ -22,7 +22,7 @@ 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..a17b35de 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,42 @@ 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 with maxTest = 1000 } $"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/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/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index c8950c2e..7f89df5a 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -96,9 +96,7 @@ let allTests = "All tests" [ // SpGeMM.generalTests // Common.Gather.initTests - //Common.Scatter.allTests ] - Common.ClArray.Choose.tests - ] + Common.ClArray.Choose.tests2 ] |> 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 1ce37add..2f7c5149 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs @@ -105,8 +105,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 +115,8 @@ let testFixturesSpMV (testContext: TestContext) = Utils.floatIsEqual (+) (*) - ArithmeticOperations.floatSum - ArithmeticOperations.floatMul + ArithmeticOperations.floatSumOption + ArithmeticOperations.floatMulOption createTest testContext @@ -124,10 +124,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 From 751ee68fea5997661a6f94fc29ddd40b19d4f551 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 22:41:39 +0300 Subject: [PATCH 22/33] add: filter after multiplication --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 2 +- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 76 ++++++++++++++----- .../Quotes/Arithmetic.fs | 10 +++ .../Common/ClArray/Choose.fs | 2 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 5 +- tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 49 ++++++------ tests/GraphBLAS-sharp.Tests/Program.fs | 7 +- 7 files changed, 104 insertions(+), 47 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index e2dbb88f..0d4cf1b2 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -389,7 +389,7 @@ module ClArray = result - let private assignOption2 (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b -> 'c option>) = + 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 -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 9e8518be..d88a4712 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -9,6 +9,7 @@ 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 @@ -65,7 +66,40 @@ module Expand = length, segmentsLengths - let expand (clContext: ClContext) workGroupSize opMul = + 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 // TODO(last ?) + + 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 @@ -89,8 +123,6 @@ module Expand = let BGather = Gather.run clContext workGroupSize - let mul = ClArray.map2 clContext workGroupSize opMul - fun (processor: MailboxProcessor<_>) lengths (segmentsPointers: Indices) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> // Compute A positions @@ -150,13 +182,8 @@ module Expand = BPositions.Free processor - // multiply values TODO(filter values) - let values = mul processor DeviceOnly AValues BValues - - AValues.Free processor - BValues.Free processor - - values, columns, rows + // left, right matrix values, columns and rows indices + AValues, BValues, columns, rows let sortByColumnsAndRows (clContext: ClContext) workGroupSize = @@ -227,7 +254,9 @@ module Expand = let getSegmentPointers = getSegmentPointers clContext workGroupSize - let expand = expand clContext workGroupSize opMul + let expand = expand clContext workGroupSize + + let multiply = multiply clContext workGroupSize opMul let sort = sortByColumnsAndRows clContext workGroupSize @@ -237,24 +266,37 @@ module Expand = let length, segmentPointers = getSegmentPointers processor leftMatrix rightMatrix - let values, columns, rows = + // expand + let leftMatrixValues, rightMatrixValues, columns, rows = expand processor length segmentPointers leftMatrix rightMatrix - printfn $"expanded values: %A{values.ToHost processor}" + printfn $"left matrix values: %A{leftMatrixValues.ToHost processor}" + printfn $"right matrix values: %A{rightMatrixValues.ToHost processor}" printfn $"expanded columns: %A{columns.ToHost processor}" printfn $"expanded rows: %A{rows.ToHost processor}" + // 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 values columns rows + sort processor resultValues resultColumns resultRows printfn $"sorted values: %A{sortedValues.ToHost processor}" printfn $"sorted columns: %A{sortedColumns.ToHost processor}" printfn $"sorted rows: %A{sortedRows.ToHost processor}" - values.Free processor - columns.Free processor - rows.Free processor + resultValues.Free processor + resultColumns.Free processor + resultRows.Free processor + // addition let reducedValues, reducedColumns, reducedRows = reduce processor allocationMode sortedValues sortedColumns sortedRows diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 32e3d5b9..bd2d159a 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -141,6 +141,7 @@ module ArithmeticOperations = let inline createPair zero op opQ = binOpQ zero opQ, binOp zero op + // addition let intAdd = createPair 0 (+) <@ (+) @> let boolAdd = createPair false (||) <@ (||) @> @@ -148,3 +149,12 @@ module ArithmeticOperations = let floatAdd = createPair 0.0 (+) <@ (+) @> let float32Add = createPair 0.0f (+) <@ (+) @> + + // multiplication + let intMul = createPair 0 (*) <@ (*) @> + + let boolMul = createPair false (&&) <@ (&&) @> + + let floatMul = createPair 0.0 (*) <@ (*) @> + + let float32Mul = createPair 0.0f (*) <@ (*) @> diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs index a17b35de..1863b191 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs @@ -85,7 +85,7 @@ let createTest2 (isEqual: 'a -> 'a -> bool) (opMapQ, opMap) testFun = let testFun = testFun context Utils.defaultWorkGroupSize opMapQ makeTest2 isEqual opMap testFun - |> testPropertyWithConfig { config with maxTest = 1000 } $"test on %A{typeof<'a>}" + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" let tests2 = [ createTest2 (=) ArithmeticOperations.intAdd ClArray.choose2 diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index c941d7ec..0fe23f11 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -229,7 +229,7 @@ module HostPrimitives = result - let array2DMultiplication mul add leftArray rightArray = + let array2DMultiplication zero mul add leftArray rightArray = if Array2D.length2 leftArray <> Array2D.length1 rightArray then failwith "Incompatible matrices" @@ -239,7 +239,8 @@ module HostPrimitives = <| fun i j -> (leftArray.[i, *], rightArray.[*, j]) ||> Array.map2 mul - |> Array.reduce add + |> Array.choose id + |> Array.fold add zero module Context = type TestContext = diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs index 8102d533..25b4913d 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs @@ -2,6 +2,7 @@ module GraphBLAS.FSharp.Tests.Matrix.SpGeMM 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 @@ -76,7 +77,7 @@ let getSegmentsTests = createTest ((=) 0uy) Expand.getSegmentPointers ] |> testList "get segment pointers" -let expand length segmentPointers mulOp (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = +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) @@ -106,11 +107,9 @@ let expand length segmentPointers mulOp (leftMatrix: Matrix.CSR<'a>) (rightMatri |> Array.concat |> Array.unzip - let expectedValues = Array.map2 mulOp leftMatrixValues rightMatrixValues + leftMatrixValues, rightMatrixValues, expectedColumns, expectedRows - expectedValues, expectedColumns, expectedRows - -let makeExpandTest isEqual zero opMul testFun (leftArray: 'a [,], rightArray: 'a [,]) = +let makeExpandTest isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = let leftMatrix = createCSRMatrix leftArray <| isEqual zero @@ -126,22 +125,26 @@ let makeExpandTest isEqual zero opMul testFun (leftArray: 'a [,], rightArray: 'a let clRightMatrix = rightMatrix.ToDevice context let clSegmentPointers = context.CreateClArray segmentPointers - let (clActualValues: ClArray<'a>), (clActualColumns: ClArray), (clActualRows: ClArray) = + 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 actualValues = clActualValues.ToHostAndFree processor + let actualLeftValues = clActualLeftValues.ToHostAndFree processor + let actualRightValues = clActualRightValues.ToHostAndFree processor let actualColumns = clActualColumns.ToHostAndFree processor let actualRows = clActualRows.ToHostAndFree processor - let expectedValues, expectedColumns, expectedRows = - expand length segmentPointers opMul leftMatrix rightMatrix + let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns, expectedRows = + expand length segmentPointers leftMatrix rightMatrix + + "Left values must be the same" + |> Utils.compareArrays isEqual actualLeftValues expectedLeftMatrixValues - "Values must be the same" - |> Utils.compareArrays isEqual actualValues expectedValues + "Right values must be the same" + |> Utils.compareArrays isEqual actualRightValues expectedRightMatrixValues "Columns must be the same" |> Utils.compareArrays (=) actualColumns expectedColumns @@ -149,28 +152,28 @@ let makeExpandTest isEqual zero opMul testFun (leftArray: 'a [,], rightArray: 'a "Rows must be the same" |> Utils.compareArrays (=) actualRows expectedRows -let createExpandTest isEqual (zero: 'a) opMul opMulQ testFun = +let createExpandTest isEqual (zero: 'a) testFun = - let testFun = testFun context Utils.defaultWorkGroupSize opMulQ + let testFun = testFun context Utils.defaultWorkGroupSize - makeExpandTest isEqual zero opMul testFun + makeExpandTest isEqual zero testFun |> testPropertyWithConfig config $"test on %A{typeof<'a>}" let expandTests = - [ createExpandTest (=) 0 (*) <@ (*) @> Expand.expand + [ createExpandTest (=) 0 Expand.expand if Utils.isFloat64Available context.ClDevice then - createExpandTest Utils.floatIsEqual 0.0 (*) <@ (*) @> Expand.expand + createExpandTest Utils.floatIsEqual 0.0 Expand.expand - createExpandTest Utils.float32IsEqual 0f (*) <@ (*) @> Expand.expand - createExpandTest (=) false (&&) <@ (&&) @> Expand.expand - createExpandTest (=) 0uy (*) <@ (*) @> Expand.expand ] + createExpandTest Utils.float32IsEqual 0f Expand.expand + createExpandTest (=) false Expand.expand + createExpandTest (=) 0uy Expand.expand ] |> testList "Expand.expand" let checkGeneralResult zero isEqual actualValues actualColumns actualRows mul add (leftArray: 'a [,]) (rightArray: 'a [,]) = let expected = - HostPrimitives.array2DMultiplication mul add leftArray rightArray + HostPrimitives.array2DMultiplication zero mul add leftArray rightArray |> fun array -> Utils.createMatrixFromArray2D COO array (isEqual zero) |> function Matrix.COO matrix -> matrix | _ -> failwith "format miss" @@ -217,9 +220,9 @@ let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightAr checkGeneralResult zero isEqual actualValues actualColumns actualRows opMul opAdd leftArray rightArray with | ex when ex.Message = "InvalidBufferSize" -> () - | ex -> raise ex + | _ -> reraise () -let createGeneralTest (zero: 'a) isEqual opAdd opAddQ opMul opMulQ testFun = +let createGeneralTest (zero: 'a) isEqual opAddQ opAdd (opMulQ, opMul) testFun = let testFun = testFun context Utils.defaultWorkGroupSize opAddQ opMulQ @@ -227,5 +230,5 @@ let createGeneralTest (zero: 'a) isEqual opAdd opAddQ opMul opMulQ testFun = |> testPropertyWithConfig { config with endSize = 10; maxTest = 1000 } $"test on %A{typeof<'a>}" let generalTests = - [ createGeneralTest 0 (=) (+) <@ (+) @> (*) <@ (*) @> Expand.run ] + [ createGeneralTest 0 (=) <@ (+) @> (+) ArithmeticOperations.intMul Expand.run ] |> testList "general" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 7f89df5a..513f54cf 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -94,10 +94,11 @@ open GraphBLAS.FSharp.Tests.Matrix let allTests = testList "All tests" - [ // SpGeMM.generalTests + [ // SpGeMM.expandTests + SpGeMM.generalTests // Common.Gather.initTests - Common.ClArray.Choose.tests2 ] - + // Common.ClArray.Choose.tests2 ] + ] |> testSequenced [] From 69be680727566be2233e370121021e5116af27d1 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Thu, 6 Apr 2023 23:55:37 +0300 Subject: [PATCH 23/33] add: reduce by key option --- src/GraphBLAS-sharp.Backend/Common/Sum.fs | 125 ++++++++++++++++++ .../Common/Reduce/ReduceByKey.fs | 95 +++++++++++++ tests/GraphBLAS-sharp.Tests/Program.fs | 4 +- 3 files changed, 222 insertions(+), 2 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index ca84fab9..953f4e6c 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 = /// @@ -616,3 +617,127 @@ module Reduce = 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/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index 6a7f66f3..c015550a 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -2,6 +2,7 @@ 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 @@ -14,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 = @@ -336,3 +347,87 @@ let sequentialSegmentTests2D = 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 testsByKey2DSegmentsSequential = + [ 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" + + + diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 513f54cf..7e1a4974 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -95,10 +95,10 @@ let allTests = testList "All tests" [ // SpGeMM.expandTests - SpGeMM.generalTests + // SpGeMM.generalTests // Common.Gather.initTests // Common.ClArray.Choose.tests2 ] - ] + Common.Reduce.ByKey.testsByKey2DSegmentsSequential ] |> testSequenced [] From 3f7c0bf757fb4e43a876dca6792935c0d5434a57 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Apr 2023 09:03:57 +0300 Subject: [PATCH 24/33] add: spgemm --- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 2 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 15 +++++++++++++-- tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 6 +++--- tests/GraphBLAS-sharp.Tests/Program.fs | 5 +++-- 4 files changed, 20 insertions(+), 8 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index d88a4712..857ca8b9 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -216,7 +216,7 @@ module Expand = let reduce (clContext: ClContext) workGroupSize opAdd = - let reduce = Reduce.ByKey2D.segmentSequential clContext workGroupSize opAdd + let reduce = Reduce.ByKey2D.segmentSequentialOption clContext workGroupSize opAdd let getUniqueBitmap = ClArray.getUniqueBitmap2LastOccurrence clContext workGroupSize diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 0fe23f11..c4375449 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -233,15 +233,26 @@ module HostPrimitives = 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 - |> Array.fold add zero - + // add and filter + |> Array.map Some + |> Array.fold add None + |> function | Some value -> value | None -> zero module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs index 25b4913d..a73953d3 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs @@ -222,13 +222,13 @@ let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightAr | ex when ex.Message = "InvalidBufferSize" -> () | _ -> reraise () -let createGeneralTest (zero: 'a) isEqual opAddQ opAdd (opMulQ, opMul) testFun = +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 with endSize = 10; maxTest = 1000 } $"test on %A{typeof<'a>}" + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" let generalTests = - [ createGeneralTest 0 (=) <@ (+) @> (+) ArithmeticOperations.intMul Expand.run ] + [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Expand.run ] |> testList "general" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 7e1a4974..ae4e742d 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -95,10 +95,11 @@ let allTests = testList "All tests" [ // SpGeMM.expandTests - // SpGeMM.generalTests + SpGeMM.generalTests // Common.Gather.initTests // Common.ClArray.Choose.tests2 ] - Common.Reduce.ByKey.testsByKey2DSegmentsSequential ] + // Common.Reduce.ByKey.testsByKey2DSegmentsSequential ] + ] |> testSequenced [] From 96c0c0822b32ee0a737c292f5df65de213170472 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Apr 2023 10:28:00 +0300 Subject: [PATCH 25/33] refactor: spgemm --- .../BenchmarksMxm.fs | 12 +- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 68 +++-- src/GraphBLAS-sharp.Backend/Common/Gather.fs | 16 +- .../Common/PrefixSum.fs | 1 - src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 46 +-- src/GraphBLAS-sharp.Backend/Common/Sum.fs | 32 ++- .../GraphBLAS-sharp.Backend.fsproj | 22 +- .../Matrix/CSRMatrix/Matrix.fs | 50 +++- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 141 ++++++---- .../{SpGEMMMasked.fs => SpGEMM/Masked.fs} | 11 +- src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs | 46 ++- .../Quotes/Arithmetic.fs | 10 +- tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs | 6 +- .../Common/ClArray/Choose.fs | 11 +- tests/GraphBLAS-sharp.Tests/Common/Gather.fs | 19 +- .../Common/Reduce/ReduceByKey.fs | 80 ++++-- tests/GraphBLAS-sharp.Tests/Common/Scatter.fs | 19 +- .../Common/Sort/Radix.fs | 3 +- .../GraphBLAS-sharp.Tests.fsproj | 6 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 55 ++-- tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs | 234 ---------------- .../Matrix/SpGeMM/Expand.fs | 264 ++++++++++++++++++ .../Matrix/{Mxm.fs => SpGeMM/Masked.fs} | 10 +- tests/GraphBLAS-sharp.Tests/Program.fs | 177 ++++++------ 24 files changed, 746 insertions(+), 593 deletions(-) rename src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/{SpGEMMMasked.fs => SpGEMM/Masked.fs} (96%) delete mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs create mode 100644 tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs rename tests/GraphBLAS-sharp.Tests/Matrix/{Mxm.fs => SpGeMM/Masked.fs} (91%) 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/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 0d4cf1b2..8275c434 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -168,13 +168,15 @@ module ClArray = let getUniqueBitmapFirstOccurrence clContext = getUniqueBitmapGeneral <| <@ fun (gid: int) (_: int) (inputArray: ClArray<'a>) -> - gid = 0 || inputArray.[gid - 1] <> inputArray.[gid] @> + gid = 0 + || inputArray.[gid - 1] <> inputArray.[gid] @> <| clContext let getUniqueBitmapLastOccurrence clContext = getUniqueBitmapGeneral <| <@ fun (gid: int) (length: int) (inputArray: ClArray<'a>) -> - gid = length - 1 || inputArray.[gid] <> inputArray.[gid + 1] @> + gid = length - 1 + || inputArray.[gid] <> inputArray.[gid + 1] @> <| clContext ///Remove duplicates form the given array. @@ -186,7 +188,8 @@ module ClArray = let scatter = Scatter.lastOccurrence clContext workGroupSize - let getUniqueBitmap = getUniqueBitmapLastOccurrence clContext workGroupSize + let getUniqueBitmap = + getUniqueBitmapLastOccurrence clContext workGroupSize let prefixSumExclude = PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize @@ -308,16 +311,20 @@ module ClArray = let getUniqueBitmap2General<'a when 'a: equality> getUniqueBitmap (clContext: ClContext) workGroupSize = - let map = map2 clContext workGroupSize <@ fun x y -> x ||| y @> + 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 firstBitmap = + firstGetBitmap processor DeviceOnly firstArray - let secondBitmap = firstGetBitmap processor DeviceOnly secondArray + let secondBitmap = + firstGetBitmap processor DeviceOnly secondArray - let result = map processor allocationMode firstBitmap secondBitmap + let result = + map processor allocationMode firstBitmap secondBitmap firstBitmap.Free processor secondBitmap.Free processor @@ -344,15 +351,15 @@ module ClArray = // seems like scatter (option scatter) ??? if 0 <= position && position < resultLength then match (%op) value with - | Some value -> - result.[position] <- value + | 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" + if values.Length <> positions.Length then + failwith "lengths must be the same" let ndRange = Range1D.CreateValid(values.Length, workGroupSize) @@ -371,19 +378,23 @@ module ClArray = map<'a, int> clContext workGroupSize <| Map.chooseBitmap predicate - let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize - let assignValues = assignOption clContext workGroupSize predicate + let assignValues = + assignOption clContext workGroupSize predicate fun (processor: MailboxProcessor<_>) allocationMode (sourceValues: ClArray<'a>) -> - let positions = getBitmap processor DeviceOnly sourceValues + let positions = + getBitmap processor DeviceOnly sourceValues let resultLength = (prefixSum processor positions) .ToHostAndFree(processor) - let result = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) assignValues processor sourceValues positions result @@ -405,8 +416,7 @@ module ClArray = // seems like scatter2 (option scatter2) ??? if 0 <= position && position < resultLength then match (%op) leftValue rightValue with - | Some value -> - result.[position] <- value + | Some value -> result.[position] <- value | None -> () @> let kernel = clContext.Compile assign @@ -414,8 +424,8 @@ module ClArray = 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" + || secondValues.Length <> positions.Length then + failwith "lengths must be the same" let ndRange = Range1D.CreateValid(firstValues.Length, workGroupSize) @@ -424,7 +434,15 @@ module ClArray = processor.Post( Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange firstValues.Length firstValues secondValues positions result result.Length) + (fun () -> + kernel.KernelFunc + ndRange + firstValues.Length + firstValues + secondValues + positions + result + result.Length) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -434,19 +452,23 @@ module ClArray = map2<'a, 'b, int> clContext workGroupSize <| Map.chooseBitmap2 predicate - let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize - let assignValues = assignOption2 clContext workGroupSize predicate + let assignValues = + assignOption2 clContext workGroupSize predicate fun (processor: MailboxProcessor<_>) allocationMode (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) -> - let positions = getBitmap processor DeviceOnly firstValues secondValues + let positions = + getBitmap processor DeviceOnly firstValues secondValues let resultLength = (prefixSum processor positions) .ToHostAndFree(processor) - let result = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) assignValues processor firstValues secondValues positions result diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs index 9837b9c1..c4f1fa19 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Gather.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -22,11 +22,10 @@ module internal Gather = let kernel = program.GetKernel() - let ndRange = Range1D.CreateValid(outputArray.Length, workGroupSize) + let ndRange = + Range1D.CreateValid(outputArray.Length, workGroupSize) - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange values.Length values outputArray) - ) + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange values.Length values outputArray)) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -59,14 +58,17 @@ module internal Gather = fun (processor: MailboxProcessor<_>) (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> - if positions.Length <> outputArray.Length then failwith "Lengths must be the same" + if positions.Length <> outputArray.Length then + failwith "Lengths must be the same" let kernel = program.GetKernel() - let ndRange = Range1D.CreateValid(positions.Length, workGroupSize) + let ndRange = + Range1D.CreateValid(positions.Length, workGroupSize) processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange positions.Length values.Length positions values outputArray) + 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/PrefixSum.fs b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs index 591b9a28..3ecd363c 100644 --- a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs @@ -341,4 +341,3 @@ module PrefixSum = /// let sequentialInclude clContext = sequentialSegments (Map.snd ()) clContext - diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index 5109a7b1..4146ea0c 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -5,13 +5,14 @@ open Brahma.FSharp module internal Scatter = let private firstOccurencePredicate () = <@ fun gid _ (positions: ClArray) -> - // first occurrence condition - (gid = 0 || positions.[gid - 1] <> positions.[gid]) @> + // first occurrence condition + (gid = 0 || positions.[gid - 1] <> positions.[gid]) @> let private lastOccurrencePredicate () = <@ fun gid positionsLength (positions: ClArray) -> - // last occurrence condition - (gid = positionsLength - 1 || positions.[gid] <> positions.[gid + 1]) @> + // last occurrence condition + (gid = positionsLength - 1 + || positions.[gid] <> positions.[gid + 1]) @> let private general<'a> predicate (clContext: ClContext) workGroupSize = @@ -23,11 +24,14 @@ module internal Scatter = if gid < positionsLength then // positions lengths == values length - let predicateResult = (%predicate) gid positionsLength positions + let predicateResult = + (%predicate) gid positionsLength positions + let position = positions.[gid] if predicateResult - && 0 <= position && position < resultLength then + && 0 <= position + && position < resultLength then result.[positions.[gid]] <- values.[gid] @> @@ -35,7 +39,8 @@ module internal Scatter = fun (processor: MailboxProcessor<_>) (positions: ClArray) (values: ClArray<'a>) (result: ClArray<'a>) -> - if positions.Length <> values.Length then failwith "Lengths must be the same" + if positions.Length <> values.Length then + failwith "Lengths must be the same" let positionsLength = positions.Length @@ -70,9 +75,7 @@ module internal Scatter = /// /// let firstOccurrence clContext = - general - <| firstOccurencePredicate () - <| clContext + general <| firstOccurencePredicate () <| 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 @@ -93,9 +96,7 @@ module internal Scatter = /// /// let lastOccurrence clContext = - general - <| lastOccurrencePredicate () - <| clContext + general <| lastOccurrencePredicate () <| clContext let private generalInit<'a> predicate valueMap (clContext: ClContext) workGroupSize = @@ -106,12 +107,14 @@ module internal Scatter = if gid < positionsLength then // positions lengths == values length - let predicateResult = (%predicate) gid positionsLength positions + let predicateResult = + (%predicate) gid positionsLength positions let position = positions.[gid] if predicateResult - && 0 <= position && position < resultLength then + && 0 <= position + && position < resultLength then result.[positions.[gid]] <- (%valueMap) gid @> @@ -127,8 +130,7 @@ module internal Scatter = let kernel = program.GetKernel() processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange positions positionsLength result result.Length) + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange positions positionsLength result result.Length) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -152,7 +154,10 @@ module internal Scatter = /// /// /// Maps global id to a value - let initFirsOccurrence<'a> valueMap = generalInit<'a> <| firstOccurencePredicate () <| valueMap + let initFirsOccurrence<'a> valueMap = + generalInit<'a> + <| firstOccurencePredicate () + <| 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 @@ -173,4 +178,7 @@ module internal Scatter = /// /// /// Maps global id to a value - let initLastOccurrence<'a> valueMap = generalInit<'a> <| lastOccurrencePredicate () <| valueMap + let initLastOccurrence<'a> valueMap = + generalInit<'a> + <| lastOccurrencePredicate () + <| valueMap diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index 953f4e6c..bdf1840d 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -536,7 +536,16 @@ module Reduce = processor.Post( Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange firstKeys.Length firstKeys secondKeys values reducedValues firstReducedKeys secondReducedKeys) + (fun () -> + kernel.KernelFunc + ndRange + firstKeys.Length + firstKeys + secondKeys + values + reducedValues + firstReducedKeys + secondReducedKeys) ) processor.Post(Msg.CreateRunMsg<_, _>(kernel)) @@ -650,11 +659,11 @@ module Reduce = match sum with | Some value -> - let result = ((%reduceOp) value values.[currentPosition]) // brahma error + let result = + ((%reduceOp) value values.[currentPosition]) // brahma error sum <- result - | None -> - sum <- Some values.[currentPosition] + | None -> sum <- Some values.[currentPosition] currentPosition <- currentPosition + 1 @@ -662,19 +671,21 @@ module Reduce = | Some value -> reducedValues.[gid] <- value resultPositions.[gid] <- 1 - | None -> - resultPositions.[gid] <- 0 + | None -> resultPositions.[gid] <- 0 firstReducedKeys.[gid] <- firstSourceKey secondReducedKeys.[gid] <- secondSourceKey @> let kernel = clContext.Compile kernel - let scatterData = Scatter.lastOccurrence clContext workGroupSize + let scatterData = + Scatter.lastOccurrence clContext workGroupSize - let scatterIndices = Scatter.lastOccurrence clContext workGroupSize + let scatterIndices = + Scatter.lastOccurrence clContext workGroupSize - let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> @@ -715,7 +726,8 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) let resultLength = - (prefixSum processor resultPositions).ToHostAndFree processor + (prefixSum processor resultPositions) + .ToHostAndFree processor let resultValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 006437cb..74797513 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -31,19 +31,18 @@ - + - - - + + @@ -56,21 +55,6 @@ - - - - - diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs index 4f3f0f09..63cd4fcc 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs @@ -104,17 +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>) - = - - let run = - SpGEMMMasked.run clContext workGroupSize opAdd opMul - - fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> - - run queue matrixLeft matrixRight mask - + 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 + + fun (queue: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + + let values, columns, rows = + run queue allocationMode leftMatrix rightMatrix + + { 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 index 857ca8b9..71f5fff9 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -18,15 +18,19 @@ type Values<'a> = ClArray<'a> module Expand = let getSegmentPointers (clContext: ClContext) workGroupSize = - let subtract = ClArray.map2 clContext workGroupSize Map.subtraction + let subtract = + ClArray.map2 clContext workGroupSize Map.subtraction - let idGather = Gather.runInit Map.id clContext workGroupSize + let idGather = + Gather.runInit Map.id clContext workGroupSize - let incGather = Gather.runInit Map.inc clContext workGroupSize + let incGather = + Gather.runInit Map.inc clContext workGroupSize let gather = Gather.run clContext workGroupSize - let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> @@ -62,7 +66,9 @@ module Expand = rightMatrixRowsLengths.Free processor // compute pointers - let length = (prefixSum processor segmentsLengths).ToHostAndFree processor + let length = + (prefixSum processor segmentsLengths) + .ToHostAndFree processor length, segmentsLengths @@ -71,29 +77,36 @@ module Expand = ClArray.map2<'a, 'b, int> clContext workGroupSize <| Map.chooseBitmap2 predicate - let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize - let assignValues = ClArray.assignOption2 clContext workGroupSize predicate + let assignValues = + ClArray.assignOption2 clContext workGroupSize predicate - let scatter = Scatter.lastOccurrence clContext workGroupSize // TODO(last ?) + 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 positions = + getBitmap processor DeviceOnly firstValues secondValues let resultLength = (prefixSum processor positions) .ToHostAndFree(processor) - let resultColumns = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + let resultColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) scatter processor positions columns resultColumns - let resultRows = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + let resultRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) scatter processor positions rows resultRows - let resultValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) assignValues processor firstValues secondValues positions resultValues @@ -101,23 +114,30 @@ module Expand = let expand (clContext: ClContext) workGroupSize = - let idScatter = Scatter.initLastOccurrence Map.id clContext workGroupSize + let idScatter = + Scatter.initLastOccurrence Map.id clContext workGroupSize - let scatter = Scatter.lastOccurrence clContext workGroupSize + let scatter = + Scatter.lastOccurrence clContext workGroupSize - let zeroCreate = ClArray.zeroCreate clContext workGroupSize + let zeroCreate = + ClArray.zeroCreate clContext workGroupSize - let maxPrefixSum = PrefixSum.runIncludeInplace <@ max @> 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 segmentPrefixSum = + PrefixSum.ByKey.sequentialInclude clContext workGroupSize <@ (+) @> 0 - let removeDuplicates = ClArray.removeDuplications clContext workGroupSize + let removeDuplicates = + ClArray.removeDuplications clContext workGroupSize - let expandRowPointers = Common.expandRowPointers clContext workGroupSize + let expandRowPointers = + Common.expandRowPointers clContext workGroupSize let AGather = Gather.run clContext workGroupSize @@ -130,12 +150,14 @@ module Expand = idScatter processor segmentsPointers APositions - (maxPrefixSum processor APositions 0).Free processor + (maxPrefixSum processor APositions 0) + .Free processor // Compute B positions let BPositions = create processor DeviceOnly lengths 1 - let requiredBPointers = zeroCreate processor DeviceOnly leftMatrix.Columns.Length + let requiredBPointers = + zeroCreate processor DeviceOnly leftMatrix.Columns.Length gather processor leftMatrix.Columns rightMatrix.RowPointers requiredBPointers @@ -144,7 +166,8 @@ module Expand = requiredBPointers.Free processor // another way to get offsets ??? - let offsets = removeDuplicates processor segmentsPointers + let offsets = + removeDuplicates processor segmentsPointers segmentPrefixSum processor offsets.Length BPositions APositions offsets @@ -157,7 +180,8 @@ module Expand = gather processor BPositions rightMatrix.Columns columns // compute rows - let ARows = expandRowPointers processor DeviceOnly leftMatrix.RowPointers leftMatrix.NNZ leftMatrix.RowCount + let ARows = + expandRowPointers processor DeviceOnly leftMatrix.RowPointers leftMatrix.NNZ leftMatrix.RowCount let rows = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) @@ -187,24 +211,31 @@ module Expand = let sortByColumnsAndRows (clContext: ClContext) workGroupSize = - let sortByKeyIndices = Radix.runByKeysStandard clContext workGroupSize + let sortByKeyIndices = + Radix.runByKeysStandard clContext workGroupSize - let sortByKeyValues = Radix.runByKeysStandard clContext workGroupSize + let sortByKeyValues = + Radix.runByKeysStandard clContext workGroupSize - let sortKeys = Radix.standardRunKeysOnly 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 valuesSortedByColumns = + sortByKeyValues processor DeviceOnly columns values - let rowsSortedByColumns = sortByKeyIndices processor DeviceOnly columns rows + let rowsSortedByColumns = + sortByKeyIndices processor DeviceOnly columns rows let sortedColumns = sortKeys processor columns // sort by rows - let valuesSortedByRows = sortByKeyValues processor DeviceOnly rowsSortedByColumns valuesSortedByColumns + let valuesSortedByRows = + sortByKeyValues processor DeviceOnly rowsSortedByColumns valuesSortedByColumns - let columnsSortedByRows = sortByKeyIndices processor DeviceOnly rowsSortedByColumns sortedColumns + let columnsSortedByRows = + sortByKeyIndices processor DeviceOnly rowsSortedByColumns sortedColumns let sortedRows = sortKeys processor rowsSortedByColumns @@ -214,33 +245,34 @@ module Expand = valuesSortedByRows, columnsSortedByRows, sortedRows - let reduce (clContext: ClContext) workGroupSize opAdd = + let reduce (clContext: ClContext) workGroupSize opAdd = - let reduce = Reduce.ByKey2D.segmentSequentialOption clContext workGroupSize opAdd + let reduce = + Reduce.ByKey2D.segmentSequentialOption clContext workGroupSize opAdd let getUniqueBitmap = ClArray.getUniqueBitmap2LastOccurrence clContext workGroupSize - let prefixSum = PrefixSum.standardExcludeInplace clContext workGroupSize + let prefixSum = + PrefixSum.standardExcludeInplace clContext workGroupSize - let idScatter = Scatter.initFirsOccurrence Map.id 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 bitmap = + getUniqueBitmap processor DeviceOnly columns rows - printfn $"key bitmap: %A{bitmap.ToHost processor}" + let uniqueKeysCount = + (prefixSum processor bitmap) + .ToHostAndFree processor - let uniqueKeysCount = (prefixSum processor bitmap).ToHostAndFree processor - - printfn $"key bitmap after prefix sum: %A{bitmap.ToHost processor}" - - let offsets = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) + let offsets = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) idScatter processor bitmap offsets - printfn $"offsets: %A{offsets.ToHost processor}" - bitmap.Free processor let reducedColumns, reducedRows, reducedValues = // by size variance TODO() @@ -252,29 +284,27 @@ module Expand = let run (clContext: ClContext) workGroupSize opAdd opMul = - let getSegmentPointers = getSegmentPointers clContext workGroupSize + let getSegmentPointers = + getSegmentPointers clContext workGroupSize let expand = expand clContext workGroupSize let multiply = multiply clContext workGroupSize opMul - let sort = sortByColumnsAndRows clContext workGroupSize + 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 + let length, segmentPointers = + getSegmentPointers processor leftMatrix rightMatrix // expand let leftMatrixValues, rightMatrixValues, columns, rows = expand processor length segmentPointers leftMatrix rightMatrix - printfn $"left matrix values: %A{leftMatrixValues.ToHost processor}" - printfn $"right matrix values: %A{rightMatrixValues.ToHost processor}" - printfn $"expanded columns: %A{columns.ToHost processor}" - printfn $"expanded rows: %A{rows.ToHost processor}" - // multiply let resultValues, resultColumns, resultRows = multiply processor leftMatrixValues rightMatrixValues columns rows @@ -288,10 +318,6 @@ module Expand = let sortedValues, sortedColumns, sortedRows = sort processor resultValues resultColumns resultRows - printfn $"sorted values: %A{sortedValues.ToHost processor}" - printfn $"sorted columns: %A{sortedColumns.ToHost processor}" - printfn $"sorted rows: %A{sortedRows.ToHost processor}" - resultValues.Free processor resultColumns.Free processor resultRows.Free processor @@ -300,13 +326,8 @@ module Expand = let reducedValues, reducedColumns, reducedRows = reduce processor allocationMode sortedValues sortedColumns sortedRows - printfn $"reduced values: %A{reducedValues.ToHost processor}" - printfn $"reduced columns: %A{reducedColumns.ToHost processor}" - printfn $"reduced rows: %A{reducedRows.ToHost processor}" - sortedValues.Free processor sortedColumns.Free processor sortedRows.Free processor reducedValues, reducedColumns, reducedRows - diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Masked.fs similarity index 96% rename from src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.fs rename to src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Masked.fs index c4c1b4d7..b4f3fcbd 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMMMasked.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 SpGEMMMasked = +module internal Masked = let private calculate (context: ClContext) workGroupSize @@ -151,8 +151,11 @@ module internal SpGEMMMasked = let calculate = calculate context workGroupSize opAdd opMul - let scatter = Scatter.lastOccurrence context workGroupSize - let scatterData = Scatter.lastOccurrence 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/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/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index bd2d159a..692455da 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -131,13 +131,19 @@ module ArithmeticOperations = <@ fun (left: 'a) (right: 'a) -> let result = (%op) left right - if result = zero then None else Some result @> + 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 + if result = zero then + None + else + Some result let inline createPair zero op opQ = binOpQ zero opQ, binOp zero op diff --git a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs b/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs index 65bfb8f9..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.intSumOption ArithmeticOperations.intMulOption 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 1863b191..7c1cfdea 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs @@ -62,8 +62,7 @@ let tests = TestCases.gpuTests "choose id" testFixtures let makeTest2 isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) = - if firstArray.Length > 0 - && secondArray.Length > 0 then + if firstArray.Length > 0 && secondArray.Length > 0 then let expected = Array.map2 opMap firstArray secondArray @@ -72,7 +71,8 @@ let makeTest2 isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) = let clFirstArray = context.CreateClArray firstArray let clSecondArray = context.CreateClArray secondArray - let (clActual: ClArray<_>) = testFun processor HostInterop clFirstArray clSecondArray + let (clActual: ClArray<_>) = + testFun processor HostInterop clFirstArray clSecondArray let actual = clActual.ToHostAndFree processor clFirstArray.Free processor @@ -82,7 +82,8 @@ let makeTest2 isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) = |> Utils.compareArrays isEqual actual expected let createTest2 (isEqual: 'a -> 'a -> bool) (opMapQ, opMap) testFun = - let testFun = testFun context Utils.defaultWorkGroupSize opMapQ + let testFun = + testFun context Utils.defaultWorkGroupSize opMapQ makeTest2 isEqual opMap testFun |> testPropertyWithConfig config $"test on %A{typeof<'a>}" @@ -91,7 +92,7 @@ let tests2 = [ createTest2 (=) ArithmeticOperations.intAdd ClArray.choose2 if Utils.isFloat64Available context.ClDevice then - createTest2 (=) ArithmeticOperations.floatAdd ClArray.choose2 + createTest2 (=) ArithmeticOperations.floatAdd ClArray.choose2 createTest2 (=) ArithmeticOperations.float32Add ClArray.choose2 createTest2 (=) ArithmeticOperations.boolAdd ClArray.choose2 ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/Gather.fs b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs index 96ff6527..3019d9d3 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Gather.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Gather.fs @@ -48,7 +48,8 @@ let makeTest isEqual testFun (array: (uint * 'a * 'a) []) = let createTest<'a> (isEqual: 'a -> 'a -> bool) testFun = - let testFun = testFun context Utils.defaultWorkGroupSize + let testFun = + testFun context Utils.defaultWorkGroupSize makeTest isEqual testFun |> testPropertyWithConfig Utils.defaultConfig $"test on %A{typeof<'a>}" @@ -57,7 +58,7 @@ let tests = [ createTest (=) Gather.run if Utils.isFloat64Available context.ClDevice then - createTest Utils.floatIsEqual Gather.run + createTest Utils.floatIsEqual Gather.run createTest Utils.float32IsEqual Gather.run createTest (=) Gather.run @@ -88,7 +89,8 @@ let makeTestInit isEqual testFun indexMap (array: ('a * 'a) []) = let createTestInit<'a> (isEqual: 'a -> 'a -> bool) testFun indexMapQ indexMap = - let testFun = testFun indexMapQ context Utils.defaultWorkGroupSize + let testFun = + testFun indexMapQ context Utils.defaultWorkGroupSize makeTestInit isEqual testFun indexMap |> testPropertyWithConfig Utils.defaultConfig $"test on {typeof<'a>}" @@ -99,11 +101,11 @@ let initTests = [ createTestInit (=) Gather.runInit Map.id id if Utils.isFloat64Available context.ClDevice then - createTestInit Utils.floatIsEqual Gather.runInit Map.id id + 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] + createTestInit (=) Gather.runInit Map.id id ] |> testList "id" let inc = ((+) 1) @@ -112,13 +114,14 @@ let initTests = [ createTestInit (=) Gather.runInit Map.inc inc if Utils.isFloat64Available context.ClDevice then - createTestInit Utils.floatIsEqual Gather.runInit Map.inc inc + 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] + createTestInit (=) Gather.runInit Map.inc inc ] |> testList "inc" - testList "init" [idTests; incTests] + testList "init" [ idTests; incTests ] +let allTests = testList "Gather" [ tests; initTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index c015550a..e50b34ed 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -228,7 +228,9 @@ let makeTest2D isEqual reduce reduceOp (array: (int * int * 'a) []) = let clValues = context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) - let resultLength = Array.length <| Array.distinctBy (fun (fst, snd, _) -> (fst, snd)) array + 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 @@ -238,8 +240,12 @@ let makeTest2D isEqual reduce reduceOp (array: (int * int * 'a) []) = clSecondKeys.Free processor let actualValues = clActualValues.ToHostAndFree processor - let firstActualKeys = clFirstActualKeys.ToHostAndFree processor - let secondActualKeys = clSecondActualKeys.ToHostAndFree processor + + let firstActualKeys = + clFirstActualKeys.ToHostAndFree processor + + let secondActualKeys = + clSecondActualKeys.ToHostAndFree processor checkResult2D isEqual firstActualKeys secondActualKeys actualValues firstKeys secondKeys values reduceOp @@ -249,7 +255,11 @@ let createTestSequential2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = Reduce.ByKey2D.sequential context Utils.defaultWorkGroupSize reduceOpQ makeTest2D isEqual reduce reduceOp - |> testPropertyWithConfig { config with arbitrary = [ typeof ]; endSize = 10 } $"test on {typeof<'a>}" + |> testPropertyWithConfig + { config with + arbitrary = [ typeof ] + endSize = 10 } + $"test on {typeof<'a>}" let sequential2DTest = let addTests = @@ -281,7 +291,8 @@ let sequential2DTest = 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 array = + Array.sortBy (fun (fst, snd, _) -> fst, snd) array let offsets = array @@ -308,8 +319,12 @@ let makeTestSequentialSegments2D isEqual reduce reduceOp (array: (int * int * 'a 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 reducedFirsKeys = + clFirstActualKeys.ToHostAndFree processor + + let reducesSecondKeys = + clSecondActualKeys.ToHostAndFree processor + let reducedValues = clReducedValues.ToHostAndFree processor checkResult2D isEqual reducedFirsKeys reducesSecondKeys reducedValues firstKeys secondKeys values reduceOp @@ -319,7 +334,10 @@ let createTestSequentialSegments2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp redu Reduce.ByKey2D.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ makeTestSequentialSegments2D isEqual reduce reduceOp - |> testPropertyWithConfig { config with arbitrary = [ typeof ] } $"test on {typeof<'a>}" + |> testPropertyWithConfig + { config with + arbitrary = [ typeof ] } + $"test on {typeof<'a>}" let sequentialSegmentTests2D = let addTests = @@ -352,8 +370,7 @@ let checkResult2DOption isEqual firstActualKeys secondActualKeys actualValues fi let reduceOp left right = match left, right with - | Some left, Some right -> - reduceOp left right + | Some left, Some right -> reduceOp left right | Some value, None | None, Some value -> Some value | _ -> None @@ -364,14 +381,16 @@ let checkResult2DOption isEqual firstActualKeys secondActualKeys actualValues fi 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.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" @@ -383,9 +402,10 @@ let checkResult2DOption isEqual firstActualKeys secondActualKeys actualValues fi "Values must the same" |> Utils.compareArrays isEqual actualValues expectedValues -let test2DOption<'a> isEqual reduce reduceOp (array: (int * int * 'a) []) = +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 array = + Array.sortBy (fun (fst, snd, _) -> fst, snd) array let offsets = getOffsets2D array @@ -406,8 +426,12 @@ let test2DOption<'a> isEqual reduce reduceOp (array: (int * int * 'a) []) = 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 reducedFirsKeys = + clFirstActualKeys.ToHostAndFree processor + + let reducesSecondKeys = + clSecondActualKeys.ToHostAndFree processor + let reducedValues = clReducedValues.ToHostAndFree processor checkResult2DOption isEqual reducedFirsKeys reducesSecondKeys reducedValues firstKeys secondKeys values reduceOp @@ -417,17 +441,17 @@ let createTest2DOption (isEqual: 'a -> 'a -> bool) (reduceOpQ, reduceOp) = Reduce.ByKey2D.segmentSequentialOption context Utils.defaultWorkGroupSize reduceOpQ test2DOption<'a> isEqual reduce reduceOp - |> testPropertyWithConfig { config with arbitrary = [ typeof ] } $"test on {typeof<'a>}" + |> testPropertyWithConfig + { config with + arbitrary = [ typeof ] } + $"test on {typeof<'a>}" -let testsByKey2DSegmentsSequential = +let testsByKey2DSegmentsSequentialOption = [ createTest2DOption (=) ArithmeticOperations.intAdd if Utils.isFloat64Available context.ClDevice then - createTest2DOption Utils.floatIsEqual ArithmeticOperations.floatAdd + createTest2DOption Utils.floatIsEqual ArithmeticOperations.floatAdd createTest2DOption Utils.float32IsEqual ArithmeticOperations.float32Add createTest2DOption (=) ArithmeticOperations.boolAdd ] |> testList "2D option" - - - diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs index bd2629cb..e3f16eb4 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs @@ -21,13 +21,10 @@ let q = defaultContext.Queue let makeTest<'a when 'a: equality> hostScatter scatter (array: (int * 'a) []) (result: 'a []) = if array.Length > 0 then - let positions, values = - Array.sortBy fst array - |> Array.unzip + let positions, values = Array.sortBy fst array |> Array.unzip let expected = - Array.copy result - |> hostScatter positions values + Array.copy result |> hostScatter positions values let actual = let clPositions = context.CreateClArray positions @@ -68,7 +65,7 @@ let tests = testFixturesFirst ] |> testList "First Occurrence" - testList "ones occurrence" [first; last] + testList "ones occurrence" [ first; last ] let makeTestInit<'a when 'a: equality> hostScatter valueMap scatter (positions: int []) (result: 'a []) = if positions.Length > 0 then @@ -77,8 +74,7 @@ let makeTestInit<'a when 'a: equality> hostScatter valueMap scatter (positions: let positions = Array.sort positions let expected = - Array.copy result - |> hostScatter positions values + Array.copy result |> hostScatter positions values let clPositions = context.CreateClArray positions let clResult = context.CreateClArray result @@ -93,7 +89,8 @@ let makeTestInit<'a when 'a: equality> hostScatter valueMap scatter (positions: |> Utils.compareArrays (=) actual expected let createInitTest clScatter hostScatter name valuesMap valuesMapQ = - let scatter = clScatter valuesMapQ context Utils.defaultWorkGroupSize + let scatter = + clScatter valuesMapQ context Utils.defaultWorkGroupSize makeTestInit<'a> hostScatter valuesMap scatter |> testPropertyWithConfig config name @@ -105,12 +102,12 @@ let initTests = let firstOccurrence = [ createInitTest Scatter.initFirsOccurrence HostPrimitives.scatterFirstOccurrence "id" id Map.id - createInitTest Scatter.initFirsOccurrence HostPrimitives.scatterFirstOccurrence "inc" inc Map.inc ] + 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 ] + createInitTest Scatter.initLastOccurrence HostPrimitives.scatterLastOccurrence "inc" inc Map.inc ] |> testList "last occurrence" testList "init" [ firstOccurrence; lastOccurrence ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs index f0a9df92..049568c5 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs @@ -33,7 +33,8 @@ module Radix = let clKeys = keys.ToDevice context let clValues = values.ToDevice context - let clActualValues: ClArray<'a> = sortFun processor HostInterop clKeys clValues + let clActualValues: ClArray<'a> = + sortFun processor HostInterop clKeys clValues let actualValues = clActualValues.ToHostAndFree processor diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 502969bf..3d9f4d63 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -17,7 +17,7 @@ - + @@ -46,10 +46,10 @@ - - + + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index c4375449..8f58afea 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -140,7 +140,8 @@ module Utils = result - let castMatrixToCSR = function + let castMatrixToCSR = + function | Matrix.CSR matrix -> matrix | _ -> failwith "matrix format must be CSR" @@ -197,46 +198,51 @@ module HostPrimitives = 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.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" + 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 + if bit = 1 && 0 <= key && key < resultValues.Length then + resultValues.[key] <- values.[index]) + bitmap + positions resultValues - let scatterLastOccurrence positions = generalScatter getUniqueBitmapLastOccurrence positions + let scatterLastOccurrence positions = + generalScatter getUniqueBitmapLastOccurrence positions - let scatterFirstOccurrence positions = generalScatter getUniqueBitmapFirstOccurrence 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 + 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 + 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 left, Some right -> add left right | Some value, None | None, Some value -> Some value | _ -> None @@ -245,14 +251,17 @@ module HostPrimitives = <| 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 - |> function | Some value -> value | None -> zero + (leftArray.[i, *], rightArray.[*, j]) + // multiply and filter + ||> Array.map2 mul + |> Array.choose id + // add and filter + |> Array.map Some + |> Array.fold add None + |> function + | Some value -> value + | None -> zero + module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs deleted file mode 100644 index a73953d3..00000000 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM.fs +++ /dev/null @@ -1,234 +0,0 @@ -module GraphBLAS.FSharp.Tests.Matrix.SpGeMM - -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 - -let context = Context.defaultContext.ClContext - -let processor = Context.defaultContext.Queue - -let config = { Utils.defaultConfig with arbitrary = [ typeof ] } - -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 - -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) testFun = - - let testFun = testFun context Utils.defaultWorkGroupSize - - makeTest isZero testFun - |> testPropertyWithConfig config $"test on {typeof<'a>}" - -let getSegmentsTests = - [ createTest ((=) 0) Expand.getSegmentPointers - - if Utils.isFloat64Available context.ClDevice then - createTest ((=) 0.0) Expand.getSegmentPointers - - createTest ((=) 0f) Expand.getSegmentPointers - createTest ((=) false) Expand.getSegmentPointers - createTest ((=) 0uy) Expand.getSegmentPointers ] - |> 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 // TODO(expand row pointers) - // 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>}" - -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 actualValues actualColumns actualRows mul add (leftArray: 'a [,]) (rightArray: 'a [,]) = - - let expected = - HostPrimitives.array2DMultiplication zero mul add leftArray rightArray - |> fun array -> Utils.createMatrixFromArray2D COO array (isEqual zero) - |> function Matrix.COO matrix -> matrix | _ -> failwith "format miss" - - printfn $"leftMatrix \n %A{leftArray}" - printfn $"rightMatrix \n %A{rightArray}" - - printfn $"actual values: %A{actualValues}" - printfn $"expected values: %A{expected.Values}" - - printfn $"actualColumns: %A{actualColumns}" - printfn $"expectedColumns: %A{expected.Columns}" - - printfn $"actualRows: %A{actualRows}" - printfn $"expectedRows: %A{expected.Rows}" - - "Values must be the same" - |> Utils.compareArrays isEqual actualValues expected.Values - - "Columns must be the same" - |> Utils.compareArrays (=) actualColumns expected.Columns - - "Rows must be the same" - |> Utils.compareArrays (=) actualRows expected.Rows - -let makeGeneralTest zero isEqual opMul opAdd 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 - try - let clLeftMatrix = leftMatrix.ToDevice context - let clRightMatrix = rightMatrix.ToDevice context - - let (clActualValues: ClArray<'a>), (clActualColumns: ClArray), (clActualRows: ClArray) = - testFun processor HostInterop clLeftMatrix clRightMatrix - - let actualValues = clActualValues.ToHostAndFree processor - let actualColumns = clActualColumns.ToHostAndFree processor - let actualRows = clActualRows.ToHostAndFree processor - - checkGeneralResult zero isEqual actualValues actualColumns actualRows 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 Expand.run ] - |> testList "general" 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..5e6c6a8a --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -0,0 +1,264 @@ +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 ] } + +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 + +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) testFun = + + let testFun = + testFun context Utils.defaultWorkGroupSize + + makeTest isZero testFun + |> testPropertyWithConfig config $"test on {typeof<'a>}" + +let getSegmentsTests = + [ createTest ((=) 0) Expand.getSegmentPointers + + if Utils.isFloat64Available context.ClDevice then + createTest ((=) 0.0) Expand.getSegmentPointers + + createTest ((=) 0f) Expand.getSegmentPointers + createTest ((=) false) Expand.getSegmentPointers + createTest ((=) 0uy) Expand.getSegmentPointers ] + |> 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 ae4e742d..b1dc6c04 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,108 +1,95 @@ open Expecto open GraphBLAS.FSharp.Tests.Backend -open GraphBLAS.FSharp.Tests.Matrix +open GraphBLAS.FSharp.Tests +let matrixTests = + testList + "Matrix tests" + [ Matrix.Convert.tests + Matrix.Map2.addTests + Matrix.Map2.addAtLeastOneTests + Matrix.Map2.mulAtLeastOneTests + Matrix.Map2.addAtLeastOneToCOOTests + Matrix.Map.notTests + Matrix.Map.addTests + Matrix.Map.mulTests + Matrix.Transpose.tests + + Matrix.SpGeMM.Masked.tests + Matrix.SpGeMM.Expand.generalTests ] + |> testSequenced + +let commonTests = + let reduceTests = + testList + "Reduce" + [ Common.Reduce.ByKey.sequentialTest + Common.Reduce.ByKey.sequentialSegmentTests + Common.Reduce.ByKey.oneWorkGroupTest + Common.Reduce.ByKey.testsByKey2DSegmentsSequentialOption + Common.Reduce.Reduce.tests + Common.Reduce.Sum.tests ] -// [] -// let allTests = -// testList -// "All tests" -// [ Matrix.SpGEMM.Expand.processPositionsTest -// Matrix.SpGEMM.Expand.expandLeftMatrixValuesTest -// Matrix.SpGEMM.Expand.extendGlobalRightMatrixPointersTest -// Matrix.SpGEMM.Expand.getRightMatrixValuesAndPointersTest -// Matrix.SpGEMM.Expand.multiplicationTest -// Matrix.SpGEMM.Expand.runExtendTest ] - // |> testSequenced + let clArrayTests = + testList + "ClArray" + [ Common.ClArray.PrefixSum.tests + Common.ClArray.RemoveDuplicates.tests + Common.ClArray.Copy.tests + Common.ClArray.Replicate.tests + Common.ClArray.Exists.tests + Common.ClArray.Map.tests + Common.ClArray.Map2.addTests + Common.ClArray.Map2.mulTests + Common.ClArray.Choose.allTests ] + + let sortTests = + testList + "Sort" + [ Common.Sort.Bitonic.tests + Common.Sort.Radix.testByKeys + Common.Sort.Radix.testKeysOnly ] + + testList + "Common tests" + [ clArrayTests + sortTests + reduceTests + Common.Scatter.allTests + Common.Gather.allTests ] + |> testSequenced + +let vectorTests = + testList + "Vector tests" + [ Vector.SpMV.tests + Vector.ZeroCreate.tests + Vector.OfList.tests + Vector.Copy.tests + Vector.Convert.tests + Vector.Map2.addTests + Vector.Map2.mulTests + Vector.Map2.addAtLeastOneTests + Vector.Map2.mulAtLeastOneTests + Vector.Map2.complementedGeneralTests + Vector.AssignByMask.tests + Vector.AssignByMask.complementedTests + Vector.Reduce.tests ] + |> testSequenced + +let algorithmsTests = + testList "Algorithms tests" [ Algorithms.BFS.tests ] + |> testSequenced -// let matrixTests = -// testList -// "Matrix tests" -// [ Matrix.Convert.tests -// Matrix.Map2.addTests -// Matrix.Map2.addAtLeastOneTests -// Matrix.Map2.mulAtLeastOneTests -// Matrix.Map2.addAtLeastOneToCOOTests -// Matrix.Map.notTests -// Matrix.Map.addTests -// Matrix.Map.mulTests -// Matrix.Mxm.tests -// Matrix.Transpose.tests ] -// |> testSequenced -// -// let commonTests = -// let reduceTests = -// testList -// "Reduce" -// [ Common.Reduce.ByKey.sequentialTest -// Common.Reduce.ByKey.sequentialSegmentTests -// Common.Reduce.ByKey.oneWorkGroupTest -// Common.Reduce.Reduce.tests -// Common.Reduce.Sum.tests ] -// -// let clArrayTests = -// testList -// "ClArray" -// [ Common.ClArray.PrefixSum.tests -// Common.ClArray.RemoveDuplicates.tests -// Common.ClArray.Copy.tests -// Common.ClArray.Replicate.tests -// Common.ClArray.Exists.tests -// Common.ClArray.Map.tests -// Common.ClArray.Map2.addTests -// Common.ClArray.Map2.mulTests -// Common.ClArray.Choose.tests ] -// -// let sortTests = -// testList -// "Sort" -// [ Common.Sort.Bitonic.tests -// Common.Sort.Radix.testsByKeys -// Common.Sort.Radix.testKeysOnly ] -// -// testList -// "Common tests" -// [ clArrayTests -// sortTests -// reduceTests -// Common.Scatter.tests ] -// |> testSequenced -// -// let vectorTests = -// testList -// "Vector tests" -// [ Vector.SpMV.tests -// Vector.ZeroCreate.tests -// Vector.OfList.tests -// Vector.Copy.tests -// Vector.Convert.tests -// Vector.Map2.addTests -// Vector.Map2.mulTests -// Vector.Map2.addAtLeastOneTests -// Vector.Map2.mulAtLeastOneTests -// Vector.Map2.complementedGeneralTests -// Vector.AssignByMask.tests -// Vector.AssignByMask.complementedTests -// Vector.Reduce.tests ] -// |> testSequenced -// -// let algorithmsTests = -// testList "Algorithms tests" [ Algorithms.BFS.tests ] -// |> testSequenced -// [] let allTests = testList "All tests" - [ // SpGeMM.expandTests - SpGeMM.generalTests - // Common.Gather.initTests - // Common.ClArray.Choose.tests2 ] - // Common.Reduce.ByKey.testsByKey2DSegmentsSequential ] - ] + [ matrixTests + vectorTests + commonTests + algorithmsTests ] |> testSequenced [] let main argv = allTests |> runTestsWithCLIArgs [] argv - - From 95fea31311c3b68f5b8b64be30ec8fdba849095c Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Apr 2023 17:00:26 +0300 Subject: [PATCH 26/33] refactor: duplication, allTests in Reduce --- src/GraphBLAS-sharp.Backend/Common/ClArray.fs | 9 +++---- src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 21 ++++------------ .../Quotes/Arithmetic.fs | 2 +- .../Quotes/Predicates.fs | 12 ++++++++++ .../Common/Reduce/ReduceByKey.fs | 24 +++++++++++++------ tests/GraphBLAS-sharp.Tests/Program.fs | 5 +--- 6 files changed, 39 insertions(+), 34 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 8275c434..5db339a7 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -6,6 +6,7 @@ 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>) = @@ -167,16 +168,12 @@ module ClArray = let getUniqueBitmapFirstOccurrence clContext = getUniqueBitmapGeneral - <| <@ fun (gid: int) (_: int) (inputArray: ClArray<'a>) -> - gid = 0 - || inputArray.[gid - 1] <> inputArray.[gid] @> + <| Predicates.firstOccurrence () <| clContext let getUniqueBitmapLastOccurrence clContext = getUniqueBitmapGeneral - <| <@ fun (gid: int) (length: int) (inputArray: ClArray<'a>) -> - gid = length - 1 - || inputArray.[gid] <> inputArray.[gid + 1] @> + <| Predicates.lastOccurrence () <| clContext ///Remove duplicates form the given array. diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index 4146ea0c..d6113206 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -1,20 +1,9 @@ namespace GraphBLAS.FSharp.Backend.Common open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Quotes module internal Scatter = - let private firstOccurencePredicate () = - <@ fun gid _ (positions: ClArray) -> - // first occurrence condition - (gid = 0 || positions.[gid - 1] <> positions.[gid]) @> - - let private lastOccurrencePredicate () = - <@ fun gid positionsLength (positions: ClArray) -> - // last occurrence condition - (gid = positionsLength - 1 - || positions.[gid] <> positions.[gid + 1]) @> - - let private general<'a> predicate (clContext: ClContext) workGroupSize = let run = @@ -75,7 +64,7 @@ module internal Scatter = /// /// let firstOccurrence clContext = - general <| firstOccurencePredicate () <| 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 @@ -96,7 +85,7 @@ module internal Scatter = /// /// let lastOccurrence clContext = - general <| lastOccurrencePredicate () <| clContext + general <| Predicates.lastOccurrence () <| clContext let private generalInit<'a> predicate valueMap (clContext: ClContext) workGroupSize = @@ -156,7 +145,7 @@ module internal Scatter = /// Maps global id to a value let initFirsOccurrence<'a> valueMap = generalInit<'a> - <| firstOccurencePredicate () + <| Predicates.firstOccurrence () <| valueMap /// @@ -180,5 +169,5 @@ module internal Scatter = /// Maps global id to a value let initLastOccurrence<'a> valueMap = generalInit<'a> - <| lastOccurrencePredicate () + <| Predicates.lastOccurrence () <| valueMap diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 692455da..5e0ba6c4 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -159,7 +159,7 @@ module ArithmeticOperations = // multiplication let intMul = createPair 0 (*) <@ (*) @> - let boolMul = createPair false (&&) <@ (&&) @> + let boolMul = createPair true (&&) <@ (&&) @> let floatMul = createPair 0.0 (*) <@ (*) @> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs b/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs index ad2c4165..97641e18 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/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index e50b34ed..79e76ae4 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -15,17 +15,17 @@ let processor = Context.defaultContext.Queue let config = Utils.defaultConfig -let getOffsets array = +let private getOffsets array = Array.map fst array |> HostPrimitives.getUniqueBitmapFirstOccurrence |> HostPrimitives.getBitPositions -let getOffsets2D array = +let private getOffsets2D array = Array.map (fun (fst, snd, _) -> fst, snd) array |> HostPrimitives.getUniqueBitmapFirstOccurrence |> HostPrimitives.getBitPositions -let checkResult isEqual actualKeys actualValues keys values reduceOp = +let private checkResult isEqual actualKeys actualValues keys values reduceOp = let expectedKeys, expectedValues = HostPrimitives.reduceByKey keys values reduceOp @@ -36,7 +36,7 @@ let checkResult isEqual actualKeys actualValues keys values reduceOp = "Values must the same" |> Utils.compareArrays isEqual actualValues expectedValues -let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = +let private makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = let keys, values = Array.sortBy fst arrayAndKeys |> Array.unzip @@ -60,7 +60,7 @@ let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = checkResult isEqual actualKeys actualValues keys values reduceOp -let createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = +let private createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = Reduce.ByKey.sequential context Utils.defaultWorkGroupSize reduceOpQ @@ -339,7 +339,7 @@ let createTestSequentialSegments2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp redu arbitrary = [ typeof ] } $"test on {typeof<'a>}" -let sequentialSegmentTests2D = +let sequentialSegment2DTests = let addTests = testList "add tests" @@ -446,7 +446,7 @@ let createTest2DOption (isEqual: 'a -> 'a -> bool) (reduceOpQ, reduceOp) = arbitrary = [ typeof ] } $"test on {typeof<'a>}" -let testsByKey2DSegmentsSequentialOption = +let testsSegmentsSequential2DOption = [ createTest2DOption (=) ArithmeticOperations.intAdd if Utils.isFloat64Available context.ClDevice then @@ -455,3 +455,13 @@ let testsByKey2DSegmentsSequentialOption = 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/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index b1dc6c04..a5a7a469 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -23,10 +23,7 @@ let commonTests = let reduceTests = testList "Reduce" - [ Common.Reduce.ByKey.sequentialTest - Common.Reduce.ByKey.sequentialSegmentTests - Common.Reduce.ByKey.oneWorkGroupTest - Common.Reduce.ByKey.testsByKey2DSegmentsSequentialOption + [ Common.Reduce.ByKey.allTests Common.Reduce.Reduce.tests Common.Reduce.Sum.tests ] From c5fa0d0628ade6bf1474dd5eec988410470f17e9 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Apr 2023 17:42:27 +0300 Subject: [PATCH 27/33] refactor: ClArray.Free and *.FreeAndWait --- .../GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs | 2 +- src/GraphBLAS-sharp.Backend/Common/Scatter.fs | 8 ++++++-- .../Objects/ArraysExtentions.fs | 4 ++-- src/GraphBLAS-sharp.Backend/Objects/Vector.fs | 2 +- src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs | 8 ++++---- .../Common/Reduce/ReduceByKey.fs | 14 +++++++------- tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs | 3 +-- 7 files changed, 22 insertions(+), 19 deletions(-) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs index 95d25fc9..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.Free this.Processor + this.ResultVector.FreeAndWait this.Processor member this.ReadMatrix() = let matrixReader = this.InputMatrixReader diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index d6113206..4f51cb93 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -64,7 +64,9 @@ module internal Scatter = /// /// let firstOccurrence clContext = - general <| Predicates.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 @@ -85,7 +87,9 @@ module internal Scatter = /// /// let lastOccurrence clContext = - general <| Predicates.lastOccurrence () <| clContext + general + <| Predicates.lastOccurrence () + <| clContext let private generalInit<'a> predicate valueMap (clContext: ClContext) workGroupSize = diff --git a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs index 4a35e2e0..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.Free(q: MailboxProcessor) = + member this.FreeAndWait(q: MailboxProcessor) = q.Post(Msg.CreateFreeMsg this) q.PostAndReply(Msg.MsgNotifyMe) @@ -12,7 +12,7 @@ module ArraysExtensions = let dst = Array.zeroCreate this.Length q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this, dst, ch)) - // member this.Free(q: MailboxProcessor<_>) = q.Post <| Msg.CreateFreeMsg this TODO() + member this.Free(q: MailboxProcessor<_>) = q.Post <| Msg.CreateFreeMsg this member this.ToHostAndFree(q: MailboxProcessor<_>) = let result = this.ToHost q diff --git a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs index c1d75282..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.Free(q) + | Dense vector -> vector.FreeAndWait(q) diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs b/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs index 97641e18..74fda243 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Predicates.fs @@ -11,10 +11,10 @@ module Predicates = let inline lastOccurrence () = <@ fun (gid: int) (length: int) (inputArray: ClArray<'a>) -> - gid = length - 1 - || inputArray.[gid] <> inputArray.[gid + 1] @> + 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] @> + gid = 0 + || inputArray.[gid - 1] <> inputArray.[gid] @> diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index 79e76ae4..41760d02 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -458,10 +458,10 @@ let testsSegmentsSequential2DOption = let allTests = testList - "Reduce.ByKey" - [ sequentialTest - oneWorkGroupTest - sequentialSegmentTests - sequential2DTest - sequentialSegment2DTests - testsSegmentsSequential2DOption ] + "Reduce.ByKey" + [ sequentialTest + oneWorkGroupTest + sequentialSegmentTests + sequential2DTest + sequentialSegment2DTests + testsSegmentsSequential2DOption ] diff --git a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs index 2f7c5149..db42fd9d 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs +++ b/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs @@ -77,8 +77,7 @@ let correctnessGenericTest (ClMatrix.CSR m).Dispose q v.Free q - let hostRes = res.ToHost q - res.Free q + let hostRes = res.ToHostAndFree q checkResult isEqual sumOp mulOp zero matrix vector hostRes | _ -> failwith "Impossible" From 6ff19713c52247adda20ddcf8be582a2c2a9aba4 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Apr 2023 23:36:12 +0300 Subject: [PATCH 28/33] refactor: remove use in test --- .../Common/ClArray/Copy.fs | 10 ++++------ .../Common/ClArray/PrefixSum.fs | 7 ++++--- .../Common/ClArray/Replicate.fs | 10 ++++------ .../Common/Reduce/Reduce.fs | 12 +++++------ .../Common/Reduce/Sum.fs | 10 ++++++---- .../Common/Sort/Bitonic.fs | 20 +++++++------------ .../Matrix/SpGeMM/Expand.fs | 4 +++- 7 files changed, 33 insertions(+), 40 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs index dcf4ed83..e4e261d3 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,10 @@ 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 - - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + let actual = (copyFun q HostInterop clArray: ClArray<_>).ToHostAndFree q + clArray.Free q logger.debug ( eventX "Actual is {actual}" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs index 3c8bedee..faab8893 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/PrefixSum.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/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 actual = clArray.ToHostAndFree q let actualSum = total.ToHostAndFree(q) - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clArray, actual, ch)), actualSum + actual, actualSum logger.debug ( eventX "Actual is {actual}\n" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs index c7067df5..2df5858c 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,10 @@ 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 - - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + let actual = (replicateFun q HostInterop clArray i: ClArray<'a>).ToHostAndFree q + clArray.Free q logger.debug ( eventX $"Actual is {actual}" 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/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/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/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index 5e6c6a8a..104c01a7 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -22,7 +22,9 @@ let processor = Context.defaultContext.Queue let config = { Utils.defaultConfig with - arbitrary = [ typeof ] } + arbitrary = [ typeof ] + endSize = 500 + maxTest = 100 } let createCSRMatrix array isZero = Utils.createMatrixFromArray2D CSR array isZero From 048477dfea0fb437547ad54ef51c0df3ff2aed52 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Apr 2023 23:38:23 +0300 Subject: [PATCH 29/33] refactor: formatting --- src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj | 4 ---- tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs | 5 ++++- tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs | 5 ++++- tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj | 4 ---- 4 files changed, 8 insertions(+), 10 deletions(-) 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/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs index e4e261d3..2c8d2ba2 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs @@ -23,7 +23,10 @@ let makeTest<'a when 'a: equality> copyFun (array: array<'a>) = if array.Length > 0 then let clArray = context.CreateClArray array - let actual = (copyFun q HostInterop clArray: ClArray<_>).ToHostAndFree q + let actual = + (copyFun q HostInterop clArray: ClArray<_>) + .ToHostAndFree q + clArray.Free q logger.debug ( diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs index 2df5858c..0299eb05 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs @@ -23,7 +23,10 @@ let makeTest<'a when 'a: equality> replicateFun (array: array<'a>) i = if array.Length > 0 && i > 0 then let clArray = context.CreateClArray array - let actual = (replicateFun q HostInterop clArray i: ClArray<'a>).ToHostAndFree q + let actual = + (replicateFun q HostInterop clArray i: ClArray<'a>) + .ToHostAndFree q + clArray.Free q logger.debug ( diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 3d9f4d63..26bebb7d 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -31,10 +31,6 @@ - - - - From 4d26023e7fc85f7baa0ed0025f528dbda8e90a9c Mon Sep 17 00:00:00 2001 From: IgorErin Date: Fri, 7 Apr 2023 23:50:44 +0300 Subject: [PATCH 30/33] refactor: formatting --- tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index 104c01a7..84d5b943 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -36,7 +36,7 @@ let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b rightMatrix.RowPointers.[item + 1] - rightMatrix.RowPointers.[item]) leftMatrix.ColumnIndices - |> HostPrimitives.prefixSumExclude + |> HostPrimitives.prefixSumExclude 0 (+) let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = From cf7cc1d553fce6f6929fb5d0d5be83900e9ee7a1 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 8 Apr 2023 11:54:15 +0300 Subject: [PATCH 31/33] refactor: expand endSize --- tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index 84d5b943..e3e732fd 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -23,7 +23,7 @@ let processor = Context.defaultContext.Queue let config = { Utils.defaultConfig with arbitrary = [ typeof ] - endSize = 500 + endSize = 100 maxTest = 100 } let createCSRMatrix array isZero = From fdb904110f7cf74a175455de2ed6c54811ca6afa Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 8 Apr 2023 15:50:55 +0300 Subject: [PATCH 32/33] refactor: Scatter.test memory release --- tests/GraphBLAS-sharp.Tests/Common/Scatter.fs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs index e3f16eb4..a72de22b 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs @@ -34,7 +34,7 @@ let makeTest<'a when 'a: equality> hostScatter scatter (array: (int * 'a) []) (r scatter q clPositions clValues clResult clValues.Free q - clValues.Free q + clPositions.Free q clResult.ToHostAndFree q $"Arrays should be equal." @@ -81,9 +81,8 @@ let makeTestInit<'a when 'a: equality> hostScatter valueMap scatter (positions: scatter q clPositions clResult - let actual = clResult.ToHostAndFree q clPositions.Free q - clResult.Free q + let actual = clResult.ToHostAndFree q $"Arrays should be equal." |> Utils.compareArrays (=) actual expected From a6ebc30e76573995f02cf905f1c54f21c5179a60 Mon Sep 17 00:00:00 2001 From: IgorErin Date: Sat, 8 Apr 2023 20:51:43 +0300 Subject: [PATCH 33/33] refactor: tests, names --- .../Matrix/CSRMatrix/SpGEMM/Expand.fs | 50 +++++++++---------- .../Common/Reduce/ReduceByKey.fs | 10 ++-- .../Common/Scan/PrefixSum.fs | 2 +- tests/GraphBLAS-sharp.Tests/Helpers.fs | 4 +- .../Matrix/SpGeMM/Expand.fs | 14 +++--- 5 files changed, 39 insertions(+), 41 deletions(-) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs index 71f5fff9..37cefdce 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/SpGEMM/Expand.fs @@ -139,37 +139,37 @@ module Expand = let expandRowPointers = Common.expandRowPointers clContext workGroupSize - let AGather = Gather.run clContext workGroupSize + let leftMatrixGather = Gather.run clContext workGroupSize - let BGather = 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 A positions - let APositions = zeroCreate processor DeviceOnly lengths + // Compute left matrix positions + let leftMatrixPositions = zeroCreate processor DeviceOnly lengths - idScatter processor segmentsPointers APositions + idScatter processor segmentsPointers leftMatrixPositions - (maxPrefixSum processor APositions 0) + (maxPrefixSum processor leftMatrixPositions 0) .Free processor - // Compute B positions - let BPositions = create processor DeviceOnly lengths 1 + // Compute right matrix positions + let rightMatrixPositions = create processor DeviceOnly lengths 1 - let requiredBPointers = + let requiredRightMatrixPointers = zeroCreate processor DeviceOnly leftMatrix.Columns.Length - gather processor leftMatrix.Columns rightMatrix.RowPointers requiredBPointers + gather processor leftMatrix.Columns rightMatrix.RowPointers requiredRightMatrixPointers - scatter processor segmentsPointers requiredBPointers BPositions + scatter processor segmentsPointers requiredRightMatrixPointers rightMatrixPositions - requiredBPointers.Free processor + requiredRightMatrixPointers.Free processor // another way to get offsets ??? let offsets = removeDuplicates processor segmentsPointers - segmentPrefixSum processor offsets.Length BPositions APositions offsets + segmentPrefixSum processor offsets.Length rightMatrixPositions leftMatrixPositions offsets offsets.Free processor @@ -177,37 +177,37 @@ module Expand = let columns = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) - gather processor BPositions rightMatrix.Columns columns + gather processor rightMatrixPositions rightMatrix.Columns columns // compute rows - let ARows = + let leftMatrixRows = expandRowPointers processor DeviceOnly leftMatrix.RowPointers leftMatrix.NNZ leftMatrix.RowCount let rows = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) - gather processor APositions ARows rows + gather processor leftMatrixPositions leftMatrixRows rows - ARows.Free processor + leftMatrixRows.Free processor - // compute leftMatrix values - let AValues = + // compute left matrix values + let leftMatrixValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) - AGather processor APositions leftMatrix.Values AValues + leftMatrixGather processor leftMatrixPositions leftMatrix.Values leftMatrixValues - APositions.Free processor + leftMatrixPositions.Free processor // compute right matrix values - let BValues = + let rightMatrixValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) - BGather processor BPositions rightMatrix.Values BValues + rightMatrixGather processor rightMatrixPositions rightMatrix.Values rightMatrixValues - BPositions.Free processor + rightMatrixPositions.Free processor // left, right matrix values, columns and rows indices - AValues, BValues, columns, rows + leftMatrixValues, rightMatrixValues, columns, rows let sortByColumnsAndRows (clContext: ClContext) workGroupSize = diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs index 41760d02..09e0b21a 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs @@ -15,17 +15,17 @@ let processor = Context.defaultContext.Queue let config = Utils.defaultConfig -let private getOffsets array = +let getOffsets array = Array.map fst array |> HostPrimitives.getUniqueBitmapFirstOccurrence |> HostPrimitives.getBitPositions -let private getOffsets2D array = +let getOffsets2D array = Array.map (fun (fst, snd, _) -> fst, snd) array |> HostPrimitives.getUniqueBitmapFirstOccurrence |> HostPrimitives.getBitPositions -let private checkResult isEqual actualKeys actualValues keys values reduceOp = +let checkResult isEqual actualKeys actualValues keys values reduceOp = let expectedKeys, expectedValues = HostPrimitives.reduceByKey keys values reduceOp @@ -36,7 +36,7 @@ let private checkResult isEqual actualKeys actualValues keys values reduceOp = "Values must the same" |> Utils.compareArrays isEqual actualValues expectedValues -let private makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = +let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = let keys, values = Array.sortBy fst arrayAndKeys |> Array.unzip @@ -60,7 +60,7 @@ let private makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = checkResult isEqual actualKeys actualValues keys values reduceOp -let private createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = +let createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = Reduce.ByKey.sequential context Utils.defaultWorkGroupSize reduceOpQ diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs b/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs index f76a0258..734b96f9 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs +++ b/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs @@ -33,7 +33,7 @@ let makeTest plus zero isEqual scan (array: 'a []) = let (total: ClCell<_>) = scan q clArray zero let actual = clArray.ToHostAndFree q - let actualSum = total.ToHostAndFree(q) + let actualSum = total.ToHostAndFree q actual, actualSum logger.debug ( diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 93c13eb3..08c2fc27 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -254,9 +254,7 @@ module HostPrimitives = // add and filter |> Array.map Some |> Array.fold add None - |> function - | Some value -> value - | None -> zero + |> Option.defaultValue zero let scanByKey scan keysAndValues = Array.groupBy fst keysAndValues diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs index e3e732fd..00ce048d 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs @@ -67,23 +67,23 @@ let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = "Result pointers must be the same" |> Expect.sequenceEqual actualPointers expectedPointers -let createTest<'a when 'a: struct> (isZero: 'a -> bool) testFun = +let createTest<'a when 'a: struct> (isZero: 'a -> bool) = let testFun = - testFun context Utils.defaultWorkGroupSize + Expand.getSegmentPointers context Utils.defaultWorkGroupSize makeTest isZero testFun |> testPropertyWithConfig config $"test on {typeof<'a>}" let getSegmentsTests = - [ createTest ((=) 0) Expand.getSegmentPointers + [ createTest ((=) 0) if Utils.isFloat64Available context.ClDevice then - createTest ((=) 0.0) Expand.getSegmentPointers + createTest ((=) 0.0) - createTest ((=) 0f) Expand.getSegmentPointers - createTest ((=) false) Expand.getSegmentPointers - createTest ((=) 0uy) Expand.getSegmentPointers ] + createTest ((=) 0f) + createTest ((=) false) + createTest ((=) 0uy) ] |> testList "get segment pointers" let expand length segmentPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) =