diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs index 5e7050d2..d8af762f 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs @@ -187,4 +187,3 @@ type BFSWithTransferBenchmarkInt32() = static member InputMatrixProvider = Benchmarks<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" - diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj index 6e8486b0..2dd0c406 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj @@ -1,4 +1,4 @@ - + Exe diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/Algorithms.fs b/src/GraphBLAS-sharp.Backend/Algorithms/Algorithms.fs index f46a35cd..bc7de55d 100644 --- a/src/GraphBLAS-sharp.Backend/Algorithms/Algorithms.fs +++ b/src/GraphBLAS-sharp.Backend/Algorithms/Algorithms.fs @@ -12,5 +12,10 @@ module Algorithms = let singleSourcePushPull = BFS.singleSourcePushPull + module MSBFS = + let runLevels = MSBFS.Levels.run + + let runParents = MSBFS.Parents.run + module SSSP = - let singleSource = SSSP.run + let run = SSSP.run diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/MSBFS.fs b/src/GraphBLAS-sharp.Backend/Algorithms/MSBFS.fs new file mode 100644 index 00000000..b7c82e6a --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Algorithms/MSBFS.fs @@ -0,0 +1,265 @@ +namespace GraphBLAS.FSharp.Backend.Algorithms + +open Brahma.FSharp +open FSharp.Quotations +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Common +open GraphBLAS.FSharp.Objects.ClMatrix +open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ClCellExtensions +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Matrix.LIL +open GraphBLAS.FSharp.Backend.Matrix.COO + +module internal MSBFS = + let private frontExclude (clContext: ClContext) workGroupSize = + + let invert = + ClArray.mapInPlace ArithmeticOperations.intNotQ clContext workGroupSize + + let prefixSum = + PrefixSum.standardExcludeInPlace clContext workGroupSize + + let scatterIndices = + Scatter.lastOccurrence clContext workGroupSize + + let scatterValues = + Scatter.lastOccurrence clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (front: ClMatrix.COO<_>) (intersection: ClArray) -> + + invert queue intersection + + let length = + (prefixSum queue intersection).ToHostAndFree queue + + if length = 0 then + None + else + let rows = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, length) + + let columns = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, length) + + let values = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, length) + + scatterIndices queue intersection front.Rows rows + scatterIndices queue intersection front.Columns columns + scatterValues queue intersection front.Values values + + { Context = clContext + Rows = rows + Columns = columns + Values = values + RowCount = front.RowCount + ColumnCount = front.ColumnCount } + |> Some + + module Levels = + let private updateFrontAndLevels (clContext: ClContext) workGroupSize = + + let updateFront = frontExclude clContext workGroupSize + + let mergeDisjoint = + Matrix.mergeDisjoint clContext workGroupSize + + let setLevel = ClArray.fill clContext workGroupSize + + let findIntersection = + Intersect.findKeysIntersection clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (level: int) (front: ClMatrix.COO<_>) (levels: ClMatrix.COO<_>) -> + + // Find intersection of levels and front indices. + let intersection = + findIntersection queue DeviceOnly front levels + + // Remove mutual elements + let newFront = + updateFront queue allocationMode front intersection + + intersection.Free queue + + match newFront with + | Some f -> + let levelClCell = clContext.CreateClCell level + + // Set current level value to all remaining front positions + setLevel queue levelClCell 0 f.Values.Length f.Values + + levelClCell.Free queue + + // Update levels + let newLevels = mergeDisjoint queue levels f + + newLevels, newFront + | _ -> levels, None + + let run<'a when 'a: struct> + (add: Expr int -> int option>) + (mul: Expr 'a -> int option>) + (clContext: ClContext) + workGroupSize + = + + let spGeMM = + Operations.SpGeMM.COO.expand add mul clContext workGroupSize + + let copy = Matrix.copy clContext workGroupSize + + let updateFrontAndLevels = + updateFrontAndLevels clContext workGroupSize + + fun (queue: MailboxProcessor) (matrix: ClMatrix<'a>) (source: int list) -> + let vertexCount = matrix.RowCount + let sourceVertexCount = source.Length + + let source = source |> List.sort + + let startMatrix = + source |> List.mapi (fun i vertex -> i, vertex, 1) + + let mutable levels = + startMatrix + |> Matrix.ofList clContext DeviceOnly sourceVertexCount vertexCount + + let mutable front = copy queue DeviceOnly levels + + let mutable level = 1 + let mutable stop = false + + while not stop do + level <- level + 1 + + //Getting new frontier + match spGeMM queue DeviceOnly (ClMatrix.COO front) matrix with + | None -> + front.Dispose queue + stop <- true + + | Some newFrontier -> + front.Dispose queue + + //Filtering visited vertices + match updateFrontAndLevels queue DeviceOnly level newFrontier levels with + | l, Some f -> + front <- f + + levels.Dispose queue + + levels <- l + + newFrontier.Dispose queue + + | _, None -> + stop <- true + newFrontier.Dispose queue + + ClMatrix.COO levels + + module Parents = + let private updateFrontAndParents (clContext: ClContext) workGroupSize = + let frontExclude = frontExclude clContext workGroupSize + + let mergeDisjoint = + Matrix.mergeDisjoint clContext workGroupSize + + let findIntersection = + Intersect.findKeysIntersection clContext workGroupSize + + let copyIndices = ClArray.copyTo clContext workGroupSize + + fun (queue: MailboxProcessor) allocationMode (front: ClMatrix.COO<_>) (parents: ClMatrix.COO<_>) -> + + // Find intersection of levels and front indices. + let intersection = + findIntersection queue DeviceOnly front parents + + // Remove mutual elements + let newFront = + frontExclude queue allocationMode front intersection + + intersection.Free queue + + match newFront with + | Some f -> + // Update parents + let newParents = mergeDisjoint queue parents f + + copyIndices queue f.Columns f.Values + + newParents, Some f + + | _ -> parents, None + + let run<'a when 'a: struct> (clContext: ClContext) workGroupSize = + + let spGeMM = + Operations.SpGeMM.COO.expand + (ArithmeticOperations.min) + (ArithmeticOperations.fst) + clContext + workGroupSize + + let updateFrontAndParents = + updateFrontAndParents clContext workGroupSize + + fun (queue: MailboxProcessor) (inputMatrix: ClMatrix<'a>) (source: int list) -> + let vertexCount = inputMatrix.RowCount + let sourceVertexCount = source.Length + + let source = source |> List.sort + + let matrix = + match inputMatrix with + | ClMatrix.CSR m -> + { Context = clContext + RowPointers = m.RowPointers + Columns = m.Columns + Values = m.Columns + RowCount = m.RowCount + ColumnCount = m.ColumnCount } + |> ClMatrix.CSR + | _ -> failwith "Incorrect format" + + let mutable parents = + source + |> List.mapi (fun i vertex -> i, vertex, -1) + |> Matrix.ofList clContext DeviceOnly sourceVertexCount vertexCount + + let mutable front = + source + |> List.mapi (fun i vertex -> i, vertex, vertex) + |> Matrix.ofList clContext DeviceOnly sourceVertexCount vertexCount + + let mutable stop = false + + while not stop do + //Getting new frontier + match spGeMM queue DeviceOnly (ClMatrix.COO front) matrix with + | None -> + front.Dispose queue + stop <- true + + | Some newFrontier -> + front.Dispose queue + + //Filtering visited vertices + match updateFrontAndParents queue DeviceOnly newFrontier parents with + | p, Some f -> + front <- f + + parents.Dispose queue + parents <- p + + newFrontier.Dispose queue + + | _, None -> + stop <- true + newFrontier.Dispose queue + + ClMatrix.COO parents diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/SSSP.fs b/src/GraphBLAS-sharp.Backend/Algorithms/SSSP.fs index 251f7866..dc4499e9 100644 --- a/src/GraphBLAS-sharp.Backend/Algorithms/SSSP.fs +++ b/src/GraphBLAS-sharp.Backend/Algorithms/SSSP.fs @@ -11,7 +11,7 @@ module SSSP = let run (clContext: ClContext) workGroupSize = let less = ArithmeticOperations.less - let min = ArithmeticOperations.min + let min = ArithmeticOperations.minOption let plus = ArithmeticOperations.intSumAsMul let spMVInPlace = diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index dacb249e..ad6b3caf 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -121,6 +121,35 @@ module ClArray = outputArray + /// + /// Copies all elements from source to destination array. + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let copyTo (clContext: ClContext) workGroupSize = + let copy = + <@ fun (ndRange: Range1D) (source: ClArray<'a>) (destination: ClArray<'a>) inputArrayLength -> + + let i = ndRange.GlobalID0 + + if i < inputArrayLength then + destination.[i] <- source.[i] @> + + let program = clContext.Compile(copy) + + fun (processor: MailboxProcessor<_>) (source: ClArray<'a>) (destination: ClArray<'a>) -> + if source.Length <> destination.Length then + failwith "The source array length differs from the destination array length." + + let ndRange = + Range1D.CreateValid(source.Length, workGroupSize) + + let kernel = program.GetKernel() + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange source destination source.Length)) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + /// /// Creates an array of the given size by replicating the values of the given initial array. /// @@ -781,3 +810,93 @@ module ClArray = bitmap.Free processor result + + /// + /// Builds a new array whose elements are the results of applying the given function + /// to each of the elements of the array. + /// + /// The function to transform elements of the array. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map<'a, 'b> (op: Expr<'a -> 'b>) (clContext: ClContext) workGroupSize = Map.map op clContext workGroupSize + + /// + /// Builds a new array whose elements are the results of applying the given function + /// to each of the elements of the array. + /// + /// The function to transform elements of the array. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let mapInPlace<'a> (op: Expr<'a -> 'a>) (clContext: ClContext) workGroupSize = + Map.mapInPlace op clContext workGroupSize + + /// + /// Builds a new array whose elements are the results of applying the given function + /// to the corresponding pairs of values, where the first element of pair is from the given array + /// and the second element is the given value. + /// + /// The function to transform elements of the array. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let mapWithValue<'a, 'b, 'c> (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b -> 'c>) = + Map.mapWithValue clContext workGroupSize op + + /// + /// Builds a new array whose elements are the results of applying the given function + /// to the corresponding elements of the two given arrays pairwise. + /// + /// + /// The two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c>) (clContext: ClContext) workGroupSize = + Map.map2 map clContext workGroupSize + + /// + /// Fills the third given array with the results of applying the given function + /// to the corresponding elements of the first two given arrays pairwise. + /// + /// + /// The first two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2InPlace<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c>) (clContext: ClContext) workGroupSize = + Map.map2InPlace map clContext workGroupSize + + /// + /// Excludes elements, pointed by the bitmap. + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let excludeElements (clContext: ClContext) workGroupSize = + + let invert = + mapInPlace ArithmeticOperations.intNotQ clContext workGroupSize + + let prefixSum = + PrefixSum.standardExcludeInPlace clContext workGroupSize + + let scatter = + Scatter.lastOccurrence clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (excludeBitmap: ClArray) (inputArray: ClArray<'a>) -> + + invert queue excludeBitmap + + let length = + (prefixSum queue excludeBitmap) + .ToHostAndFree queue + + if length = 0 then + None + else + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, length) + + scatter queue excludeBitmap inputArray result + + Some result diff --git a/src/GraphBLAS-sharp.Backend/Common/Map.fs b/src/GraphBLAS-sharp.Backend/Common/Map.fs index f22f0f6b..2459e1ef 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Map.fs @@ -3,6 +3,7 @@ open Brahma.FSharp open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ClCellExtensions module Map = /// @@ -15,11 +16,11 @@ module Map = let map<'a, 'b> (op: Expr<'a -> 'b>) (clContext: ClContext) workGroupSize = let map = - <@ fun (ndRange: Range1D) lenght (inputArray: ClArray<'a>) (result: ClArray<'b>) -> + <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (result: ClArray<'b>) -> let gid = ndRange.GlobalID0 - if gid < lenght then + if gid < length then result.[gid] <- (%op) inputArray.[gid] @> let kernel = clContext.Compile map @@ -40,6 +41,36 @@ module Map = result + /// + /// Changes elements of the input array, applying the given function + /// to each element of the array. + /// + /// The function to transform elements of the array. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let mapInPlace<'a> (op: Expr<'a -> 'a>) (clContext: ClContext) workGroupSize = + + let map = + <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + inputArray.[gid] <- (%op) inputArray.[gid] @> + + let kernel = clContext.Compile map + + fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> + + let ndRange = + Range1D.CreateValid(inputArray.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray.Length inputArray)) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + /// /// Builds a new array whose elements are the results of applying the given function /// to the corresponding pairs of values, where the first element of pair is from the given array @@ -51,11 +82,11 @@ module Map = let mapWithValue<'a, 'b, 'c> (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b -> 'c>) = let map = - <@ fun (ndRange: Range1D) lenght (value: ClCell<'a>) (inputArray: ClArray<'b>) (result: ClArray<'c>) -> + <@ fun (ndRange: Range1D) length (value: ClCell<'a>) (inputArray: ClArray<'b>) (result: ClArray<'c>) -> let gid = ndRange.GlobalID0 - if gid < lenght then + if gid < length then result.[gid] <- (%op) value.Value inputArray.[gid] @> let kernel = clContext.Compile map @@ -78,6 +109,8 @@ module Map = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + valueClCell.Free processor + result /// diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index c90f4cb7..54f8c64d 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -53,6 +53,7 @@ + @@ -68,6 +69,7 @@ + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Intersect.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Intersect.fs new file mode 100644 index 00000000..d5a326a3 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Intersect.fs @@ -0,0 +1,61 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.COO + +open Brahma.FSharp +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Objects.ClContextExtensions + +module internal Intersect = + let findKeysIntersection (clContext: ClContext) workGroupSize = + + let findIntersection = + <@ fun (ndRange: Range1D) (leftNNZ: int) (rightNNZ: int) (leftRows: ClArray) (leftColumns: ClArray) (rightRows: ClArray) (rightColumns: ClArray) (bitmap: ClArray) -> + + let gid = ndRange.GlobalID0 + let bitmapSize = leftNNZ + + if gid < bitmapSize then + + let index: uint64 = + ((uint64 leftRows.[gid]) <<< 32) + ||| (uint64 leftColumns.[gid]) + + let intersect = + (%Search.Bin.existsByKey2D) rightNNZ index rightRows rightColumns + + if intersect then + bitmap.[gid] <- 1 + else + bitmap.[gid] <- 0 @> + + let kernel = clContext.Compile <| findIntersection + + fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.COO<'b>) -> + + let bitmapSize = leftMatrix.NNZ + + let bitmap = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, bitmapSize) + + let ndRange = + Range1D.CreateValid(bitmapSize, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + leftMatrix.NNZ + rightMatrix.NNZ + leftMatrix.Rows + leftMatrix.Columns + rightMatrix.Rows + rightMatrix.Columns + bitmap) + ) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + bitmap diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs index 9b9377f0..5d99f062 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs @@ -1,6 +1,5 @@ namespace GraphBLAS.FSharp.Backend.Matrix.COO -open System open Brahma.FSharp open GraphBLAS.FSharp.Backend.Matrix open GraphBLAS.FSharp.Backend.Quotes diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs index 327a1b45..5c7838fc 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs @@ -8,8 +8,28 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClMatrix open GraphBLAS.FSharp.Objects.ClCellExtensions open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.ClContextExtensions module Matrix = + /// + /// Creates new COO matrix with the values from the given one. + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let copy (clContext: ClContext) workGroupSize = + + let copy = ClArray.copy clContext workGroupSize + + let copyData = ClArray.copy clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: COO<'a>) -> + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + Rows = copy processor allocationMode matrix.Rows + Columns = copy processor allocationMode matrix.Columns + Values = copyData processor allocationMode matrix.Values } + /// /// Builds a new COO matrix whose elements are the results of applying the given function /// to each of the elements of the matrix. @@ -84,7 +104,7 @@ module Matrix = /// /// OpenCL context. /// Should be a power of 2 and greater than 1. - let private compressRows (clContext: ClContext) workGroupSize = + let compressRows (clContext: ClContext) workGroupSize = let compressRows = <@ fun (ndRange: Range1D) (rows: ClArray) (nnz: int) (rowPointers: ClArray) -> @@ -197,8 +217,8 @@ module Matrix = /// /// Transposes the given matrix and returns result as a new matrix. /// - ///OpenCL context. - ///Should be a power of 2 and greater than 1. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. let transpose (clContext: ClContext) workGroupSize = let transposeInPlace = transposeInPlace clContext workGroupSize @@ -216,3 +236,106 @@ module Matrix = Columns = copy queue allocationMode matrix.Columns Values = copyData queue allocationMode matrix.Values } |> transposeInPlace queue + + /// + /// Builds a bitmap. Maps non-zero elements of the left matrix + /// to 1 if the right matrix has non zero element under the same row and column pair, otherwise 0. + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let findKeysIntersection (clContext: ClContext) workGroupSize = + Intersect.findKeysIntersection clContext workGroupSize + + /// + /// Merges two disjoint matrices of the same size. + /// + /// + /// Matrices should have the same number of rows and columns.
+ /// Matrices should not have non zero values with the same index. + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let mergeDisjoint (clContext: ClContext) workGroupSize = + Merge.runDisjoint clContext workGroupSize + + let ofList (clContext: ClContext) allocationMode rowCount columnCount (elements: (int * int * 'a) list) = + let rows, columns, values = + let elements = elements |> Array.ofList + + elements + |> Array.sortInPlaceBy (fun (x, _, _) -> x) + + elements |> Array.unzip3 + + { Context = clContext + Rows = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, rows) + Columns = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, columns) + Values = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, values) + RowCount = rowCount + ColumnCount = columnCount } + + /// + /// Returns matrix composed of all elements from the given row range of the input matrix. + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let subRows (clContext: ClContext) workGroupSize = + + let upperBound = + ClArray.upperBound clContext workGroupSize + + let blit = ClArray.blit clContext workGroupSize + + let blitData = ClArray.blit clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode startRow count (matrix: ClMatrix.COO<'a>) -> + if count <= 0 then + failwith "Count must be greater than zero" + + if startRow < 0 then + failwith "startIndex must be greater then zero" + + if startRow + count > matrix.RowCount then + failwith "startIndex and count sum is larger than the matrix row count" + + let firstRowClCell = clContext.CreateClCell(startRow - 1) + let lastRowClCell = clContext.CreateClCell(startRow + count) + + // extract rows + let firstIndex = + (upperBound processor matrix.Rows firstRowClCell) + .ToHostAndFree processor + + let lastIndex = + (upperBound processor matrix.Rows lastRowClCell) + .ToHostAndFree processor + - 1 + + firstRowClCell.Free processor + lastRowClCell.Free processor + + let resultLength = lastIndex - firstIndex + 1 + + let rows = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + blit processor matrix.Columns firstIndex rows 0 resultLength + + // extract values + let values = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + blitData processor matrix.Values firstIndex values 0 resultLength + + // extract indices + let columns = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + blit processor matrix.Columns firstIndex columns 0 resultLength + + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + Rows = rows + Columns = columns + Values = values } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Merge.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Merge.fs index 5e847976..1401f3cc 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Merge.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Merge.fs @@ -1,8 +1,10 @@ namespace GraphBLAS.FSharp.Backend.Matrix.COO open Brahma.FSharp -open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ClMatrix +open GraphBLAS.FSharp.Objects.ArraysExtensions module Merge = let run<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = @@ -180,3 +182,48 @@ module Merge = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) allRows, allColumns, leftMergedValues, rightMergedValues, isLeft + + let runDisjoint<'a when 'a: struct> (clContext: ClContext) workGroupSize = + + let mergeValues = + <@ fun (ndRange: Range1D) (length: int) (leftValues: ClArray<'a>) (rightValues: ClArray<'a>) (isLeft: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + + if isLeft.[gid] = 0 then + leftValues.[gid] <- rightValues.[gid] @> + + let mergeValuesKernel = clContext.Compile(mergeValues) + + let merge = run clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.COO<'a>) -> + + let length = + leftMatrix.Columns.Length + + rightMatrix.Columns.Length + + let rows, cols, leftValues, rightValues, isLeft = merge processor leftMatrix rightMatrix + + let ndRange = + Range1D.CreateValid(length, workGroupSize) + + let mergeValuesKernel = mergeValuesKernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments(fun () -> mergeValuesKernel.KernelFunc ndRange length leftValues rightValues isLeft) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(mergeValuesKernel)) + + isLeft.Free processor + rightValues.Free processor + + { Context = clContext + Rows = rows + Columns = cols + Values = leftValues + ColumnCount = leftMatrix.ColumnCount + RowCount = leftMatrix.RowCount } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 5cc805f9..0bea32dd 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -393,8 +393,7 @@ module Matrix = { Context = clContext RowCount = matrix.RowCount ColumnCount = matrix.ColumnCount - Rows = rows - NNZ = matrix.NNZ } + Rows = rows } /// /// Gets the number of non-zero elements in each row. diff --git a/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs index 838fdead..9b3c2fbd 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs @@ -2,6 +2,7 @@ namespace GraphBLAS.FSharp.Backend.Matrix.LIL open Brahma.FSharp open GraphBLAS.FSharp +open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClMatrix open GraphBLAS.FSharp.Objects.ClContextExtensions @@ -43,3 +44,9 @@ module Matrix = RowPointers = rowsPointers Columns = columnsIndices Values = values } + + let ofVectors (clContext: ClContext) rowCount columnCount (vectors: ClVector.Sparse<_> option list) = + { Context = clContext + RowCount = rowCount + ColumnCount = columnCount + Rows = vectors } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index c56ec5ea..b15c85e1 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -1,7 +1,6 @@ namespace GraphBLAS.FSharp open Brahma.FSharp -open Microsoft.FSharp.Quotations open GraphBLAS.FSharp open GraphBLAS.FSharp.Backend.Matrix open GraphBLAS.FSharp.Backend.Vector @@ -58,10 +57,53 @@ module Matrix = { Context = clContext RowCount = matrix.RowCount ColumnCount = matrix.ColumnCount - Rows = rows - NNZ = matrix.NNZ } + Rows = rows } |> ClMatrix.LIL + /// + /// Creates new matrix with the values from the given one. + /// New matrix represented in the format of the given one. + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let copyTo (clContext: ClContext) workGroupSize = + + let copyTo = ClArray.copyTo clContext workGroupSize + + let copyDataTo = ClArray.copyTo clContext workGroupSize + + let vectorCopyTo = + Sparse.Vector.copyTo clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (source: ClMatrix<'a>) (destination: ClMatrix<'a>) -> + if source.NNZ <> destination.NNZ + || source.RowCount <> destination.RowCount + || source.ColumnCount <> destination.ColumnCount then + failwith "Two matrices are not of the same size or they have different number of non-zero elements" + + match source, destination with + | ClMatrix.COO s, ClMatrix.COO d -> + copyTo processor s.Rows d.Rows + copyTo processor s.Columns d.Columns + copyDataTo processor s.Values d.Values + | ClMatrix.CSR s, ClMatrix.CSR d -> + copyTo processor s.RowPointers d.RowPointers + copyTo processor s.Columns d.Columns + copyDataTo processor s.Values d.Values + | ClMatrix.CSC s, ClMatrix.CSC d -> + copyTo processor s.Rows d.Rows + copyTo processor s.ColumnPointers d.ColumnPointers + copyDataTo processor s.Values d.Values + | ClMatrix.LIL s, ClMatrix.LIL d -> + List.iter2 + (fun sourceVector destinationVector -> + match sourceVector, destinationVector with + | Some sv, Some dv -> vectorCopyTo processor sv dv + | _ -> failwith "Vectors of LIL matrix are not of the same size") + s.Rows + d.Rows + | _ -> failwith "Matrix formats are not matching" + /// /// Creates a new matrix, represented in CSR format, that is equal to the given one. /// @@ -273,9 +315,9 @@ module Matrix = /// /// /// The format changes according to the following: - /// * COO -> COO - /// * CSR -> CSC - /// * CSC -> CSR + /// * COO -> COO
+ /// * CSR -> CSC
+ /// * CSC -> CSR
/// ///OpenCL context. ///Should be a power of 2 and greater than 1. @@ -296,12 +338,12 @@ module Matrix = /// /// /// The format changes according to the following: - /// * COO -> COO - /// * CSR -> CSC - /// * CSC -> CSR + /// * COO -> COO
+ /// * CSR -> CSC
+ /// * CSC -> CSR
/// - ///OpenCL context. - ///Should be a power of 2 and greater than 1. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. let transpose (clContext: ClContext) workGroupSize = let COOTranspose = COO.Matrix.transpose clContext workGroupSize @@ -332,3 +374,10 @@ module Matrix = Values = copyData processor allocationMode m.Values } |> ClMatrix.CSR | ClMatrix.LIL _ -> failwith "Not yet implemented" + + let ofList (clContext: ClContext) allocationMode format rowCount columnCount (elements: (int * int * 'a) list) = + match format with + | COO -> + COO.Matrix.ofList clContext allocationMode rowCount columnCount elements + |> ClMatrix.COO + | _ -> failwith "Not implemented" diff --git a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs index 81771bd0..766925aa 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs @@ -86,8 +86,7 @@ module ClMatrix = { Context: ClContext RowCount: int ColumnCount: int - Rows: ClVector.Sparse<'elem> option list - NNZ: int } + Rows: ClVector.Sparse<'elem> option list } interface IDeviceMemObject with member this.Dispose q = @@ -95,6 +94,15 @@ module ClMatrix = |> Seq.choose id |> Seq.iter (fun vector -> vector.Dispose q) + member this.NNZ = + this.Rows + |> List.fold + (fun acc row -> + match row with + | Some r -> acc + r.NNZ + | None -> acc) + 0 + type Tuple<'elem when 'elem: struct> = { Context: ClContext RowIndices: ClArray diff --git a/src/GraphBLAS-sharp.Backend/Operations/Operations.fs b/src/GraphBLAS-sharp.Backend/Operations/Operations.fs index 06b2a39a..2e99b7dc 100644 --- a/src/GraphBLAS-sharp.Backend/Operations/Operations.fs +++ b/src/GraphBLAS-sharp.Backend/Operations/Operations.fs @@ -98,6 +98,89 @@ module Operations = |> Some | _ -> failwith "Vector formats are not matching." + /// + /// Applying the given function to the corresponding elements of the two given arrays pairwise. + /// Stores the result in the left vector. + /// + /// + /// The two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2InPlace (map: Expr<'a option -> 'b option -> 'a option>) (clContext: ClContext) workGroupSize = + let map2Dense = + Dense.Vector.map2InPlace map clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + match leftVector, rightVector with + | ClVector.Dense left, ClVector.Dense right -> map2Dense processor left right left + | _ -> failwith "Unsupported vector format" + + /// + /// Applying the given function to the corresponding elements of the two given arrays pairwise. + /// Stores the result in the given vector. + /// + /// + /// The two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2To (map: Expr<'a option -> 'b option -> 'c option>) (clContext: ClContext) workGroupSize = + let map2Dense = + Dense.Vector.map2InPlace map clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) (resultVector: ClVector<'c>) -> + match leftVector, rightVector, resultVector with + | ClVector.Dense left, ClVector.Dense right, ClVector.Dense result -> + map2Dense processor left right result + | _ -> failwith "Unsupported vector format" + + /// + /// Applying the given function to the corresponding elements of the two given arrays pairwise. + /// Returns new vector. + /// + /// + /// The two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2Dense (map: Expr<'a option -> 'b option -> 'a option>) (clContext: ClContext) workGroupSize = + let map2Dense = + Dense.Vector.map2 map clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationFlag (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + match leftVector, rightVector with + | ClVector.Dense left, ClVector.Dense right -> map2Dense processor allocationFlag left right + | _ -> failwith "Unsupported vector format" + + /// + /// Applying the given function to the corresponding elements of the two given arrays pairwise. + /// Returns new vector as option. + /// + /// + /// The two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2Sparse (map: Expr<'a option -> 'b option -> 'a option>) (clContext: ClContext) workGroupSize = + let map2Sparse = + Sparse.Map2.run map clContext workGroupSize + + let map2SparseDense = + Sparse.Map2.runSparseDense map clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationFlag (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + match leftVector, rightVector with + | ClVector.Sparse left, ClVector.Sparse right -> + Option.map ClVector.Sparse (map2Sparse processor allocationFlag left right) + | ClVector.Sparse left, ClVector.Dense right -> + Option.map ClVector.Sparse (map2SparseDense processor allocationFlag left right) + | _ -> failwith "Unsupported vector format" + module Matrix = /// /// Builds a new matrix whose elements are the results of applying the given function @@ -374,3 +457,43 @@ module Operations = run processor allocationMode resultCapacity leftMatrix rightMatrix | _ -> failwith "Matrix formats are not matching" + + module COO = + /// + /// Generalized matrix-matrix multiplication. Left matrix should be in COO format. + /// + /// Type of binary function to reduce entries. + /// Type of binary function to combine entries. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let expand + (opAdd: Expr<'c -> 'c -> 'c option>) + (opMul: Expr<'a -> 'b -> 'c option>) + (clContext: ClContext) + workGroupSize + = + + let run = + SpGeMM.Expand.COO.run opAdd opMul clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> + match leftMatrix, rightMatrix with + | ClMatrix.COO leftMatrix, ClMatrix.CSR rightMatrix -> + let allocCapacity = + List.max [ sizeof<'a> + sizeof<'c> + sizeof<'b> ] + |> uint64 + |> (*) 1UL + + let resultCapacity = + (clContext.MaxMemAllocSize / allocCapacity) / 3UL + + let resultCapacity = + (min + <| uint64 System.Int32.MaxValue + <| resultCapacity) + |> int + + run processor allocationMode resultCapacity leftMatrix rightMatrix + | _ -> failwith "Matrix formats are not matching" diff --git a/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Expand.fs index e404cf87..45ff0df0 100644 --- a/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Expand.fs @@ -3,7 +3,6 @@ open Brahma.FSharp open FSharp.Quotations open GraphBLAS.FSharp -open GraphBLAS.FSharp open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClMatrix open GraphBLAS.FSharp.Objects.ClCellExtensions @@ -499,3 +498,186 @@ module internal Expand = Values = values } |> Some | _ -> None + + module COO = + let runOneStep opAdd opMul (clContext: ClContext) workGroupSize = + + let runCOO = + runCOO opAdd opMul clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.COO<'a>) rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> + + let _, result = + runCOO processor allocationMode rightMatrixRowsNNZ rightMatrix leftMatrix + + result + |> Option.map + (fun (values, columns, rows) -> + { Context = clContext + RowCount = leftMatrix.RowCount + ColumnCount = rightMatrix.ColumnCount + Rows = rows + Columns = columns + Values = values }) + + let runManySteps opAdd opMul (clContext: ClContext) workGroupSize = + + let compress = + COO.Matrix.compressRows clContext workGroupSize + + let gather = + Common.Gather.run clContext workGroupSize + + let upperBound = + ClArray.upperBound clContext workGroupSize + + let set = ClArray.set clContext workGroupSize + + let subMatrix = + COO.Matrix.subRows clContext workGroupSize + + let runCOO = + runCOO opAdd opMul clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode maxAllocSize generalLength (leftMatrix: ClMatrix.COO<'a>) segmentLengths rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> + + let leftRowPointers = + compress processor allocationMode leftMatrix.Rows leftMatrix.RowCount + + // extract segment lengths by left matrix rows pointers + let segmentPointersByLeftMatrixRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftRowPointers.Length) + + gather processor leftRowPointers segmentLengths segmentPointersByLeftMatrixRows + + // set last element to one step length + set processor segmentPointersByLeftMatrixRows (leftRowPointers.Length - 1) generalLength + + // curring + let upperBound = + upperBound processor segmentPointersByLeftMatrixRows + + let subMatrix = subMatrix processor DeviceOnly + + let runCOO = + runCOO processor allocationMode rightMatrixRowsNNZ rightMatrix + + let rec helper beginRow workOffset previousResult = + if beginRow < leftMatrix.RowCount then + let currentBound = + clContext.CreateClCell(workOffset + maxAllocSize: int) + + // find largest row that fit into maxAllocSize + let upperBound = + (upperBound currentBound).ToHostAndFree processor + + let endRow = upperBound - 2 + + currentBound.Free processor + + // TODO(handle largest rows) + // (we can split row, multiply and merge them but merge path needed) + if endRow = beginRow then + failwith "It is impossible to multiply such a long row" + + // extract matrix TODO(Transfer overhead) + let subMatrix = + subMatrix beginRow (endRow - beginRow) leftMatrix + + // compute sub result + let length, result = runCOO subMatrix + // increase workOffset according to previous expand + let workOffset = workOffset + length + + match result with + | Some result -> + helper endRow workOffset + <| result :: previousResult + | None -> helper endRow workOffset previousResult + else + previousResult + + let result = helper 0 0 [] |> List.rev + + segmentPointersByLeftMatrixRows.Free processor + + result + + let run opAdd opMul (clContext: ClContext) workGroupSize = + + let getNNZInRows = + CSR.Matrix.NNZInRows clContext workGroupSize + + let getSegmentPointers = + getSegmentPointers clContext workGroupSize + + let runOneStep = + runOneStep opAdd opMul clContext workGroupSize + + let concat = ClArray.concat clContext workGroupSize + + let concatData = ClArray.concat clContext workGroupSize + + let runManySteps = + runManySteps opAdd opMul clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode maxAllocSize (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + + let rightMatrixRowsNNZ = + getNNZInRows processor DeviceOnly rightMatrix + + let generalLength, segmentLengths = + getSegmentPointers processor leftMatrix.Columns rightMatrixRowsNNZ + + if generalLength = 0 then + None + elif generalLength < maxAllocSize then + segmentLengths.Free processor + + runOneStep processor allocationMode leftMatrix rightMatrixRowsNNZ rightMatrix + else + let result = + runManySteps + processor + allocationMode + maxAllocSize + generalLength + leftMatrix + segmentLengths + rightMatrixRowsNNZ + rightMatrix + + rightMatrixRowsNNZ.Free processor + segmentLengths.Free processor + + match result with + | _ :: _ -> + let valuesList, columnsList, rowsList = result |> List.unzip3 + + let values = + concatData processor allocationMode valuesList + + let columns = + concat processor allocationMode columnsList + + let rows = concat processor allocationMode rowsList + + // TODO(overhead: compute result length 3 time) + // release resources + valuesList + |> List.iter (fun array -> array.Free processor) + + columnsList + |> List.iter (fun array -> array.Free processor) + + rowsList + |> List.iter (fun array -> array.Free processor) + + { Context = clContext + RowCount = leftMatrix.RowCount + ColumnCount = rightMatrix.ColumnCount + Rows = rows + Columns = columns + Values = values } + |> Some + | _ -> None diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 5d80a0da..d66b15e5 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -1,6 +1,7 @@ namespace GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Objects +open Microsoft.FSharp.Quotations module ArithmeticOperations = let inline private mkUnaryOp zero unaryOp = @@ -191,6 +192,8 @@ module ArithmeticOperations = | Some true -> None | _ -> Some true @> + let intNotQ = <@ fun x -> if x = 0 then 1 else 0 @> + let inline private binOpQ zero op = <@ fun (left: 'a) (right: 'a) -> let result = (%op) left right @@ -229,6 +232,11 @@ module ArithmeticOperations = let float32Mul = createPair 0.0f (*) <@ (*) @> + // without zero + let intAddWithoutZero = <@ fun x y -> Some(x + y) @> + + let intMulWithoutZero = <@ fun x y -> Some(x * y) @> + // other operations let less<'a when 'a: comparison> = <@ fun (x: 'a option) (y: 'a option) -> @@ -237,10 +245,15 @@ module ArithmeticOperations = | Some x, None -> Some 1 | _ -> None @> - let min<'a when 'a: comparison> = + let minOption<'a when 'a: comparison> = <@ fun (x: 'a option) (y: 'a option) -> match x, y with | Some x, Some y -> Some(min x y) | Some x, None -> Some x | None, Some y -> Some y | _ -> None @> + + let min<'a when 'a: comparison> = + <@ fun (x: 'a) (y: 'a) -> Some(min x y) @> + + let fst<'a> = <@ fun (x: 'a) (_: 'a) -> Some x @> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs index 183d3e4c..27687645 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs @@ -96,6 +96,36 @@ module Search = result @> + /// + /// Searches value in array by two keys. + /// In case there is a value at the given keys position, it returns true. + /// + let existsByKey2D<'a> = + <@ fun length sourceIndex (rowIndices: ClArray) (columnIndices: ClArray) -> + + let mutable leftEdge = 0 + let mutable rightEdge = length - 1 + + let mutable result = false + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + + let currentIndex: uint64 = + ((uint64 rowIndices.[middleIdx]) <<< 32) + ||| (uint64 columnIndices.[middleIdx]) + + if sourceIndex = currentIndex then + result <- true + + rightEdge <- -1 // TODO() break + elif sourceIndex < currentIndex then + rightEdge <- middleIdx - 1 + else + leftEdge <- middleIdx + 1 + + result @> + /// /// Find lower position of item in array. /// diff --git a/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs index 6401a580..6b6a7629 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs @@ -218,3 +218,34 @@ module Vector = result | None -> clContext.CreateClCell Unchecked.defaultof<'a> + + let ofList (clContext: ClContext) workGroupSize = + let scatter = + Common.Scatter.lastOccurrence clContext workGroupSize + + let zeroCreate = + ClArray.zeroCreate clContext workGroupSize + + let map = + Backend.Common.Map.map <@ Some @> clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode size (elements: (int * 'a) list) -> + let indices, values = elements |> Array.ofList |> Array.unzip + + let values = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + let indices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, indices) + + let mappedValues = map processor DeviceOnly values + + let result = zeroCreate processor allocationMode size + + scatter processor indices mappedValues result + + processor.Post(Msg.CreateFreeMsg(mappedValues)) + processor.Post(Msg.CreateFreeMsg(indices)) + processor.Post(Msg.CreateFreeMsg(values)) + + result diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs index 6d5bc25d..1a7fb8f7 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs @@ -6,6 +6,7 @@ open Microsoft.FSharp.Quotations open GraphBLAS.FSharp open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVector +open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Backend.Quotes module Vector = @@ -20,6 +21,15 @@ module Vector = Values = copyData processor allocationMode vector.Values Size = vector.Size } + let copyTo (clContext: ClContext) workGroupSize = + let copyTo = ClArray.copyTo clContext workGroupSize + + let copyDataTo = ClArray.copyTo clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (source: Sparse<'a>) (destination: Sparse<'a>) -> + copyTo processor source.Indices destination.Indices + copyDataTo processor source.Values destination.Values + let map = Map.run let mapWithValue = Map.WithValueOption.run @@ -74,3 +84,15 @@ module Vector = Common.Reduce.reduce opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClVector.Sparse<'a>) -> reduce processor vector.Values + + let ofList (clContext: ClContext) allocationMode size (elements: (int * 'a) list) = + let indices, values = + elements + |> Array.ofList + |> Array.sortBy fst + |> Array.unzip + + { Context = clContext + Indices = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, indices) + Values = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, values) + Size = size } diff --git a/src/GraphBLAS-sharp/Objects/Matrix.fs b/src/GraphBLAS-sharp/Objects/Matrix.fs index e74e9153..84004b1a 100644 --- a/src/GraphBLAS-sharp/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp/Objects/Matrix.fs @@ -187,8 +187,7 @@ module Matrix = { Context = context RowCount = this.RowCount ColumnCount = this.ColumnCount - Rows = rows - NNZ = this.NNZ } + Rows = rows } type Tuples<'a> = { RowIndices: int [] diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/MSBFS.fs b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/MSBFS.fs new file mode 100644 index 00000000..205e1218 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/MSBFS.fs @@ -0,0 +1,127 @@ +module GraphBLAS.FSharp.Tests.Backend.Algorithms.MSBFS + +open Expecto +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Context +open GraphBLAS.FSharp.Tests.Backend.QuickGraph.Algorithms +open GraphBLAS.FSharp.Tests.Backend.QuickGraph.CreateGraph +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.MatrixExtensions + +let config = Utils.undirectedAlgoConfig + +let workGroupSize = Utils.defaultWorkGroupSize + +let makeLevelsTest context queue bfs (matrix: int [,]) = + let graph = undirectedFromArray2D matrix 0 + + let largestComponent = + ConnectedComponents.largestComponent graph + + Array.sortInPlace largestComponent + + if largestComponent.Length > 1 then + let sourceVertexCount = max 2 (largestComponent.Length / 10) + + let source = + largestComponent.[0..sourceVertexCount - 1] + |> Array.sort + |> Array.toList + + let matrixHost = + Utils.createMatrixFromArray2D CSR matrix ((=) 0) + + let matrixDevice = matrixHost.ToDevice context + + let expectedArray2D: int [,] = + Array2D.zeroCreate sourceVertexCount (Array2D.length1 matrix) + + source + |> List.iteri + (fun i vertex -> + (snd (BFS.runUndirected graph vertex)) + |> Utils.createArrayFromDictionary (Array2D.length1 matrix) 0 + |> Array.iteri (fun col value -> expectedArray2D.[i, col] <- value)) + + let expected = + Utils.createMatrixFromArray2D COO expectedArray2D ((=) 0) + + let actual: ClMatrix = bfs queue matrixDevice source + let actual = actual.ToHostAndFree queue + + matrixDevice.Dispose queue + + match actual, expected with + | Matrix.COO a, Matrix.COO e -> Utils.compareCOOMatrix (=) a e + | _ -> failwith "Not implemented" + +let createLevelsTest<'a> context queue testFun = + testFun + |> makeLevelsTest context queue + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let levelsTestFixtures (testContext: TestContext) = + [ let context = testContext.ClContext + let queue = testContext.Queue + + let bfsLevels = + Algorithms.MSBFS.runLevels + ArithmeticOperations.intAddWithoutZero + ArithmeticOperations.intMulWithoutZero + context + workGroupSize + + createLevelsTest context queue bfsLevels ] + +let levelsTests = + TestCases.gpuTests "MSBFS Levels tests" levelsTestFixtures + +let makeParentsTest context queue bfs (matrix: int [,]) = + + let graph = undirectedFromArray2D matrix 0 + + let largestComponent = + ConnectedComponents.largestComponent graph + + if largestComponent.Length > 1 then + let sourceVertexCount = max 2 (largestComponent.Length / 10) + + let source = largestComponent.[0..sourceVertexCount] + source |> Array.sortInPlace + let source = source |> Array.toList + + let matrixHost = + Utils.createMatrixFromArray2D CSR matrix ((=) 0) + + let matrixDevice = matrixHost.ToDevice context + + let expected = + HostPrimitives.MSBFSParents matrix source + + let actual: ClMatrix = bfs queue matrixDevice source + let actual = actual.ToHostAndFree queue + + matrixDevice.Dispose queue + + match actual, expected with + | Matrix.COO a, Matrix.COO e -> Utils.compareCOOMatrix (=) a e + | _ -> failwith "Not implemented" + +let createParentsTest<'a> context queue testFun = + testFun + |> makeParentsTest context queue + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let parentsTestFixtures (testContext: TestContext) = + [ let context = testContext.ClContext + let queue = testContext.Queue + + let bfsParents = + Algorithms.MSBFS.runParents context workGroupSize + + createParentsTest context queue bfsParents ] + +let parentsTests = + TestCases.gpuTests "MSBFS Parents tests" parentsTestFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ExcludeElements.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ExcludeElements.fs new file mode 100644 index 00000000..335cd665 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ExcludeElements.fs @@ -0,0 +1,63 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.ExcludeElements + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.ClContextExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let makeTest<'a> isEqual (zero: 'a) testFun ((array, bitmap): 'a array * int array) = + if array.Length > 0 && (Array.exists ((=) 1) bitmap) then + + let arrayCl = context.CreateClArray array + let bitmapCl = context.CreateClArray bitmap + + let actual: ClArray<'a> option = + testFun processor HostInterop bitmapCl arrayCl + + let actual = + actual + |> Option.map (fun a -> a.ToHostAndFree processor) + + arrayCl.Free processor + bitmapCl.Free processor + + let expected = + (bitmap, array) + ||> Array.zip + |> Array.filter (fun (bit, _) -> bit <> 1) + |> Array.unzip + |> snd + + match actual with + | Some actual -> + "Results must be the same" + |> Utils.compareArrays isEqual actual expected + | None -> + "Expected should be empty" + |> Expect.isEmpty expected + +let createTest<'a> (zero: 'a) isEqual = + ClArray.excludeElements context Utils.defaultWorkGroupSize + |> makeTest<'a> isEqual zero + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest 0 (=) + + if Utils.isFloat64Available context.ClDevice then + createTest 0.0 (=) + + createTest 0.0f (=) + createTest false (=) ] + |> testList "ExcludeElements tests" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Intersect.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Intersect.fs new file mode 100644 index 00000000..15760ada --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Intersect.fs @@ -0,0 +1,78 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.Intersect + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Context +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.ArraysExtensions + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let workGroupSize = Utils.defaultWorkGroupSize + +let context = defaultContext.ClContext +let processor = defaultContext.Queue + +let makeTest<'a when 'a: struct> isZero testFun (leftMatrix: 'a [,], rightMatrix: 'a [,]) = + + let m1 = + Matrix.COO.FromArray2D(leftMatrix, isZero) + + let m2 = + Matrix.COO.FromArray2D(rightMatrix, isZero) + + if m1.NNZ > 0 && m2.NNZ > 0 then + + let expected = + let mutable index = 0 + let bitmap = Array.zeroCreate m1.NNZ + + leftMatrix + |> Array2D.iteri + (fun row col value -> + if row < m2.RowCount + && col < m2.ColumnCount + && not <| isZero rightMatrix.[row, col] + && not <| isZero value then + bitmap.[index] <- 1 + + if not <| isZero value then + index <- index + 1) + + bitmap + + let m1 = m1.ToDevice context + let m2 = m2.ToDevice context + + let actual: ClArray = + testFun processor ClContextExtensions.HostInterop m1 m2 + + let actual = actual.ToHostAndFree processor + + m1.Dispose processor + m2.Dispose processor + + // Check result + "Matrices should be equal" + |> Expect.equal actual expected + +let inline createTest<'a when 'a: struct> (isZero: 'a -> bool) = + Matrix.COO.Matrix.findKeysIntersection context workGroupSize + |> makeTest<'a> isZero + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest ((=) false) + createTest ((=) 0) + createTest ((=) 0uy) + createTest (Utils.float32IsEqual 0.0f) + + if Utils.isFloat64Available context.ClDevice then + createTest (Utils.floatIsEqual 0.0) ] + |> testList "Intersect tests" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Merge.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Merge.fs index 554fbff2..af7a2700 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Merge.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Merge.fs @@ -2,12 +2,14 @@ module GraphBLAS.FSharp.Tests.Backend.Matrix.Merge open Brahma.FSharp open Expecto +open GraphBLAS.FSharp.Test open Microsoft.FSharp.Collections open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.MatrixExtensions let context = Context.defaultContext.ClContext @@ -108,6 +110,60 @@ let testsCOO = createTestCOO (=) false ] |> testList "COO" +let makeTestCOODisjoint isEqual zero testFun (array: ('a * 'a) [,]) = + + let leftArray = Array2D.map fst array + let rightArray = Array2D.map snd array + + let leftMatrix = + Matrix.COO.FromArray2D(leftArray, isEqual zero) + + let rightMatrix = + Matrix.COO.FromArray2D(rightArray, isEqual zero) + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + + let actual: ClMatrix.COO<'a> = + testFun processor clLeftMatrix clRightMatrix + + let actual = actual.ToHostAndFree processor + + clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor + + rightArray + |> Array2D.iteri + (fun row column value -> + if value <> zero then + leftArray.[row, column] <- value) + + let expected = + Matrix.COO.FromArray2D(leftArray, isEqual zero) + + Utils.compareCOOMatrix isEqual actual expected + +let createTestCOODisjoint isEqual (zero: 'a) = + let configDisjoint = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + + Matrix.COO.Merge.runDisjoint context Utils.defaultWorkGroupSize + |> makeTestCOODisjoint isEqual zero + |> testPropertyWithConfig configDisjoint $"test on {typeof<'a>}" + +let testsCOODisjoint = + [ createTestCOODisjoint (=) 0 + + if Utils.isFloat64Available context.ClDevice then + createTestCOODisjoint (=) 0.0 + + createTestCOODisjoint (=) 0.0f + createTestCOODisjoint (=) false ] + |> testList "COO Disjoint" + let makeTestCSR isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = let leftMatrix = Matrix.CSR.FromArray2D(leftArray, isEqual zero) @@ -173,4 +229,5 @@ let testsCSR = |> testList "CSR" let allTests = - [ testsCSR; testsCOO ] |> testList "Merge" + [ testsCSR; testsCOO; testsCOODisjoint ] + |> testList "Merge" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/ExpandCOO.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/ExpandCOO.fs new file mode 100644 index 00000000..43787eac --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/ExpandCOO.fs @@ -0,0 +1,77 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.SpGeMM.ExpandCOO + +open Expecto +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.MatrixExtensions +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Backend + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let makeGeneralTest zero isEqual opAdd opMul testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = + Utils.createMatrixFromArray2D COO leftArray (isEqual zero) + + let rightMatrix = + Utils.createMatrixFromArray2D CSR rightArray (isEqual zero) + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + + let (clMatrixActual: ClMatrix.COO<_> option) = + testFun processor HostInterop clLeftMatrix clRightMatrix + + let expected = + HostPrimitives.array2DMultiplication zero opMul opAdd leftArray rightArray + |> fun array -> Matrix.COO.FromArray2D(array, isEqual zero) + + match clMatrixActual with + | Some clMatrixActual -> + + let matrixActual = clMatrixActual.ToHost processor + clMatrixActual.Dispose processor + + Utils.compareCOOMatrix isEqual matrixActual expected + | None -> + "Expected should be empty" + |> Expect.isTrue (expected.NNZ = 0) + +let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = + testFun opAddQ opMulQ context Utils.defaultWorkGroupSize + |> makeGeneralTest zero isEqual opAdd opMul + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let generalTests = + [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Operations.SpGeMM.COO.expand + + if Utils.isFloat64Available context.ClDevice then + createGeneralTest + 0.0 + Utils.floatIsEqual + ArithmeticOperations.floatAdd + ArithmeticOperations.floatMul + Operations.SpGeMM.COO.expand + + createGeneralTest + 0.0f + Utils.float32IsEqual + ArithmeticOperations.float32Add + ArithmeticOperations.float32Mul + Operations.SpGeMM.COO.expand + createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Operations.SpGeMM.COO.expand ] + |> testList "General" + +let tests = + testList "SpGeMM.Expand" [ generalTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index fec8f61e..deaab99c 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -34,9 +34,10 @@ module Generators = } let genericSparseGenerator zero valuesGen handler = - let maxSparsity = 10 + let minSparsity = 10 + let maxSparsity = 50 let upperBound = 100 - let sparsityGen = Gen.choose (1, maxSparsity) + let sparsityGen = Gen.choose (minSparsity, maxSparsity) let genWithSparsity sparseValuesGenProvider = gen { @@ -167,6 +168,67 @@ module Generators = |> genericSparseGenerator false Arb.generate |> Arb.fromGen + type PairOfSparseMatrices() = + static let pairOfMatricesOfEqualSizeGenerator (valuesGenerator: Gen<'a>) = + gen { + let! nRowsA, nColumnsA = dimension2DGenerator + let! nRowsB, nColumnsB = dimension2DGenerator + + let! matrixA = + valuesGenerator + |> Gen.array2DOfDim (nRowsA, nColumnsA) + + let! matrixB = + valuesGenerator + |> Gen.array2DOfDim (nRowsB, nColumnsB) + + return (matrixA, matrixB) + } + + static member IntType() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0 Arb.generate + |> Arb.fromGen + + static member FloatType() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator + 0. + (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0.0f (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0y Arb.generate + |> Arb.fromGen + + static member ByteType() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0uy Arb.generate + |> Arb.fromGen + + static member Int16Type() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0s Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0us Arb.generate + |> Arb.fromGen + + static member BoolType() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator false Arb.generate + |> Arb.fromGen + type PairOfSparseMatricesOfEqualSize() = static let pairOfMatricesOfEqualSizeGenerator (valuesGenerator: Gen<'a>) = gen { @@ -403,6 +465,73 @@ module Generators = |> genericSparseGenerator false Arb.generate |> Arb.fromGen + type PairOfDisjointMatricesOfTheSameSize() = + static let pairOfDisjointMatricesGenerator zero (valuesGenerator: Gen<'a>) = + gen { + let! rowCount, columnCount = dimension2DGenerator + + let! pairs = + Gen.two valuesGenerator + |> Gen.array2DOfDim (rowCount, columnCount) + + let isZero = (=) zero + + let pairs = + pairs + |> Array2D.map + (fun (fst, snd) -> + match () with + | () when isZero fst && not <| isZero snd -> (zero, snd) + | () when not <| isZero fst && isZero snd -> (fst, zero) + | () -> (fst, zero)) + + return pairs + } + + static member IntType() = + (pairOfDisjointMatricesGenerator 0) + |> genericSparseGenerator 0 Arb.generate + |> Arb.fromGen + + static member FloatType() = + (pairOfDisjointMatricesGenerator 0.) + |> genericSparseGenerator + 0. + (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + (pairOfDisjointMatricesGenerator 0.0f) + |> genericSparseGenerator 0.0f (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + (pairOfDisjointMatricesGenerator 0y) + |> genericSparseGenerator 0y Arb.generate + |> Arb.fromGen + + static member ByteType() = + (pairOfDisjointMatricesGenerator 0uy) + |> genericSparseGenerator 0uy Arb.generate + |> Arb.fromGen + + static member Int16Type() = + (pairOfDisjointMatricesGenerator 0s) + |> genericSparseGenerator 0s Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + (pairOfDisjointMatricesGenerator 0us) + |> genericSparseGenerator 0us Arb.generate + |> Arb.fromGen + + static member BoolType() = + (pairOfDisjointMatricesGenerator false) + |> genericSparseGenerator false Arb.generate + |> Arb.fromGen + type VectorXMatrix() = static let pairOfVectorAndMatrixOfCompatibleSizeGenerator (valuesGenerator: Gen<'a>) = gen { @@ -1278,6 +1407,71 @@ module Generators = |> Arb.fromGen module ClArray = + type ExcludeElements() = + static let arrayAndBitmap (valuesGenerator: Gen<'a>) zero = + gen { + let! length = Gen.sized <| fun size -> Gen.choose (1, size) + + let! array = Gen.arrayOfLength length valuesGenerator + + let! bitmap = + Gen.collectToArr + (fun value -> + if value = zero then + Gen.constant 0 + else + Gen.choose (0, 1)) + array + + return (array, bitmap) + } + + static member IntType() = + arrayAndBitmap <| Arb.generate <| 0 + |> Arb.fromGen + + static member FloatType() = + arrayAndBitmap + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + <| 0. + |> Arb.fromGen + + static member Float32Type() = + arrayAndBitmap + <| (normalFloat32Generator <| System.Random()) + <| 0.0f + |> Arb.fromGen + + static member SByteType() = + arrayAndBitmap <| Arb.generate <| 0y + |> Arb.fromGen + + static member ByteType() = + arrayAndBitmap <| Arb.generate <| 0uy + |> Arb.fromGen + + static member Int16Type() = + arrayAndBitmap <| Arb.generate <| 0s + |> Arb.fromGen + + static member UInt16Type() = + arrayAndBitmap <| Arb.generate <| 0us + |> Arb.fromGen + + static member Int32Type() = + arrayAndBitmap <| Arb.generate <| 0 + |> Arb.fromGen + + static member UInt32Type() = + arrayAndBitmap <| Arb.generate <| 0u + |> Arb.fromGen + + static member BoolType() = + arrayAndBitmap <| Arb.generate <| false + |> Arb.fromGen + type Set() = static let arrayAndChunkPosition (valuesGenerator: Gen<'a>) = gen { @@ -1428,7 +1622,7 @@ module Generators = |> Arb.fromGen static member ByteType() = - arrayAndChunkPosition <| Arb.generate + arrayAndChunkPosition <| Arb.generate |> Arb.fromGen static member Int16Type() = diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index cdc0d28f..d4913a3d 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -19,6 +19,7 @@ + @@ -34,6 +35,7 @@ + @@ -50,11 +52,13 @@ + + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 5f8d043b..e9d2e86a 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -337,6 +337,65 @@ module HostPrimitives = op leftElement rightElement + let MSBFSParents matrix source = + let zero = -2 + + let opAdd a b = + let result = min a b + + if result = zero then + None + else + Some result + + let opMul (a: int) (b: int) = + if a = zero || b = 0 then + None + else + Some a + + let array2DMultiplication = array2DMultiplication zero opMul opAdd + + let mutable front = + Array2D.create + <| Seq.length source + <| Array2D.length1 matrix + <| zero + + source + |> Seq.iteri (fun row vertex -> front.[row, vertex] <- vertex) + + let parents = + Array2D.create + <| Seq.length source + <| Array2D.length1 matrix + <| zero + + source + |> Seq.iteri (fun row vertex -> parents.[row, vertex] <- -1) + + let mutable stop = false + + while not stop do + let newFront = array2DMultiplication front matrix + stop <- true + + newFront + |> Array2D.iteri + (fun row col value -> + if value <> zero then + if parents.[row, col] <> zero then + newFront.[row, col] <- zero + + else + stop <- false + parents.[row, col] <- value + newFront.[row, col] <- col) + + front <- newFront + + Utils.createMatrixFromArray2D COO parents ((=) -2) + module Context = type TestContext = { ClContext: ClContext diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 5b7b7908..3a59d101 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,7 +1,7 @@ open Expecto +open GraphBLAS.FSharp.Test.Generators open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Backend -open GraphBLAS.FSharp.Tests.Backend.Matrix let matrixTests = testList @@ -15,6 +15,7 @@ let matrixTests = Matrix.ByRows.tests Matrix.ExpandRows.tests Matrix.SubRows.tests + Matrix.Intersect.tests Matrix.Kronecker.tests Matrix.SpGeMM.Expand.tests @@ -92,7 +93,10 @@ let algorithmsTests = testList "Algorithms tests" [ Algorithms.BFS.tests - Algorithms.SSSP.tests ] + Algorithms.SSSP.tests + + Algorithms.MSBFS.levelsTests + Algorithms.MSBFS.parentsTests ] |> testSequenced let deviceTests =