diff --git a/.github/workflows/build-and-benchmark.yml b/.github/workflows/build-and-benchmark.yml index ff8e88b4..2bde3398 100644 --- a/.github/workflows/build-and-benchmark.yml +++ b/.github/workflows/build-and-benchmark.yml @@ -36,7 +36,7 @@ jobs: with: name: BFS tool: 'benchmarkdotnet' - output-file-path: BenchmarkDotNet.Artifacts/results/GraphBLAS.FSharp.Benchmarks.BFSBenchmarksWithoutDataTransfer-report-brief.json + output-file-path: BenchmarkDotNet.Artifacts/results/GraphBLAS.FSharp.Benchmarks.BFSWithoutTransferBenchmarkInt32-report-brief.json # Access token to deploy GitHub Pages branch github-token: ${{ secrets._GITHUB_TOKEN }} # Push and deploy GitHub pages branch automatically diff --git a/README.md b/README.md index 964b619f..6ddbc2c0 100644 --- a/README.md +++ b/README.md @@ -19,32 +19,38 @@ GraphBLAS# is a GPGPU-based [GraphBLAS](https://graphblas.org/)-like API impleme | Left of 't1 | Right of 't2 ``` - So, type of matrix-matrix elementwise oertion is ```Matrix> -> Matrix> -> (AtLeastOne<'t1,'t2> -> Option<'t3>) -> Matrix>```. -- No semirings. Just functions. Ofcourse one can implement semirings on the top of provided API. + So, type of matrix-matrix elementwise operation is ```Matrix> -> Matrix> -> (AtLeastOne<'t1,'t2> -> Option<'t3>) -> Matrix>```. +- No semirings. Just functions. Of course one can implement semirings on the top of provided API. - Minimal core: high-order functions allows us to minimaze core by functions unification. For example, such functions as matrix-matrix addition, matrix-matrix element-wise multiplication, masking all are partial case of `map2` function. ### Operations - **Matrix-Matrix** - - [x] COO-COO element-wize - - [x] CSR-CSR element-wize - - [ ] CSR-CSR multiplication - - [ ] COO transpose - - [ ] CSR transpose + - [x] CSR-CSR `map2` + - [x] CSR-CSR `map2AtLeastOne` + - [x] COO-COO `map2` + - [x] COO-COO `map2AtLeastOne` + - [x] CSR-CSR multiplication - **Vector-Matrix** - [x] Dense-CSR multiplication - - [ ] COO-CSR multiplication + - [ ] Sparse-CSR multiplication - **Vector-Vector** - - [x] Dense-Dense element-wise + - [x] Dense-Dense `map2` + - [x] Dense-Dense `map2AtLeastOne` + - [x] Sparse-Sparse `map2` + - [x] Sparse-Sparse `map2AtLeastOne` - [ ] ... - **Matrix** - - [ ] `map` - - [ ] `iter` + - [x] `copy` + - [x] `map` + - [x] COO transpose + - [x] CSR transpose + - [x] CSC transpose - [ ] ... - **Vector** - - [ ] `map` - - [ ] `iter` - - [ ] `filter` - - [ ] `contains` + - [x] `zeroCreate` + - [x] `ofList` + - [x] `copy` + - [x] `reduce` - [ ] ... ### Graph Analysis Algorithms diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs new file mode 100644 index 00000000..7115a90c --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs @@ -0,0 +1,178 @@ +namespace GraphBLAS.FSharp.Benchmarks.Algorithms.BFS + +open System.IO +open BenchmarkDotNet.Attributes +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.IO +open Brahma.FSharp +open Backend.Algorithms.BFS +open Microsoft.FSharp.Core +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Benchmarks +open GraphBLAS.FSharp.Backend.Objects + +[] +[] +[] +[)>] +type Benchmarks<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + binaryConverter, + vertex: int) + = + + let mutable funToBenchmark = None + let mutable matrix = Unchecked.defaultof> + let mutable matrixHost = Unchecked.defaultof<_> + + member val ResultLevels = Unchecked.defaultof> with get,set + + [] + member val OclContextInfo = Unchecked.defaultof with get, set + + [] + member val InputMatrixReader = Unchecked.defaultof with get, set + + member this.OclContext = (fst this.OclContextInfo).ClContext + member this.WorkGroupSize = snd this.OclContextInfo + + member this.Processor = + let p = (fst this.OclContextInfo).Queue + p.Error.Add(fun e -> failwithf "%A" e) + p + + static member AvailableContexts = Utils.availableContexts + + static member InputMatrixProviderBuilder pathToConfig = + let datasetFolder = "BFS" + pathToConfig + |> Utils.getMatricesFilenames + |> Seq.map + (fun matrixFilename -> + printfn "%A" matrixFilename + + match Path.GetExtension matrixFilename with + | ".mtx" -> MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) + | _ -> failwith "Unsupported matrix format") + + member this.FunToBenchmark = + match funToBenchmark with + | None -> + let x = buildFunToBenchmark this.OclContext this.WorkGroupSize + funToBenchmark <- Some x + x + | Some x -> x + + member this.BFS() = + this.ResultLevels <- this.FunToBenchmark this.Processor matrix vertex + + member this.ClearInputMatrix() = + (matrix :> IDeviceMemObject).Dispose this.Processor + + member this.ClearResult() = this.ResultLevels.FreeAndWait this.Processor + + member this.ReadMatrix() = + let converter = + match this.InputMatrixReader.Field with + | Pattern -> binaryConverter + | _ -> converter + + matrixHost <- this.InputMatrixReader.ReadMatrix converter + + member this.LoadMatrixToGPU() = + matrix <- matrixHost.ToCSR.ToDevice this.OclContext + + abstract member GlobalSetup : unit -> unit + + abstract member IterationCleanup : unit -> unit + + abstract member GlobalCleanup : unit -> unit + + abstract member Benchmark : unit -> unit + +type WithoutTransferBenchmark<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + boolConverter, + vertex) = + + inherit Benchmarks<'elem>( + buildFunToBenchmark, + converter, + boolConverter, + vertex) + + [] + override this.GlobalSetup() = + this.ReadMatrix() + this.LoadMatrixToGPU() + + [] + override this.IterationCleanup() = + this.ClearResult() + + [] + override this.GlobalCleanup() = + this.ClearInputMatrix() + + [] + override this.Benchmark() = + this.BFS() + this.Processor.PostAndReply Msg.MsgNotifyMe + +type BFSWithoutTransferBenchmarkInt32() = + + inherit WithoutTransferBenchmark( + (singleSource ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), + int32, + (fun _ -> Utils.nextInt (System.Random())), + 0) + + static member InputMatrixProvider = + Benchmarks<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" + +type WithTransferBenchmark<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + boolConverter, + vertex) = + + inherit Benchmarks<'elem>( + buildFunToBenchmark, + converter, + boolConverter, + vertex) + + [] + override this.GlobalSetup() = + this.ReadMatrix() + + [] + override this.GlobalCleanup() = + this.ClearResult() + + [] + override this.IterationCleanup() = + this.ClearInputMatrix() + this.ClearResult() + + [] + override this.Benchmark() = + this.LoadMatrixToGPU() + this.BFS() + this.ResultLevels.ToHost this.Processor |> ignore + this.Processor.PostAndReply Msg.MsgNotifyMe + +type BFSWithTransferBenchmarkInt32() = + + inherit WithTransferBenchmark( + (singleSource ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), + int32, + (fun _ -> Utils.nextInt (System.Random())), + 0) + + static member InputMatrixProvider = + Benchmarks<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" + diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs deleted file mode 100644 index 283cbcc2..00000000 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs +++ /dev/null @@ -1,164 +0,0 @@ -namespace GraphBLAS.FSharp.Benchmarks - -open System.IO -open GraphBLAS.FSharp.Backend.Quotes -open GraphBLAS.FSharp.IO -open BenchmarkDotNet.Attributes -open BenchmarkDotNet.Configs -open BenchmarkDotNet.Columns -open Brahma.FSharp -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Algorithms -open MatrixExtensions -open ArraysExtensions - -[] -[] -[] -[)>] -type BFSBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix) = - - let mutable funToBenchmark = None - let mutable matrix = Unchecked.defaultof<'matrixT> - let mutable matrixHost = Unchecked.defaultof<_> - - let source = 0 - - member val ResultVector = Unchecked.defaultof> with get,set - - [] - member val OclContextInfo = Unchecked.defaultof with get, set - - [] - member val InputMatrixReader = Unchecked.defaultof with get, set - - member this.OclContext:ClContext = (fst this.OclContextInfo).ClContext - member this.WorkGroupSize = snd this.OclContextInfo - - member this.Processor = - let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) - p - - static member AvaliableContexts = Utils.avaliableContexts - - static member InputMatricesProviderBuilder pathToConfig = - let datasetFolder = "" - pathToConfig - |> Utils.getMatricesFilenames - |> Seq.map - (fun matrixFilename -> - printfn "%A" matrixFilename - - match Path.GetExtension matrixFilename with - | ".mtx" -> - MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) - | _ -> failwith "Unsupported matrix format") - - member this.FunToBenchmark = - match funToBenchmark with - | None -> - let x = buildFunToBenchmark this.OclContext this.WorkGroupSize - funToBenchmark <- Some x - x - | Some x -> x - - member this.ReadMatrix (reader:MtxReader) = - let converter = - match reader.Field with - | Pattern -> converterBool - | _ -> converter - - reader.ReadMatrix converter - - member this.BFS() = - this.ResultVector <- this.FunToBenchmark this.Processor matrix source - - member this.ClearInputMatrix() = - (matrix :> IDeviceMemObject).Dispose this.Processor - - member this.ClearResult() = - this.ResultVector.FreeAndWait this.Processor - - member this.ReadMatrix() = - let matrixReader = this.InputMatrixReader - matrixHost <- this.ReadMatrix matrixReader - - member this.LoadMatrixToGPU() = - matrix <- buildMatrix this.OclContext matrixHost - - abstract member GlobalSetup : unit -> unit - - abstract member IterationCleanup : unit -> unit - - abstract member GlobalCleanup : unit -> unit - - abstract member Benchmark : unit -> unit - -type BFSBenchmarksWithoutDataTransfer() = - - inherit BFSBenchmarks, int>( - (fun context wgSize -> BFS.singleSource context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption wgSize), - int, - (fun _ -> Utils.nextInt (System.Random())), - Matrix.ToBackendCSR) - - static member InputMatricesProvider = - BFSBenchmarks<_,_>.InputMatricesProviderBuilder "BFSBenchmarks.txt" - - [] - override this.GlobalSetup() = - this.ReadMatrix () - this.LoadMatrixToGPU () - - [] - override this.IterationCleanup() = - this.ClearResult() - - [] - override this.GlobalCleanup() = - this.ClearInputMatrix() - - [] - override this.Benchmark() = - this.BFS() - this.Processor.PostAndReply(Msg.MsgNotifyMe) - -type BFSBenchmarksWithDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix, - resultToHost) = - - inherit BFSBenchmarks<'matrixT, 'elem>( - buildFunToBenchmark, - converter, - converterBool, - buildMatrix) - - [] - override this.GlobalSetup() = - this.ReadMatrix() - - [] - override this.GlobalCleanup() = () - - [] - override this.IterationCleanup() = - this.ClearInputMatrix() - this.ClearResult() - - [] - override this.Benchmark() = - this.LoadMatrixToGPU() - this.BFS() - this.Processor.PostAndReply Msg.MsgNotifyMe - let res = resultToHost this.ResultVector this.Processor - this.Processor.PostAndReply Msg.MsgNotifyMe - diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs deleted file mode 100644 index 18aa2cdd..00000000 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs +++ /dev/null @@ -1,307 +0,0 @@ -namespace GraphBLAS.FSharp.Benchmarks - -open System.IO -open GraphBLAS.FSharp.Backend.Quotes -open GraphBLAS.FSharp.IO -open BenchmarkDotNet.Attributes -open BenchmarkDotNet.Configs -open BenchmarkDotNet.Columns -open Brahma.FSharp -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Matrix -open GraphBLAS.FSharp.Objects.Matrix -open GraphBLAS.FSharp.Benchmarks.MatrixExtensions -open GraphBLAS.FSharp.Backend.Objects.ClContext - -[] -[] -[] -[)>] -type EWiseAddBenchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix) = - - let mutable funToBenchmark = None - let mutable firstMatrix = Unchecked.defaultof<'matrixT> - let mutable secondMatrix = Unchecked.defaultof<'matrixT> - let mutable firstMatrixHost = Unchecked.defaultof<_> - let mutable secondMatrixHost = Unchecked.defaultof<_> - - member val ResultMatrix = Unchecked.defaultof<'matrixT> with get,set - - [] - member val OclContextInfo = Unchecked.defaultof with get, set - - [] - member val InputMatrixReader = Unchecked.defaultof with get, set - - member this.OclContext:ClContext = (fst this.OclContextInfo).ClContext - member this.WorkGroupSize = snd this.OclContextInfo - - member this.Processor = - let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) - p - - static member AvaliableContexts = Utils.avaliableContexts - - static member InputMatricesProviderBuilder pathToConfig = - let datasetFolder = "EWiseAdd" - pathToConfig - |> Utils.getMatricesFilenames - |> Seq.map - (fun matrixFilename -> - printfn "%A" matrixFilename - - match Path.GetExtension matrixFilename with - | ".mtx" -> - MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) - , MtxReader(Utils.getFullPathToMatrix datasetFolder ("squared_" + matrixFilename)) - | _ -> failwith "Unsupported matrix format") - - member this.FunToBenchmark = - match funToBenchmark with - | None -> - let x = buildFunToBenchmark this.OclContext this.WorkGroupSize - funToBenchmark <- Some x - x - | Some x -> x - - member this.ReadMatrix (reader:MtxReader) = - let converter = - match reader.Field with - | Pattern -> converterBool - | _ -> converter - - reader.ReadMatrix converter - - member this.EWiseAddition() = - this.ResultMatrix <- this.FunToBenchmark this.Processor HostInterop firstMatrix secondMatrix - - member this.ClearInputMatrices() = - (firstMatrix :> IDeviceMemObject).Dispose this.Processor - (secondMatrix :> IDeviceMemObject).Dispose this.Processor - - member this.ClearResult() = - (this.ResultMatrix :> IDeviceMemObject).Dispose this.Processor - - member this.ReadMatrices() = - let leftMatrixReader = fst this.InputMatrixReader - let rightMatrixReader = snd this.InputMatrixReader - firstMatrixHost <- this.ReadMatrix leftMatrixReader - secondMatrixHost <- this.ReadMatrix rightMatrixReader - - member this.LoadMatricesToGPU () = - firstMatrix <- buildMatrix this.OclContext firstMatrixHost - secondMatrix <- buildMatrix this.OclContext secondMatrixHost - - abstract member GlobalSetup : unit -> unit - - abstract member IterationCleanup : unit -> unit - - abstract member GlobalCleanup : unit -> unit - - abstract member Benchmark : unit -> unit - -type EWiseAddBenchmarksWithoutDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix) = - - inherit EWiseAddBenchmarks<'matrixT, 'elem>( - buildFunToBenchmark, - converter, - converterBool, - buildMatrix) - - [] - override this.GlobalSetup() = - this.ReadMatrices () - this.LoadMatricesToGPU () - - [] - override this.IterationCleanup () = - this.ClearResult() - - [] - override this.GlobalCleanup () = - this.ClearInputMatrices() - - [] - override this.Benchmark () = - this.EWiseAddition() - this.Processor.PostAndReply(Msg.MsgNotifyMe) - -type EWiseAddBenchmarksWithDataTransfer<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( - buildFunToBenchmark, - converter: string -> 'elem, - converterBool, - buildMatrix, - resultToHost) = - - inherit EWiseAddBenchmarks<'matrixT, 'elem>( - buildFunToBenchmark, - converter, - converterBool, - buildMatrix) - - [] - override this.GlobalSetup () = - this.ReadMatrices () - - [] - override this.GlobalCleanup () = () - - [] - override this.IterationCleanup () = - this.ClearInputMatrices() - this.ClearResult() - - [] - override this.Benchmark () = - this.LoadMatricesToGPU() - this.EWiseAddition() - this.Processor.PostAndReply Msg.MsgNotifyMe - let res = resultToHost this.ResultMatrix this.Processor - this.Processor.PostAndReply Msg.MsgNotifyMe - -module M = - let resultToHostCOO (resultMatrix: ClMatrix.COO<'a>) (processor :MailboxProcessor<_>) = - let cols = - let a = Array.zeroCreate resultMatrix.ColumnCount - processor.Post(Msg.CreateToHostMsg<_>(resultMatrix.Columns,a)) - a - let rows = - let a = Array.zeroCreate resultMatrix.RowCount - processor.Post(Msg.CreateToHostMsg(resultMatrix.Rows,a)) - a - let vals = - let a = Array.zeroCreate resultMatrix.Values.Length - processor.Post(Msg.CreateToHostMsg(resultMatrix.Values,a)) - a - { - RowCount = resultMatrix.RowCount - ColumnCount = resultMatrix.ColumnCount - Rows = rows - Columns = cols - Values = vals - } - - -type EWiseAddBenchmarks4Float32COOWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.ToBackendCOO - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" - -type EWiseAddBenchmarks4Float32COOWithDataTransfer() = - - inherit EWiseAddBenchmarksWithDataTransfer,float32>( - (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.ToBackendCOO, - M.resultToHostCOO - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" - - -type EWiseAddBenchmarks4BoolCOOWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> COO.Matrix.map2 context ArithmeticOperations.boolSum wgSize), - (fun _ -> true), - (fun _ -> true), - Matrix.ToBackendCOO - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCOO.txt" - - -type EWiseAddBenchmarks4Float32CSRWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> CSR.Matrix.map2 context ArithmeticOperations.float32SumOption wgSize), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.ToBackendCSR - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32CSR.txt" - - -type EWiseAddBenchmarks4BoolCSRWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> CSR.Matrix.map2 context ArithmeticOperations.boolSum wgSize), - (fun _ -> true), - (fun _ -> true), - Matrix.ToBackendCSR - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" - -// With AtLeastOne - -type EWiseAddAtLeastOneBenchmarks4BoolCOOWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> COO.Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne wgSize), - (fun _ -> true), - (fun _ -> true), - Matrix.ToBackendCOO - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" - -type EWiseAddAtLeastOneBenchmarks4BoolCSRWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,bool>( - (fun context wgSize -> CSR.Matrix.map2AtLeastOne context ArithmeticOperations.boolSumAtLeastOne wgSize), - (fun _ -> true), - (fun _ -> true), - Matrix.ToBackendCSR - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" - -type EWiseAddAtLeastOneBenchmarks4Float32COOWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> COO.Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne wgSize), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.ToBackendCOO - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" - -type EWiseAddAtLeastOneBenchmarks4Float32CSRWithoutDataTransfer() = - - inherit EWiseAddBenchmarksWithoutDataTransfer,float32>( - (fun context wgSize -> CSR.Matrix.map2AtLeastOne context ArithmeticOperations.float32SumAtLeastOne wgSize), - float32, - (fun _ -> Utils.nextSingle (System.Random())), - Matrix.ToBackendCSR - ) - - static member InputMatricesProvider = - EWiseAddBenchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxv.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxv.fs deleted file mode 100644 index 62dade8a..00000000 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxv.fs +++ /dev/null @@ -1,77 +0,0 @@ -namespace GraphBLAS.FSharp.Benchmarks - -open GraphBLAS.FSharp -open GraphBLAS.FSharp.Backend -open BenchmarkDotNet.Attributes -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Objects - -[)>] -type MxvBenchmarks() = - let rand = System.Random() - - let mutable matrix = Unchecked.defaultof> - let mutable vector = Unchecked.defaultof> - let semiring = Predefined.AddMult.float - - //TODO fix me - (*[] - member val OclContext = Unchecked.defaultof with get, set - member this.Context = - let (ClContext context) = this.OclContext - context - - [] - member val InputMatrixReader = Unchecked.defaultof with get, set - - [] - member this.BuildMatrix() = - let inputMatrix = this.InputMatrixReader.ReadMatrixReal(float) - - matrix <- - graphblas { - return! Matrix.switch CSR inputMatrix - >>= Matrix.synchronizeAndReturn - } - |> EvalGB.withClContext this.Context - |> EvalGB.runSync - - [] - member this.BuildVector() = - vector <- - graphblas { - return! - [ for i = 0 to matrix.ColumnCount - 1 do if rand.Next() % 2 = 0 then yield (i, 1.) ] - |> Vector.ofList matrix.ColumnCount - // >>= Vector.synchronizeAndReturn - } - |> EvalGB.withClContext this.Context - |> EvalGB.runSync - - [] - member this.Mxv() = - Matrix.mxv semiring matrix vector - |> EvalGB.withClContext this.Context - |> EvalGB.runSync - - [] - member this.ClearBuffers() = - this.Context.Provider.CloseAllBuffers() - - [] - member this.ClearContext() = - let (ClContext context) = this.OclContext - context.Provider.Dispose() - - static member AvaliableContextsProvider = Utils.avaliableContexts - - static member InputMatricesProvider = - "Common.txt" - |> Utils.getMatricesFilenames - |> Seq.map - (fun matrixFilename -> - match Path.GetExtension matrixFilename with - | ".mtx" -> MtxReader(Utils.getFullPathToMatrix "Common" matrixFilename) - | _ -> failwith "Unsupported matrix format" - ) -*) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksTranspose.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksTranspose.fs deleted file mode 100644 index 92a60f38..00000000 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksTranspose.fs +++ /dev/null @@ -1,68 +0,0 @@ -namespace GraphBLAS.FSharp.Benchmarks - -open GraphBLAS.FSharp -open GraphBLAS.FSharp.Algorithms -open BenchmarkDotNet.Attributes -open BenchmarkDotNet.Configs -open BenchmarkDotNet.Columns -open System.IO -open System -open System.Text.RegularExpressions -open Brahma.FSharp.OpenCL -open OpenCL.Net -open GraphBLAS.FSharp.IO - -[)>] -type TransposeBenchmarks() = - let mutable matrix = Unchecked.defaultof> - - //TODO fix me - (* - [] - member val OclContext = Unchecked.defaultof with get, set - member this.Context = - let (ClContext context) = this.OclContext - context - - [] - member val InputMatrixReader = Unchecked.defaultof with get, set - - [] - member this.BuildMatrix() = - let inputMatrix = this.InputMatrixReader.ReadMatrixReal(float) - - matrix <- - graphblas { - return! Matrix.switch CSR inputMatrix - >>= Matrix.synchronizeAndReturn - } - |> EvalGB.withClContext this.Context - |> EvalGB.runSync - - [] - member this.Transpose() = - Matrix.transpose matrix - |> EvalGB.withClContext this.Context - |> EvalGB.runSync - - [] - member this.ClearBuffers() = - this.Context.Provider.CloseAllBuffers() - - [] - member this.ClearContext() = - let (ClContext context) = this.OclContext - context.Provider.Dispose() - - static member AvaliableContextsProvider = Utils.avaliableContexts - - static member InputMatricesProvider = - "Common.txt" - |> Utils.getMatricesFilenames - |> Seq.map - (fun matrixFilename -> - match Path.GetExtension matrixFilename with - | ".mtx" -> MtxReader(Utils.getFullPathToMatrix "Common" matrixFilename) - | _ -> failwith "Unsupported matrix format" - ) -*) \ No newline at end of file diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Columns.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Columns.fs new file mode 100644 index 00000000..0b2173ae --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Columns.fs @@ -0,0 +1,41 @@ +namespace GraphBLAS.FSharp.Benchmarks.Columns + +open BenchmarkDotNet.Columns +open BenchmarkDotNet.Reports +open BenchmarkDotNet.Running +open GraphBLAS.FSharp.IO + +type CommonColumn<'a>(benchmarkCaseConvert, columnName: string, getShape: 'a -> _) = + interface IColumn with + member this.AlwaysShow = true + member this.Category = ColumnCategory.Params + member this.ColumnName = columnName + + member this.GetValue(_: Summary, benchmarkCase: BenchmarkCase) = + benchmarkCaseConvert benchmarkCase + |> getShape + |> sprintf "%A" + + member this.GetValue(summary: Summary, benchmarkCase: BenchmarkCase, _: SummaryStyle) = + (this :> IColumn).GetValue(summary, benchmarkCase) + + member this.Id = sprintf $"%s{columnName}" + + member this.IsAvailable(_: Summary) = true + member this.IsDefault(_: Summary, _: BenchmarkCase) = false + member this.IsNumeric = true + member this.Legend = sprintf $"%s{columnName}" + member this.PriorityInCategory = 1 + member this.UnitType = UnitType.Size + +type MatrixColumn(name, getShape) = + inherit CommonColumn( + (fun benchmarkCase -> benchmarkCase.Parameters.["InputMatrixReader"] :?> MtxReader), + name, + getShape) + +type Matrix2Column(name, getShape) = + inherit CommonColumn( + (fun benchmarkCase -> benchmarkCase.Parameters.["InputMatrixReader"] :?> MtxReader * MtxReader), + name, + getShape) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs.fs new file mode 100644 index 00000000..8f22f19f --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs.fs @@ -0,0 +1,77 @@ +module GraphBLAS.FSharp.Benchmarks.Configs + +open BenchmarkDotNet.Columns +open BenchmarkDotNet.Toolchains.InProcess.Emit +open GraphBLAS.FSharp.IO +open BenchmarkDotNet.Configs +open BenchmarkDotNet.Jobs +open GraphBLAS.FSharp.Benchmarks.Columns + +type Matrix2() = + inherit ManualConfig() + + do + base.AddColumn( + Matrix2Column("RowCount", (fun (matrix,_) -> matrix.ReadMatrixShape().RowCount)) :> IColumn, + Matrix2Column("ColumnCount", (fun (matrix,_) -> matrix.ReadMatrixShape().ColumnCount)) :> IColumn, + Matrix2Column( + "NNZ", + fun (matrix,_) -> + match matrix.Format with + | Coordinate -> matrix.ReadMatrixShape().NNZ + | Array -> 0 + ) + :> IColumn, + Matrix2Column( + "SqrNNZ", + fun (_,matrix) -> + match matrix.Format with + | Coordinate -> matrix.ReadMatrixShape().NNZ + | Array -> 0 + ) + :> IColumn, + StatisticColumn.Min, + StatisticColumn.Max + ) + |> ignore + +type Matrix() = + inherit ManualConfig() + + do + base.AddColumn( + MatrixColumn("RowCount", (fun matrix -> matrix.ReadMatrixShape().RowCount)) :> IColumn, + MatrixColumn("ColumnCount", (fun matrix -> matrix.ReadMatrixShape().ColumnCount)) :> IColumn, + MatrixColumn( + "NNZ", + fun matrix -> + match matrix.Format with + | Coordinate -> matrix.ReadMatrixShape().NNZ + | Array -> 0 + ) + :> IColumn, + StatisticColumn.Min, + StatisticColumn.Max + ) + |> ignore + + base.AddJob( + Job + .Dry + .WithToolchain(InProcessEmitToolchain.Instance) + .WithWarmupCount(3) + .WithIterationCount(10) + .WithInvocationCount(3) + ) + |> ignore + +type MinMaxMean() = + inherit ManualConfig() + + do + base.AddColumn( + StatisticColumn.Min, + StatisticColumn.Max, + StatisticColumn.Mean + ) + |> ignore diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/SpGeMM.txt b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/SpGeMM.txt new file mode 100644 index 00000000..9a294a4a --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/SpGeMM.txt @@ -0,0 +1 @@ +hollywood-2009.mtx diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj index 689d84c0..6e8486b0 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj @@ -16,16 +16,17 @@ - - - - - - - - + + + + + + + + + \ No newline at end of file diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs index 734d9b15..6ce43002 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs @@ -1,135 +1,19 @@ namespace rec GraphBLAS.FSharp.Benchmarks -open BenchmarkDotNet.Columns -open BenchmarkDotNet.Reports -open BenchmarkDotNet.Running +namespace GraphBLAS.FSharp.Benchmarks + open Brahma.FSharp open Brahma.FSharp.OpenCL.Translator +open Brahma.FSharp.OpenCL.Translator.QuotationTransformers +open GraphBLAS.FSharp.Backend.Objects open OpenCL.Net -open GraphBLAS.FSharp.IO open System.IO open System.Text.RegularExpressions -open BenchmarkDotNet.Configs -open BenchmarkDotNet.Jobs open GraphBLAS.FSharp.Tests open FsCheck open Expecto open GraphBLAS.FSharp.Test -type CommonConfig() = - inherit ManualConfig() - - do - base.AddColumn( - MatrixShapeColumn("RowCount", (fun (mtxReader, _) -> mtxReader.ReadMatrixShape().RowCount)) :> IColumn, - MatrixShapeColumn("ColumnCount", (fun (mtxReader, _) -> mtxReader.ReadMatrixShape().ColumnCount)) :> IColumn, - MatrixShapeColumn("NNZ", (fun (mtxReader, _) -> mtxReader.ReadMatrixShape().Nnz)) :> IColumn, - MatrixShapeColumn("SqrNNZ", (fun (_, mtxReader) -> mtxReader.ReadMatrixShape().Nnz)) :> IColumn, - TEPSColumn(fun (parameters: obj) -> parameters :?> MtxReader * MtxReader |> fst) :> IColumn, - StatisticColumn.Min, - StatisticColumn.Max - ) - |> ignore - - base.AddJob( - Job - .Dry - .WithWarmupCount(3) - .WithIterationCount(10) - .WithInvocationCount(3) - ) - |> ignore - -type AlgorithmConfig() = - inherit ManualConfig() - - do - base.AddColumn( - MatrixShapeColumn("RowCount", (fun (mtxReader) -> mtxReader.ReadMatrixShape().RowCount)) :> IColumn, - MatrixShapeColumn("ColumnCount", (fun (mtxReader) -> mtxReader.ReadMatrixShape().ColumnCount)) :> IColumn, - MatrixShapeColumn("NNZ", (fun (mtxReader) -> mtxReader.ReadMatrixShape().Nnz)) :> IColumn, - TEPSColumn(fun (parameters: obj) -> parameters :?> MtxReader) :> IColumn, - StatisticColumn.Min, - StatisticColumn.Max - ) - |> ignore - - base.AddJob( - Job - .Dry - .WithWarmupCount(3) - .WithIterationCount(10) - .WithInvocationCount(3) - ) - |> ignore - -type MatrixShapeColumn<'shape>(columnName: string, getShape: 'shape -> int) = - interface IColumn with - member this.AlwaysShow: bool = true - member this.Category: ColumnCategory = ColumnCategory.Params - member this.ColumnName: string = columnName - - member this.GetValue(summary: Summary, benchmarkCase: BenchmarkCase) : string = - let inputMatrix = - benchmarkCase.Parameters.["InputMatrixReader"] :?> 'shape - - sprintf "%i" <| getShape inputMatrix - - member this.GetValue(summary: Summary, benchmarkCase: BenchmarkCase, style: SummaryStyle) : string = - (this :> IColumn).GetValue(summary, benchmarkCase) - - member this.Id: string = - sprintf "%s.%s" "MatrixShapeColumn" columnName - - member this.IsAvailable(summary: Summary) : bool = true - member this.IsDefault(summary: Summary, benchmarkCase: BenchmarkCase) : bool = false - member this.IsNumeric: bool = true - member this.Legend: string = sprintf "%s of input matrix" columnName - member this.PriorityInCategory: int = 1 - member this.UnitType: UnitType = UnitType.Size - -type TEPSColumn(getMtxReader: obj -> MtxReader) = - interface IColumn with - member this.AlwaysShow: bool = true - member this.Category: ColumnCategory = ColumnCategory.Statistics - member this.ColumnName: string = "TEPS" - - member this.GetValue(summary: Summary, benchmarkCase: BenchmarkCase) : string = - let inputMatrixReader = getMtxReader benchmarkCase.Parameters.["InputMatrixReader"] - - let matrixShape = inputMatrixReader.ReadMatrixShape() - - let (nrows, ncols) = - matrixShape.RowCount, matrixShape.ColumnCount - - let (vertices, edges) = - match inputMatrixReader.Format with - | Coordinate -> - if nrows = ncols then - (nrows, matrixShape.Nnz) - else - (ncols, nrows) - | _ -> failwith "Unsupported" - - if isNull summary.[benchmarkCase].ResultStatistics then - "NA" - else - let meanTime = - summary.[benchmarkCase].ResultStatistics.Mean - - sprintf "%f" <| float edges / (meanTime * 1e-6) - - member this.GetValue(summary: Summary, benchmarkCase: BenchmarkCase, style: SummaryStyle) : string = - (this :> IColumn).GetValue(summary, benchmarkCase) - - member this.Id: string = "TEPSColumn" - member this.IsAvailable(summary: Summary) : bool = true - member this.IsDefault(summary: Summary, benchmarkCase: BenchmarkCase) : bool = false - member this.IsNumeric: bool = true - member this.Legend: string = "Traversed edges per second" - member this.PriorityInCategory: int = 0 - member this.UnitType: UnitType = UnitType.Dimensionless - module Utils = type BenchmarkContext = { ClContext: Brahma.FSharp.ClContext @@ -154,7 +38,7 @@ module Utils = datasetsFolder matrixFilename |] - let avaliableContexts = + let availableContexts = let pathToConfig = Path.Combine [| __SOURCE_DIRECTORY__ "Configs" @@ -213,18 +97,6 @@ module Utils = .ToString() |> Platform.Custom - let deviceType = - Cl - .GetDeviceInfo(device, DeviceInfo.Type, &e) - .CastTo() - - let clDeviceType = - match deviceType with - | DeviceType.Cpu -> ClDeviceType.Cpu - | DeviceType.Gpu -> ClDeviceType.Gpu - | DeviceType.Default -> ClDeviceType.Default - | _ -> failwith "Unsupported" - let device = ClDevice.GetFirstAppropriateDevice(clPlatform) @@ -236,7 +108,6 @@ module Utils = let queue = context.QueueProvider.CreateQueue() { ClContext = context; Queue = queue }) - seq { for wgSize in workGroupSizes do for context in contexts do @@ -248,6 +119,13 @@ module Utils = random.NextBytes buffer System.BitConverter.ToSingle(buffer, 0) + let normalFloatGenerator = + (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + + let fIsEqual x y = abs (x - y) < Accuracy.medium.absolute || x.Equals y + let nextInt (random: System.Random) = random.Next() @@ -268,37 +146,8 @@ module VectorGenerator = |> pairOfVectorsOfEqualSize Arb.generate let floatPair format = - let normalFloatGenerator = - (Arb.Default.NormalFloat() - |> Arb.toGen - |> Gen.map float) - let fIsEqual x y = abs (x - y) < Accuracy.medium.absolute || x = y let createVector array = Utils.createVectorFromArray format array (fIsEqual 0.0) - pairOfVectorsOfEqualSize normalFloatGenerator createVector - -module MatrixGenerator = - let private pairOfMatricesOfEqualSizeGenerator (valuesGenerator: Gen<'a>) createMatrix = - gen { - let! nrows, ncols = Generators.dimension2DGenerator - let! matrixA = valuesGenerator |> Gen.array2DOfDim (nrows, ncols) - let! matrixB = valuesGenerator |> Gen.array2DOfDim (nrows, ncols) - return (createMatrix matrixA, createMatrix matrixB) - } - - let intPairOfEqualSizes format = - fun array -> Utils.createMatrixFromArray2D format array ((=) 0) - |> pairOfMatricesOfEqualSizeGenerator Arb.generate - - let floatPairOfEqualSizes format = - let normalFloatGenerator = - (Arb.Default.NormalFloat() - |> Arb.toGen - |> Gen.map float) - - let fIsEqual x y = abs (x - y) < Accuracy.medium.absolute || x = y - - fun array -> Utils.createMatrixFromArray2D format array (fIsEqual 0.0) - |> pairOfMatricesOfEqualSizeGenerator normalFloatGenerator + pairOfVectorsOfEqualSize Utils.normalFloatGenerator createVector diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs new file mode 100644 index 00000000..2e2582f1 --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs @@ -0,0 +1,285 @@ +namespace GraphBLAS.FSharp.Benchmarks.Matrix.Map2 + +open System.IO +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.IO +open BenchmarkDotNet.Attributes +open Brahma.FSharp +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Objects.MatrixExtensions +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Benchmarks + +[] +[] +[] +[)>] +type Benchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix: Matrix.COO<_> -> Matrix<_>) = + + let mutable funToBenchmark = None + let mutable firstMatrix = Unchecked.defaultof> + let mutable secondMatrix = Unchecked.defaultof> + let mutable firstMatrixHost = Unchecked.defaultof<_> + let mutable secondMatrixHost = Unchecked.defaultof<_> + + member val ResultMatrix = Unchecked.defaultof> with get,set + + [] + member val OclContextInfo = Unchecked.defaultof with get, set + + [] + member val InputMatrixReader = Unchecked.defaultof with get, set + + member this.OclContext: ClContext = (fst this.OclContextInfo).ClContext + member this.WorkGroupSize = snd this.OclContextInfo + + member this.Processor = + let p = (fst this.OclContextInfo).Queue + p.Error.Add(fun e -> failwithf "%A" e) + p + + static member AvailableContexts = Utils.availableContexts + + static member InputMatricesProviderBuilder pathToConfig = + let datasetFolder = "EWiseAdd" + pathToConfig + |> Utils.getMatricesFilenames + |> Seq.map + (fun matrixFilename -> + printfn "%A" matrixFilename + + match Path.GetExtension matrixFilename with + | ".mtx" -> + MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) + , MtxReader(Utils.getFullPathToMatrix datasetFolder ("squared_" + matrixFilename)) + | _ -> failwith "Unsupported matrix format") + + member this.FunToBenchmark = + match funToBenchmark with + | None -> + let x = buildFunToBenchmark this.OclContext this.WorkGroupSize + funToBenchmark <- Some x + x + | Some x -> x + + member this.ReadMatrix (reader: MtxReader) = + let converter = + match reader.Field with + | Pattern -> converterBool + | _ -> converter + + reader.ReadMatrix converter + + member this.EWiseAddition() = + this.ResultMatrix <- this.FunToBenchmark this.Processor HostInterop firstMatrix secondMatrix + + member this.ClearInputMatrices() = + firstMatrix.Dispose this.Processor + secondMatrix.Dispose this.Processor + + member this.ClearResult() = + this.ResultMatrix.Dispose this.Processor + + member this.ReadMatrices() = + firstMatrixHost <- this.ReadMatrix <| fst this.InputMatrixReader + secondMatrixHost <- this.ReadMatrix <| snd this.InputMatrixReader + + member this.LoadMatricesToGPU () = + firstMatrix <- (buildMatrix firstMatrixHost).ToDevice this.OclContext + secondMatrix <- (buildMatrix secondMatrixHost).ToDevice this.OclContext + + abstract member GlobalSetup: unit -> unit + + abstract member Benchmark: unit -> unit + + abstract member IterationCleanup: unit -> unit + + abstract member GlobalCleanup: unit -> unit + +module WithoutTransfer = + type Benchmark<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix) = + + inherit Benchmarks<'matrixT, 'elem>( + buildFunToBenchmark, + converter, + converterBool, + buildMatrix) + + [] + override this.GlobalSetup() = + this.ReadMatrices () + this.LoadMatricesToGPU () + this.Processor.PostAndReply(Msg.MsgNotifyMe) + + [] + override this.Benchmark () = + this.EWiseAddition() + this.Processor.PostAndReply(Msg.MsgNotifyMe) + + [] + override this.IterationCleanup () = + this.ClearResult() + + [] + override this.GlobalCleanup () = + this.ClearInputMatrices() + + module COO = + type Float32() = + + inherit Benchmark,float32>( + (Matrix.map2 ArithmeticOperations.float32SumOption), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + Matrix.COO + ) + + static member InputMatricesProvider = + Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + + type Bool() = + + inherit Benchmark,bool>( + (Matrix.map2 ArithmeticOperations.boolSumOption), + (fun _ -> true), + (fun _ -> true), + Matrix.COO + ) + + static member InputMatricesProvider = + Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCOO.txt" + + module CSR = + type Float32() = + + inherit Benchmark,float32>( + (Matrix.map2 ArithmeticOperations.float32SumOption), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + (fun matrix -> Matrix.CSR matrix.ToCSR) + ) + + static member InputMatricesProvider = + Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32CSR.txt" + + type Bool() = + + inherit Benchmark,bool>( + (Matrix.map2 ArithmeticOperations.boolSumOption), + (fun _ -> true), + (fun _ -> true), + (fun matrix -> Matrix.CSR matrix.ToCSR) + ) + + static member InputMatricesProvider = + Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" + + module AtLeastOne = + module COO = + type Bool() = + + inherit Benchmark,bool>( + (Matrix.map2AtLeastOne ArithmeticOperations.boolSumAtLeastOne), + (fun _ -> true), + (fun _ -> true), + Matrix.COO + ) + + static member InputMatricesProvider = + Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCOO.txt" + + type Float32() = + + inherit Benchmark,float32>( + (Matrix.map2AtLeastOne ArithmeticOperations.float32SumAtLeastOne), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + Matrix.COO + ) + + static member InputMatricesProvider = + Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + + module CSR = + type Bool() = + + inherit Benchmark,bool>( + (Matrix.map2AtLeastOne ArithmeticOperations.boolSumAtLeastOne), + (fun _ -> true), + (fun _ -> true), + (fun matrix -> Matrix.CSR matrix.ToCSR) + ) + + static member InputMatricesProvider = + Benchmarks<_, _>.InputMatricesProviderBuilder "EWiseAddBenchmarks4BoolCSR.txt" + + type Float32() = + + inherit Benchmark,float32>( + (Matrix.map2AtLeastOne ArithmeticOperations.float32SumAtLeastOne), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + (fun matrix -> Matrix.CSR matrix.ToCSR) + ) + + static member InputMatricesProvider = + Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + +module WithTransfer = + type Benchmark<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix, + resultToHost) = + + inherit Benchmarks<'matrixT, 'elem>( + buildFunToBenchmark, + converter, + converterBool, + buildMatrix) + + [] + override this.GlobalSetup() = + this.ReadMatrices() + + [] + override this.GlobalCleanup() = () + + [] + override this.IterationCleanup() = + this.ClearInputMatrices() + this.ClearResult() + + [] + override this.Benchmark() = + this.LoadMatricesToGPU() + this.EWiseAddition() + this.Processor.PostAndReply Msg.MsgNotifyMe + resultToHost this.ResultMatrix this.Processor |> ignore + this.Processor.PostAndReply Msg.MsgNotifyMe + + module COO = + type Float32() = + + inherit Benchmark,float32>( + (Matrix.map2 ArithmeticOperations.float32SumOption), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + Matrix.COO, + (fun matrix -> matrix.ToHost) + ) + + static member InputMatricesProvider = + Benchmarks<_,_>.InputMatricesProviderBuilder "EWiseAddBenchmarks4Float32COO.txt" + diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMathNET.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/MathNET.fs similarity index 88% rename from benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMathNET.fs rename to benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/MathNET.fs index a2d8a564..b0577154 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMathNET.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/MathNET.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Benchmarks +namespace GraphBLAS.FSharp.Benchmarks.Matrix.Map2 open System.IO open GraphBLAS.FSharp.Objects @@ -7,12 +7,13 @@ open BenchmarkDotNet.Attributes open MathNet.Numerics.LinearAlgebra open MathNet.Numerics open Microsoft.FSharp.Core +open GraphBLAS.FSharp.Benchmarks [] [] [] -[)>] -type MathNETBenchmark<'elem when 'elem: struct and 'elem :> System.IEquatable<'elem> and 'elem :> System.IFormattable and 'elem :> System.ValueType and 'elem: (new : +[)>] +type MathNET<'elem when 'elem: struct and 'elem :> System.IEquatable<'elem> and 'elem :> System.IFormattable and 'elem :> System.ValueType and 'elem: (new : unit -> 'elem)>(converter: string -> 'elem, converterBool) = do Control.UseNativeMKL() @@ -35,8 +36,8 @@ type MathNETBenchmark<'elem when 'elem: struct and 'elem :> System.IEquatable<'e | Pattern -> converterBool | _ -> converter - let gbMatrix = reader.ReadMatrix converter - MathNETBenchmark<_>.COOMatrixToMathNETSparse gbMatrix + Matrix.COO (reader.ReadMatrix converter) + |> MathNET<_>.COOMatrixToMathNETSparse abstract member GlobalSetup : unit -> unit @@ -46,7 +47,7 @@ type MathNETBenchmark<'elem when 'elem: struct and 'elem :> System.IEquatable<'e type BinOpMathNETBenchmark<'elem when 'elem: struct and 'elem :> System.IEquatable<'elem> and 'elem :> System.IFormattable and 'elem :> System.ValueType and 'elem: (new : unit -> 'elem)>(funToBenchmark, converter: string -> 'elem, converterBool) = - inherit MathNETBenchmark<'elem>(converter, converterBool) + inherit MathNET<'elem>(converter, converterBool) let mutable firstMatrix = Unchecked.defaultof> let mutable secondMatrix = Unchecked.defaultof> diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs new file mode 100644 index 00000000..3f1751af --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs @@ -0,0 +1,147 @@ +module GraphBLAS.FSharp.Benchmarks.Matrix.SpGeMM.Expand + +open System.IO +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.IO +open BenchmarkDotNet.Attributes +open Brahma.FSharp +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Benchmarks +open GraphBLAS.FSharp.Backend + +[] +[] +[] +[)>] +type Benchmarks<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix) = + + let mutable funToBenchmark = None + + let mutable firstMatrix = Unchecked.defaultof> + let mutable secondMatrix = Unchecked.defaultof> + + let mutable firstMatrixHost = Unchecked.defaultof<_> + let mutable secondMatrixHost = Unchecked.defaultof<_> + + member val ResultMatrix = Unchecked.defaultof> with get, set + + [] + member val OclContextInfo = Unchecked.defaultof with get, set + + [] + member val InputMatrixReader = Unchecked.defaultof with get, set + + member this.OclContext:ClContext = (fst this.OclContextInfo).ClContext + member this.WorkGroupSize = snd this.OclContextInfo + + member this.Processor = + let p = (fst this.OclContextInfo).Queue + p.Error.Add(fun e -> failwithf "%A" e) + p + + static member AvailableContexts = Utils.availableContexts + + static member InputMatrixProviderBuilder pathToConfig = + let datasetFolder = "" + pathToConfig + |> Utils.getMatricesFilenames + |> Seq.map + (fun matrixFilename -> + printfn "%A" matrixFilename + + match Path.GetExtension matrixFilename with + | ".mtx" -> + MtxReader(Utils.getFullPathToMatrix datasetFolder matrixFilename) + | _ -> failwith "Unsupported matrix format") + + member this.FunToBenchmark = + match funToBenchmark with + | None -> + let x = buildFunToBenchmark this.OclContext this.WorkGroupSize + funToBenchmark <- Some x + x + | Some x -> x + + member this.ReadMatrix (reader: MtxReader) = + let converter = + match reader.Field with + | Pattern -> converterBool + | _ -> converter + + reader.ReadMatrix converter + + member this.Mxm() = + this.ResultMatrix <- this.FunToBenchmark this.Processor DeviceOnly firstMatrix secondMatrix + + member this.ClearInputMatrices() = + firstMatrix.Dispose this.Processor + secondMatrix.Dispose this.Processor + + member this.ClearResult() = + this.ResultMatrix.Dispose this.Processor + + member this.ReadMatrices() = + firstMatrixHost <- this.ReadMatrix this.InputMatrixReader + secondMatrixHost <- this.ReadMatrix this.InputMatrixReader + + member this.LoadMatricesToGPU () = + firstMatrix <- buildMatrix this.OclContext firstMatrixHost + secondMatrix <- buildMatrix this.OclContext secondMatrixHost + + abstract member GlobalSetup : unit -> unit + + abstract member Benchmark : unit -> unit + + abstract member IterationCleanup : unit -> unit + + abstract member GlobalCleanup : unit -> unit + +module WithoutTransfer = + type Benchmark<'elem when 'elem : struct>( + buildFunToBenchmark, + converter: string -> 'elem, + converterBool, + buildMatrix) = + + inherit Benchmarks<'elem>( + buildFunToBenchmark, + converter, + converterBool, + buildMatrix) + + [] + override this.GlobalSetup() = + this.ReadMatrices() + this.LoadMatricesToGPU() + + [] + override this.Benchmark() = + this.Mxm() + this.Processor.PostAndReply(Msg.MsgNotifyMe) + + [] + override this.IterationCleanup () = + this.ClearResult() + + [] + override this.GlobalCleanup () = + this.ClearInputMatrices() + + type Float32() = + + inherit Benchmark( + Matrix.SpGeMM.expand (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul), + float32, + (fun _ -> Utils.nextSingle (System.Random())), + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) + ) + + static member InputMatrixProvider = + Benchmarks<_>.InputMatrixProviderBuilder "SpGeMM.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs similarity index 68% rename from benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs rename to benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs index dd5d7673..2a164021 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksMxm.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs @@ -1,20 +1,22 @@ -namespace GraphBLAS.FSharp.Benchmarks +namespace GraphBLAS.FSharp.Benchmarks.Matrix.SpGeMM open System.IO +open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.IO open BenchmarkDotNet.Attributes open Brahma.FSharp open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Matrix -open GraphBLAS.FSharp.Benchmarks.MatrixExtensions open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Benchmarks +open GraphBLAS.FSharp.Backend [] [] [] -[)>] -type MxmBenchmarks<'elem when 'elem : struct>( +[)>] +type Masked<'elem when 'elem : struct>( buildFunToBenchmark, converter: string -> 'elem, converterBool, @@ -48,7 +50,7 @@ type MxmBenchmarks<'elem when 'elem : struct>( p.Error.Add(fun e -> failwithf "%A" e) p - static member AvaliableContexts = Utils.avaliableContexts + static member AvaliableContexts = Utils.availableContexts static member InputMatrixProviderBuilder pathToConfig = let datasetFolder = "Mxm" @@ -75,7 +77,7 @@ type MxmBenchmarks<'elem when 'elem : struct>( member this.FunCSR2CSC = match funCSR2CSC with | None -> - let x = Matrix.toCSCInplace this.OclContext this.WorkGroupSize + let x = Matrix.toCSCInPlace this.OclContext this.WorkGroupSize funCSR2CSC <- Some x x | Some x -> x @@ -83,12 +85,12 @@ type MxmBenchmarks<'elem when 'elem : struct>( member this.FunCSC2CSR = match funCSC2CSR with | None -> - let x = Matrix.toCSRInplace this.OclContext this.WorkGroupSize + let x = Matrix.toCSRInPlace this.OclContext this.WorkGroupSize funCSC2CSR <- Some x x | Some x -> x - member this.ReadMatrix (reader:MtxReader) = + member this.ReadMatrix (reader: MtxReader) = let converter = match reader.Field with | Pattern -> converterBool @@ -108,7 +110,7 @@ type MxmBenchmarks<'elem when 'elem : struct>( this.ResultMatrix.Dispose this.Processor member this.ReadMask(maskReader) = - maskHost <- this.ReadMatrix maskReader + maskHost <- Matrix.COO <| this.ReadMatrix maskReader member this.ReadMatrices() = let matrixReader, maskReader = this.InputMatrixReader @@ -129,19 +131,19 @@ type MxmBenchmarks<'elem when 'elem : struct>( abstract member GlobalSetup : unit -> unit + abstract member Benchmark : unit -> unit + abstract member IterationCleanup : unit -> unit abstract member GlobalCleanup : unit -> unit - abstract member Benchmark : unit -> unit - type MxmBenchmarksMultiplicationOnly<'elem when 'elem : struct>( buildFunToBenchmark, converter: string -> 'elem, converterBool, buildMatrix) = - inherit MxmBenchmarks<'elem>( + inherit Masked<'elem>( buildFunToBenchmark, converter, converterBool, @@ -153,6 +155,11 @@ type MxmBenchmarksMultiplicationOnly<'elem when 'elem : struct>( this.LoadMatricesToGPU () this.ConvertSecondMatrixToCSC() + [] + override this.Benchmark () = + this.Mxm() + this.Processor.PostAndReply(Msg.MsgNotifyMe) + [] override this.IterationCleanup () = this.ClearResult() @@ -161,139 +168,107 @@ type MxmBenchmarksMultiplicationOnly<'elem when 'elem : struct>( override this.GlobalCleanup () = this.ClearInputMatrices() - [] - override this.Benchmark () = - this.Mxm() - this.Processor.PostAndReply(Msg.MsgNotifyMe) - type MxmBenchmarksWithTransposing<'elem when 'elem : struct>( buildFunToBenchmark, converter: string -> 'elem, converterBool, buildMatrix) = - inherit MxmBenchmarks<'elem>( + inherit Masked<'elem>( buildFunToBenchmark, converter, converterBool, buildMatrix) [] - override this.GlobalSetup () = - this.ReadMatrices () + override this.GlobalSetup() = + this.ReadMatrices() this.LoadMatricesToGPU () - [] - override this.GlobalCleanup () = - this.ClearInputMatrices() - - [] - override this.IterationCleanup () = - this.ClearResult() - this.ConvertSecondMatrixToCSR() - [] - override this.Benchmark () = + override this.Benchmark() = this.ConvertSecondMatrixToCSC() this.Mxm() this.Processor.PostAndReply(Msg.MsgNotifyMe) -module Operations = - let add = <@ fun x y -> Some (x + y) @> - - let addWithFilter = <@ fun x y -> - let res = x + y - if abs res < 1e-8f then None else Some res - @> - - let mult = <@ fun x y -> Some (x * y) @> - let logicalOr = <@ fun x y -> - let mutable res = None - - match x, y with - | false, false -> res <- None - | _ -> res <- Some true - - res @> - - let logicalAnd = <@ fun x y -> - let mutable res = None - - match x, y with - | true, true -> res <- Some true - | _ -> res <- None + [] + override this.IterationCleanup() = + this.ClearResult() + this.ConvertSecondMatrixToCSR() - res @> + [] + override this.GlobalCleanup() = + this.ClearInputMatrices() -type MxmBenchmarks4Float32MultiplicationOnly() = +type Mxm4Float32MultiplicationOnlyBenchmark() = inherit MxmBenchmarksMultiplicationOnly( - (Matrix.SpGeMM.masked Operations.add Operations.mult), + Matrix.SpGeMM.masked (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul), float32, (fun _ -> Utils.nextSingle (System.Random())), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) ) static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" + Masked<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" -type MxmBenchmarks4Float32WithTransposing() = +type Mxm4Float32WithTransposingBenchmark() = inherit MxmBenchmarksWithTransposing( - (Matrix.SpGeMM.masked Operations.add Operations.mult), + Matrix.SpGeMM.masked (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul), float32, (fun _ -> Utils.nextSingle (System.Random())), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) ) static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" + Masked<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" -type MxmBenchmarks4BoolMultiplicationOnly() = +type Mxm4BoolMultiplicationOnlyBenchmark() = inherit MxmBenchmarksMultiplicationOnly( - (Matrix.SpGeMM.masked Operations.logicalOr Operations.logicalAnd), + (Matrix.SpGeMM.masked (fst ArithmeticOperations.boolAdd) (fst ArithmeticOperations.boolMul)), (fun _ -> true), (fun _ -> true), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) ) static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Bool.txt" + Masked<_>.InputMatrixProviderBuilder "MxmBenchmarks4Bool.txt" -type MxmBenchmarks4BoolWithTransposing() = +type Mxm4BoolWithTransposingBenchmark() = inherit MxmBenchmarksWithTransposing( - (Matrix.SpGeMM.masked Operations.logicalOr Operations.logicalAnd), + (Matrix.SpGeMM.masked (fst ArithmeticOperations.boolAdd) (fst ArithmeticOperations.boolMul)), (fun _ -> true), (fun _ -> true), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) ) static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Bool.txt" + Masked<_>.InputMatrixProviderBuilder "MxmBenchmarks4Bool.txt" -type MxmBenchmarks4Float32MultiplicationOnlyWithZerosFilter() = +type Mxm4Float32MultiplicationOnlyWithZerosFilterBenchmark() = inherit MxmBenchmarksMultiplicationOnly( - (Matrix.SpGeMM.masked Operations.addWithFilter Operations.mult), + (Matrix.SpGeMM.masked (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul)), float32, (fun _ -> Utils.nextSingle (System.Random())), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) ) static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" + Masked<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" -type MxmBenchmarks4Float32WithTransposingWithZerosFilter() = +type Mxm4Float32WithTransposingWithZerosFilterBenchmark() = inherit MxmBenchmarksWithTransposing( - (Matrix.SpGeMM.masked Operations.addWithFilter Operations.mult), + Matrix.SpGeMM.masked (fst ArithmeticOperations.float32Add) (fst ArithmeticOperations.float32Mul), float32, (fun _ -> Utils.nextSingle (System.Random())), - (fun context matrix -> ClMatrix.CSR (Matrix.ToBackendCSR context matrix)) + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context) ) static member InputMatrixProvider = - MxmBenchmarks<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" + Masked<_>.InputMatrixProviderBuilder "MxmBenchmarks4Float32.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/MatrixExtensions.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/MatrixExtensions.fs deleted file mode 100644 index ed84bcee..00000000 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/MatrixExtensions.fs +++ /dev/null @@ -1,91 +0,0 @@ -namespace GraphBLAS.FSharp.Benchmarks - -open GraphBLAS.FSharp.Objects -open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Objects.ClMatrix - -module MatrixExtensions = - type Matrix<'a when 'a : struct> with - static member ToBackendCOO (context: ClContext) matrix = - match matrix with - | Matrix.COO m -> - let rows = - context.CreateClArray( - m.Rows, - hostAccessMode = HostAccessMode.ReadOnly, - deviceAccessMode = DeviceAccessMode.ReadOnly, - allocationMode = AllocationMode.CopyHostPtr - ) - - let cols = - context.CreateClArray( - m.Columns, - hostAccessMode = HostAccessMode.ReadOnly, - deviceAccessMode = DeviceAccessMode.ReadOnly, - allocationMode = AllocationMode.CopyHostPtr - ) - - let vals = - context.CreateClArray( - m.Values, - hostAccessMode = HostAccessMode.ReadOnly, - deviceAccessMode = DeviceAccessMode.ReadOnly, - allocationMode = AllocationMode.CopyHostPtr - ) - - { Context = context - RowCount = m.RowCount - ColumnCount = m.ColumnCount - Rows = rows - Columns = cols - Values = vals } - - | _ -> failwith "Unsupported matrix format: %A" - - static member ToBackendCSR (context: ClContext) matrix = - let rowIndices2rowPointers (rowIndices: int []) rowCount = - let nnzPerRow = Array.zeroCreate rowCount - let rowPointers = Array.zeroCreate rowCount - - Array.iter (fun rowIndex -> nnzPerRow.[rowIndex] <- nnzPerRow.[rowIndex] + 1) rowIndices - - for i in 1 .. rowCount - 1 do - rowPointers.[i] <- rowPointers.[i - 1] + nnzPerRow.[i - 1] - - rowPointers - - match matrix with - | Matrix.COO m -> - let rowPointers = - context.CreateClArray( - rowIndices2rowPointers m.Rows m.RowCount, - hostAccessMode = HostAccessMode.ReadOnly, - deviceAccessMode = DeviceAccessMode.ReadOnly, - allocationMode = AllocationMode.CopyHostPtr - ) - - let cols = - context.CreateClArray( - m.Columns, - hostAccessMode = HostAccessMode.ReadOnly, - deviceAccessMode = DeviceAccessMode.ReadOnly, - allocationMode = AllocationMode.CopyHostPtr - ) - - let vals = - context.CreateClArray( - m.Values, - hostAccessMode = HostAccessMode.ReadOnly, - deviceAccessMode = DeviceAccessMode.ReadOnly, - allocationMode = AllocationMode.CopyHostPtr - ) - - { Context = context - RowCount = m.RowCount - ColumnCount = m.ColumnCount - RowPointers = rowPointers - Columns = cols - Values = vals } - - | _ -> failwith "Unsupported matrix format: %A" - diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs index 20749b67..5a3ccf37 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs @@ -4,7 +4,7 @@ open BenchmarkDotNet.Running [] let main argv = let benchmarks = - BenchmarkSwitcher [| typeof |] + BenchmarkSwitcher [| typeof |] benchmarks.Run argv |> ignore 0 diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs new file mode 100644 index 00000000..523f5185 --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs @@ -0,0 +1,201 @@ +module GraphBLAS.FSharp.Benchmarks.Vector.Map2 + +open FsCheck +open BenchmarkDotNet.Attributes + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Benchmarks +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.ClVectorExtensions +open GraphBLAS.FSharp.Backend.Vector +open GraphBLAS.FSharp.Backend.Objects.ClContext + +[] +[] +[] +[)>] +type Benchmarks<'elem when 'elem : struct>( + buildFunToBenchmark, + generator: Gen * Vector<'elem>>) = + + let mutable funToBenchmark = None + + let mutable firstVector = Unchecked.defaultof> + + let mutable secondVector = Unchecked.defaultof> + + member val HostVectorPair = Unchecked.defaultof * Vector<'elem>> with get, set + + member val ResultVector = Unchecked.defaultof> with get,set + + [] + member val OclContextInfo = Unchecked.defaultof with get, set + + [] + member val Size = Unchecked.defaultof with get, set + + member this.OclContext: ClContext = (fst this.OclContextInfo).ClContext + member this.WorkGroupSize = snd this.OclContextInfo + + member this.Processor = + let p = (fst this.OclContextInfo).Queue + p.Error.Add(fun e -> failwithf $"%A{e}") + p + + static member AvailableContexts = Utils.availableContexts + + member this.FunToBenchmark = + match funToBenchmark with + | None -> + let x = buildFunToBenchmark this.OclContext this.WorkGroupSize + funToBenchmark <- Some x + x + | Some x -> x + + member this.Map2() = + try + + this.ResultVector <- this.FunToBenchmark this.Processor HostInterop firstVector secondVector + + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex + + member this.ClearInputVectors()= + firstVector.Dispose this.Processor + secondVector.Dispose this.Processor + + member this.ClearResult() = + this.ResultVector.Dispose this.Processor + + member this.CreateVectors() = + this.HostVectorPair <- List.last (Gen.sample this.Size 1 generator) + + member this.LoadVectorsToGPU() = + firstVector <- (fst this.HostVectorPair).ToDevice this.OclContext + secondVector <- (snd this.HostVectorPair).ToDevice this.OclContext + + abstract member GlobalSetup: unit -> unit + + abstract member IterationSetup: unit -> unit + + abstract member Benchmark: unit -> unit + + abstract member IterationCleanup: unit -> unit + + abstract member GlobalCleanup: unit -> unit + +module WithoutTransfer = + type Benchmark<'elem when 'elem : struct>( + buildFunToBenchmark, + generator) = + + inherit Benchmarks<'elem>( + buildFunToBenchmark, + generator) + + [] + override this.GlobalSetup() = () + + [] + override this.IterationSetup() = + this.CreateVectors() + this.LoadVectorsToGPU() + this.Processor.PostAndReply Msg.MsgNotifyMe + + [] + override this.Benchmark() = + this.Map2() + this.Processor.PostAndReply Msg.MsgNotifyMe + + [] + override this.IterationCleanup() = + this.ClearResult() + this.ClearInputVectors() + + [] + override this.GlobalCleanup() = () + + type Float() = + + inherit Benchmark( + (Vector.map2 ArithmeticOperations.floatSumOption), + VectorGenerator.floatPair Sparse) + + type Int32() = + + inherit Benchmark( + (Vector.map2 ArithmeticOperations.intSumOption), + VectorGenerator.intPair Sparse) + + module AtLeastOne = + type Float() = + + inherit Benchmark( + (Vector.map2AtLeastOne ArithmeticOperations.floatSumAtLeastOne), + VectorGenerator.floatPair Sparse) + + type Int32() = + + inherit Benchmark( + (Vector.map2AtLeastOne ArithmeticOperations.intSumAtLeastOne), + VectorGenerator.intPair Sparse) + +module WithTransfer = + type Benchmark<'elem when 'elem : struct>( + buildFunToBenchmark, + generator) = + + inherit Benchmarks<'elem>( + buildFunToBenchmark, + generator) + + [] + override this.GlobalSetup() = () + + [] + override this.IterationSetup() = + this.CreateVectors() + + [] + override this.Benchmark () = + this.LoadVectorsToGPU() + this.Map2() + this.ResultVector.ToHost this.Processor |> ignore + this.Processor.PostAndReply Msg.MsgNotifyMe + + [] + override this.IterationCleanup () = + this.ClearInputVectors() + this.ClearResult() + + [] + override this.GlobalCleanup() = () + + type Float() = + + inherit Benchmark( + (Vector.map2 ArithmeticOperations.floatSumOption), + VectorGenerator.floatPair Sparse) + + type Int32() = + + inherit Benchmark( + (Vector.map2 ArithmeticOperations.intSumOption), + VectorGenerator.intPair Sparse) + + module AtLeastOne = + type Float() = + + inherit Benchmark( + (Vector.map2AtLeastOne ArithmeticOperations.floatSumAtLeastOne), + VectorGenerator.floatPair Sparse) + + type Int32() = + + inherit Benchmark( + (Vector.map2AtLeastOne ArithmeticOperations.intSumAtLeastOne), + VectorGenerator.intPair Sparse) diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs deleted file mode 100644 index 97d75077..00000000 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/VectorEWiseAddGen.fs +++ /dev/null @@ -1,211 +0,0 @@ -namespace GraphBLAS.FSharp.Benchmarks - -open Expecto -open FsCheck -open BenchmarkDotNet.Attributes -open BenchmarkDotNet.Configs -open BenchmarkDotNet.Columns -open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Quotes -open GraphBLAS.FSharp.Tests -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Objects.ClVectorExtensions -open GraphBLAS.FSharp.Backend.Vector -open GraphBLAS.FSharp.Backend.Objects.ClContext - -type VectorConfig() = - inherit ManualConfig() - - do - base.AddColumn( - StatisticColumn.Min, - StatisticColumn.Max - ) - |> ignore - -[] -[] -[] -[)>] -type VectorEWiseBenchmarks<'elem when 'elem : struct>( - buildFunToBenchmark, - generator: Gen * Vector<'elem>>) = - - let mutable funToBenchmark = None - - let mutable firstVector = Unchecked.defaultof> - - let mutable secondVector = Unchecked.defaultof> - - member val HostVectorPair = Unchecked.defaultof * Vector<'elem>> with get, set - - member val ResultVector = Unchecked.defaultof> with get,set - - [] - member val OclContextInfo = Unchecked.defaultof with get, set - - [] - member val Size = Unchecked.defaultof with get, set - - member this.OclContext: ClContext = (fst this.OclContextInfo).ClContext - member this.WorkGroupSize = snd this.OclContextInfo - - member this.Processor = - let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) - p - - static member AvaliableContexts = Utils.avaliableContexts - - member this.FunToBenchmark = - match funToBenchmark with - | None -> - let x = buildFunToBenchmark this.OclContext this.WorkGroupSize - funToBenchmark <- Some x - x - | Some x -> x - - member this.EWiseAddition() = - this.ResultVector <- this.FunToBenchmark this.Processor HostInterop firstVector secondVector - - member this.ClearInputVectors()= - firstVector.Dispose this.Processor - secondVector.Dispose this.Processor - - member this.ClearResult() = - this.ResultVector.Dispose this.Processor - - member this.CreateVectors() = - this.HostVectorPair <- List.last (Gen.sample this.Size 1 generator) - - member this.LoadVectorsToGPU() = - firstVector <- (fst this.HostVectorPair).ToDevice this.OclContext - secondVector <- (snd this.HostVectorPair).ToDevice this.OclContext - - abstract member GlobalSetup : unit -> unit - - abstract member IterationSetup: unit -> unit - - abstract member Benchmark : unit -> unit - - abstract member IterationCleanup : unit -> unit - - abstract member GlobalCleanup : unit -> unit - - -type VectorEWiseBenchmarksWithoutDataTransfer<'elem when 'elem : struct>( - buildFunToBenchmark, - generator) = - - inherit VectorEWiseBenchmarks<'elem>( - buildFunToBenchmark, - generator) - - [] - override this.GlobalSetup() = () - - [] - override this.IterationSetup() = - this.CreateVectors () - this.LoadVectorsToGPU () - - [] - override this.Benchmark () = - this.EWiseAddition() - this.Processor.PostAndReply(Msg.MsgNotifyMe) - - [] - override this.IterationCleanup () = - this.ClearResult() - this.ClearInputVectors() - - [] - override this.GlobalCleanup() = () - -type VectorEWiseBenchmarksWithDataTransfer<'elem when 'elem : struct>( - buildFunToBenchmark, - generator) = - - inherit VectorEWiseBenchmarks<'elem>( - buildFunToBenchmark, - generator) - - [] - override this.GlobalSetup() = () - - [] - override this.IterationSetup() = - this.CreateVectors() - - [] - override this.Benchmark () = - this.LoadVectorsToGPU() - this.EWiseAddition() - this.Processor.PostAndReply Msg.MsgNotifyMe - this.ResultVector.ToHost this.Processor |> ignore - this.Processor.PostAndReply Msg.MsgNotifyMe - - [] - override this.IterationCleanup () = - this.ClearInputVectors() - this.ClearResult() - - [] - override this.GlobalCleanup() = () - -/// Without data transfer -/// AtLeastOne -type VectorEWiseBenchmarks4FloatSparseWithoutDataTransfer() = - - inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), - VectorGenerator.floatPair Sparse) - -type VectorEWiseBenchmarks4Int32SparseWithoutDataTransfer() = - - inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), - VectorGenerator.intPair Sparse) - -/// General - -type VectorEWiseGeneralBenchmarks4FloatSparseWithoutDataTransfer() = - - inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), - VectorGenerator.floatPair Sparse) - -type VectorEWiseGeneralBenchmarks4Int32SparseWithoutDataTransfer() = - - inherit VectorEWiseBenchmarksWithoutDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), - VectorGenerator.intPair Sparse) - -/// With data transfer - -type VectorEWiseBenchmarks4FloatSparseWithDataTransfer() = - - inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), - VectorGenerator.floatPair Sparse) - -type VectorEWiseBenchmarks4Int32SparseWithDataTransfer() = - - inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), - VectorGenerator.intPair Sparse) - -/// General with data transfer - -type VectorEWiseGeneralBenchmarks4FloatSparseWithDataTransfer() = - - inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.floatSumOption), - VectorGenerator.floatPair Sparse) - -type VectorEWiseGeneralBenchmarks4Int32SparseWithDataTransfer() = - - inherit VectorEWiseBenchmarksWithDataTransfer( - (fun context -> Vector.map2 context ArithmeticOperations.intSumOption), - VectorGenerator.intPair Sparse) diff --git a/paket.dependencies b/paket.dependencies index c1c5211c..a434e23e 100644 --- a/paket.dependencies +++ b/paket.dependencies @@ -59,4 +59,4 @@ group Docs group Analyzers source https://www.nuget.org/api/v2 source https://api.nuget.org/v3/index.json - nuget BinaryDefense.FSharp.Analyzers.Hashing 0.2.2 + nuget BinaryDefense.FSharp.Analyzers.Hashing 0.2.2 \ No newline at end of file diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs b/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs index 4dbb9ba4..9896a557 100644 --- a/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs +++ b/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs @@ -14,14 +14,14 @@ open GraphBLAS.FSharp.Backend.Objects.ClCell module BFS = let singleSource - (clContext: ClContext) (add: Expr int option -> int option>) (mul: Expr<'a option -> int option -> int option>) + (clContext: ClContext) workGroupSize = let spMVTo = - SpMV.runTo clContext add mul workGroupSize + SpMV.runTo add mul clContext workGroupSize let zeroCreate = ClArray.zeroCreate clContext workGroupSize @@ -29,13 +29,13 @@ module BFS = let ofList = Vector.ofList clContext workGroupSize let maskComplementedTo = - DenseVector.map2Inplace clContext Mask.complementedOp workGroupSize + Vector.map2InPlace Mask.complementedOp clContext workGroupSize let fillSubVectorTo = - DenseVector.assignByMaskInplace clContext (Convert.assignToOption Mask.assign) workGroupSize + Vector.assignByMaskInPlace (Convert.assignToOption Mask.assign) clContext workGroupSize let containsNonZero = - ClArray.exists clContext workGroupSize Predicates.isSome + ClArray.exists Predicates.isSome clContext workGroupSize fun (queue: MailboxProcessor) (matrix: ClMatrix.CSR<'a>) (source: int) -> let vertexCount = matrix.RowCount diff --git a/src/GraphBLAS-sharp.Backend/COOVector/AssignSubVector.fs b/src/GraphBLAS-sharp.Backend/COOVector/AssignSubVector.fs deleted file mode 100644 index 83667528..00000000 --- a/src/GraphBLAS-sharp.Backend/COOVector/AssignSubVector.fs +++ /dev/null @@ -1,45 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.COOVector - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.COOVector.Utilities -open GraphBLAS.FSharp.Backend.COOVector.Utilities.AssignSubVector - -module internal AssignSubVector = - let private runNotEmpty - (leftIndices: int []) - (leftValues: 'a []) - (rightIndices: int []) - (rightValues: 'a []) - (maskIndices: int []) - : ClTask = - opencl { - let! bitmap, maskValues = intersect rightIndices rightValues maskIndices - - let! resultIndices, resultValues, rawPositions = filter leftIndices leftValues maskIndices maskValues bitmap - - let! rawPositions = preparePositions resultIndices rawPositions - - return! setPositions resultIndices resultValues rawPositions - } - - let run - (leftIndices: int []) - (leftValues: 'a []) - (rightIndices: int []) - (rightValues: 'a []) - (maskIndices: int []) - : ClTask = - if leftValues.Length = 0 then - opencl { - let! resultIndices = Copy.copyArray rightIndices - let! resultValues = Copy.copyArray rightValues - - return resultIndices, resultValues - } - - elif rightIndices.Length = 0 then - opencl { return leftIndices, leftValues } - - else - runNotEmpty leftIndices leftValues rightIndices rightValues maskIndices diff --git a/src/GraphBLAS-sharp.Backend/COOVector/EWiseAdd.fs b/src/GraphBLAS-sharp.Backend/COOVector/EWiseAdd.fs deleted file mode 100644 index 791670e3..00000000 --- a/src/GraphBLAS-sharp.Backend/COOVector/EWiseAdd.fs +++ /dev/null @@ -1,52 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.COOVector - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp -open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.COOVector.Utilities -open GraphBLAS.FSharp.Backend.COOVector.Utilities.EWiseAdd - -module internal EWiseAdd = - let private runNonEmpty - (leftIndices: int []) - (leftValues: 'a []) - (rightIndices: int []) - (rightValues: 'a []) - (mask: Mask1D option) - (semiring: ISemiring<'a>) - : ClTask = - opencl { - let! allIndices, allValues = merge leftIndices leftValues rightIndices rightValues mask - - let (ClosedBinaryOp plus) = semiring.Plus - let! rawPositions = preparePositions allIndices allValues plus - - return! setPositions allIndices allValues rawPositions - } - - let run - (leftIndices: int []) - (leftValues: 'a []) - (rightIndices: int []) - (rightValues: 'a []) - (mask: Mask1D option) - (semiring: ISemiring<'a>) - : ClTask = - if leftValues.Length = 0 then - opencl { - let! resultIndices = Copy.copyArray rightIndices - let! resultValues = Copy.copyArray rightValues - - return resultIndices, resultValues - } - - elif rightIndices.Length = 0 then - opencl { - let! resultIndices = Copy.copyArray leftIndices - let! resultValues = Copy.copyArray leftValues - - return resultIndices, resultValues - } - - else - runNonEmpty leftIndices leftValues rightIndices rightValues mask semiring diff --git a/src/GraphBLAS-sharp.Backend/COOVector/FillSubVector.fs b/src/GraphBLAS-sharp.Backend/COOVector/FillSubVector.fs deleted file mode 100644 index f28a20f7..00000000 --- a/src/GraphBLAS-sharp.Backend/COOVector/FillSubVector.fs +++ /dev/null @@ -1,36 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.COOVector - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.COOVector.Utilities -open GraphBLAS.FSharp.Backend.COOVector.Utilities.FillSubVector - -module internal FillSubVector = - let private runNotEmpty - (leftIndices: int []) - (leftValues: 'a []) - (rightIndices: int []) - (scalar: 'a []) - : ClTask = - opencl { - let! allIndices, allValues = merge leftIndices leftValues rightIndices scalar - - let! rawPositions = preparePositions allIndices - - return! setPositions allIndices allValues rawPositions - } - - let run (leftIndices: int []) (leftValues: 'a []) (rightIndices: int []) (scalar: 'a []) : ClTask = - if leftValues.Length = 0 then - opencl { - let! resultIndices = Copy.copyArray rightIndices - let! resultValues = Replicate.run rightIndices.Length scalar - - return resultIndices, resultValues - } - - elif rightIndices.Length = 0 then - opencl { return leftIndices, leftValues } - - else - runNotEmpty leftIndices leftValues rightIndices scalar diff --git a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/AssignSubVector/Filter.fs b/src/GraphBLAS-sharp.Backend/COOVector/Utilities/AssignSubVector/Filter.fs deleted file mode 100644 index 8d2daae1..00000000 --- a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/AssignSubVector/Filter.fs +++ /dev/null @@ -1,161 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.COOVector.Utilities.AssignSubVector - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp.Backend.Common - -[] -module internal Filter = - let filter - (leftIndices: int []) - (leftValues: 'a []) - (rightIndices: int []) - (rightValues: 'a []) - (bitmap: bool []) - : ClTask = - opencl { - let workGroupSize = Utils.defaultWorkGroupSize - let firstSide = leftValues.Length - let secondSide = rightIndices.Length - let sumOfSides = firstSide + secondSide - - let merge = - <@ fun (ndRange: Range1D) (firstIndicesBuffer: int []) (firstValuesBuffer: 'a []) (secondIndicesBuffer: int []) (secondValuesBuffer: 'a []) (bitmapBuffer: bool []) (allIndicesBuffer: int []) (allValuesBuffer: 'a []) (rawPositionsBuffer: int []) -> - - let i = ndRange.GlobalID0 - - let mutable beginIdxLocal = local () - let mutable endIdxLocal = local () - let localID = ndRange.LocalID0 - - if localID < 2 then - let mutable x = localID * (workGroupSize - 1) + i - 1 - - if x >= sumOfSides then - x <- sumOfSides - 1 - - let diagonalNumber = x - - let mutable leftEdge = diagonalNumber + 1 - secondSide - if leftEdge < 0 then leftEdge <- 0 - - let mutable rightEdge = firstSide - 1 - - if rightEdge > diagonalNumber then - rightEdge <- diagonalNumber - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = firstIndicesBuffer.[middleIdx] - - let secondIndex = - secondIndicesBuffer.[diagonalNumber - middleIdx] - - if firstIndex <= secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 - - // Here localID equals either 0 or 1 - if localID = 0 then - beginIdxLocal <- leftEdge - else - endIdxLocal <- leftEdge - - barrier () - - let beginIdx = beginIdxLocal - let endIdx = endIdxLocal - let firstLocalLength = endIdx - beginIdx - let mutable x = workGroupSize - firstLocalLength - - if endIdx = firstSide then - x <- secondSide - i + localID + beginIdx - - let secondLocalLength = x - - //First indices are from 0 to firstLocalLength - 1 inclusive - //Second indices are from firstLocalLength to firstLocalLength + secondLocalLength - 1 inclusive - let localIndices = localArray workGroupSize - - if localID < firstLocalLength then - localIndices.[localID] <- firstIndicesBuffer.[beginIdx + localID] - - if localID < secondLocalLength then - localIndices.[firstLocalLength + localID] <- secondIndicesBuffer.[i - beginIdx] - - barrier () - - if i < sumOfSides then - let mutable leftEdge = localID + 1 - secondLocalLength - if leftEdge < 0 then leftEdge <- 0 - - let mutable rightEdge = firstLocalLength - 1 - - if rightEdge > localID then - rightEdge <- localID - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = localIndices.[middleIdx] - - let secondIndex = - localIndices.[firstLocalLength + localID - middleIdx] - - if firstIndex <= secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 - - let boundaryX = rightEdge - let boundaryY = localID - leftEdge - - // boundaryX and boundaryY can't be off the right edge of array (only off the left edge) - let isValidX = boundaryX >= 0 - let isValidY = boundaryY >= 0 - - let mutable fstIdx = 0 - - if isValidX then - fstIdx <- localIndices.[boundaryX] - - let mutable sndIdx = 0 - - if isValidY then - sndIdx <- localIndices.[firstLocalLength + boundaryY] - - if not isValidX || isValidY && fstIdx <= sndIdx then - allIndicesBuffer.[i] <- sndIdx - - if bitmapBuffer.[i - localID - beginIdx + boundaryY] then - allValuesBuffer.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] - else - rawPositionsBuffer.[i] <- 0 - else - allIndicesBuffer.[i] <- fstIdx - allValuesBuffer.[i] <- firstValuesBuffer.[beginIdx + boundaryX] @> - - let resultValues = - Array.create sumOfSides Unchecked.defaultof<'a> - - let resultIndices = Array.zeroCreate sumOfSides - let rawPositions = Array.create sumOfSides 1 - - do! - runCommand merge - <| fun kernelPrepare -> - let ndRange = - Range1D(Utils.getDefaultGlobalSize sumOfSides, workGroupSize) - - kernelPrepare - ndRange - leftIndices - leftValues - rightIndices - rightValues - bitmap - resultIndices - resultValues - rawPositions - - return resultIndices, resultValues, rawPositions - } diff --git a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/AssignSubVector/Intersect.fs b/src/GraphBLAS-sharp.Backend/COOVector/Utilities/AssignSubVector/Intersect.fs deleted file mode 100644 index 78e562af..00000000 --- a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/AssignSubVector/Intersect.fs +++ /dev/null @@ -1,140 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.COOVector.Utilities.AssignSubVector - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp.Backend.Common - -[] -module internal Intersect = - let intersect (leftIndices: int []) (leftValues: 'a []) (rightIndices: int []) : ClTask = - opencl { - let workGroupSize = Utils.defaultWorkGroupSize - let firstSide = leftValues.Length - let secondSide = rightIndices.Length - let sumOfSides = firstSide + secondSide - - let merge = - <@ fun (ndRange: Range1D) (firstIndicesBuffer: int []) (firstValuesBuffer: 'a []) (secondIndicesBuffer: int []) (bitmapBuffer: bool []) (resultValuesBuffer: 'a []) -> - - let i = ndRange.GlobalID0 - - let mutable beginIdxLocal = local () - let mutable endIdxLocal = local () - let localID = ndRange.LocalID0 - - if localID < 2 then - let mutable x = localID * (workGroupSize - 1) + i - 1 - - if x >= sumOfSides then - x <- sumOfSides - 1 - - let diagonalNumber = x - - let mutable leftEdge = diagonalNumber + 1 - secondSide - if leftEdge < 0 then leftEdge <- 0 - - let mutable rightEdge = firstSide - 1 - - if rightEdge > diagonalNumber then - rightEdge <- diagonalNumber - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = firstIndicesBuffer.[middleIdx] - - let secondIndex = - secondIndicesBuffer.[diagonalNumber - middleIdx] - - if firstIndex < secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 - - // Here localID equals either 0 or 1 - if localID = 0 then - beginIdxLocal <- leftEdge - else - endIdxLocal <- leftEdge - - barrier () - - let beginIdx = beginIdxLocal - let endIdx = endIdxLocal - let firstLocalLength = endIdx - beginIdx - let mutable x = workGroupSize - firstLocalLength - - if endIdx = firstSide then - x <- secondSide - i + localID + beginIdx - - let secondLocalLength = x - - //First indices are from 0 to firstLocalLength - 1 inclusive - //Second indices are from firstLocalLength to firstLocalLength + secondLocalLength - 1 inclusive - let localIndices = localArray workGroupSize - - if localID < firstLocalLength then - localIndices.[localID] <- firstIndicesBuffer.[beginIdx + localID] - - if localID < secondLocalLength then - localIndices.[firstLocalLength + localID] <- secondIndicesBuffer.[i - beginIdx] - - barrier () - - if i < sumOfSides then - let mutable leftEdge = localID + 1 - secondLocalLength - if leftEdge < 0 then leftEdge <- 0 - - let mutable rightEdge = firstLocalLength - 1 - - if rightEdge > localID then - rightEdge <- localID - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = localIndices.[middleIdx] - - let secondIndex = - localIndices.[firstLocalLength + localID - middleIdx] - - if firstIndex < secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 - - let boundaryX = rightEdge - let boundaryY = localID - leftEdge - - // boundaryX and boundaryY can't be off the right edge of array (only off the left edge) - let isValidX = boundaryX >= 0 - let isValidY = boundaryY >= 0 - - let mutable fstIdx = 0 - - if isValidX then - fstIdx <- localIndices.[boundaryX] - - let mutable sndIdx = 0 - - if isValidY then - sndIdx <- localIndices.[firstLocalLength + boundaryY] - - if not isValidX || isValidY && fstIdx = sndIdx then - bitmapBuffer.[i - localID - beginIdx + boundaryY] <- true - - resultValuesBuffer.[i - localID - beginIdx + boundaryY] <- - firstValuesBuffer.[beginIdx + boundaryX] @> - - let bitmap = Array.zeroCreate secondSide - - let resultValues = - Array.create secondSide Unchecked.defaultof<'a> - - do! - runCommand merge - <| fun kernelPrepare -> - let ndRange = - Range1D(Utils.getDefaultGlobalSize sumOfSides, workGroupSize) - - kernelPrepare ndRange leftIndices leftValues rightIndices bitmap resultValues - - return bitmap, resultValues - } diff --git a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/AssignSubVector/PreparePositions.fs b/src/GraphBLAS-sharp.Backend/COOVector/Utilities/AssignSubVector/PreparePositions.fs deleted file mode 100644 index 19c97e64..00000000 --- a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/AssignSubVector/PreparePositions.fs +++ /dev/null @@ -1,30 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.COOVector.Utilities.AssignSubVector - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp.Backend.Common - -[] -module internal PreparePositions = - let preparePositions (allIndices: int []) (rawPositions: int []) : ClTask = - opencl { - let length = allIndices.Length - - let preparePositions = - <@ fun (ndRange: Range1D) (allIndicesBuffer: int []) (rawPositionsBuffer: int []) -> - - let i = ndRange.GlobalID0 - - if i < length - 1 - && allIndicesBuffer.[i] = allIndicesBuffer.[i + 1] then - rawPositionsBuffer.[i] <- 0 @> - - do! - runCommand preparePositions - <| fun kernelPrepare -> - let ndRange = - Range1D(Utils.getDefaultGlobalSize (length - 1), Utils.defaultWorkGroupSize) - - kernelPrepare ndRange allIndices rawPositions - - return rawPositions - } diff --git a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/EWiseAdd/Merge.fs b/src/GraphBLAS-sharp.Backend/COOVector/Utilities/EWiseAdd/Merge.fs deleted file mode 100644 index 0a654596..00000000 --- a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/EWiseAdd/Merge.fs +++ /dev/null @@ -1,148 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.COOVector.Utilities.EWiseAdd - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp -open GraphBLAS.FSharp.Backend.Common - -[] -module internal Merge = - let merge - (leftIndices: int []) - (leftValues: 'a []) - (rightIndices: int []) - (rightValues: 'a []) - (mask: Mask1D option) - : ClTask = - opencl { - let workGroupSize = Utils.defaultWorkGroupSize - let firstSide = leftValues.Length - let secondSide = rightValues.Length - let sumOfSides = firstSide + secondSide - - let merge = - <@ fun (ndRange: Range1D) (firstIndicesBuffer: int []) (firstValuesBuffer: 'a []) (secondIndicesBuffer: int []) (secondValuesBuffer: 'a []) (allIndicesBuffer: int []) (allValuesBuffer: 'a []) -> - - let i = ndRange.GlobalID0 - - let mutable beginIdxLocal = local () - let mutable endIdxLocal = local () - let localID = ndRange.LocalID0 - - if localID < 2 then - let mutable x = localID * (workGroupSize - 1) + i - 1 - - if x >= sumOfSides then - x <- sumOfSides - 1 - - let diagonalNumber = x - - let mutable leftEdge = diagonalNumber + 1 - secondSide - if leftEdge < 0 then leftEdge <- 0 - - let mutable rightEdge = firstSide - 1 - - if rightEdge > diagonalNumber then - rightEdge <- diagonalNumber - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = firstIndicesBuffer.[middleIdx] - - let secondIndex = - secondIndicesBuffer.[diagonalNumber - middleIdx] - - if firstIndex < secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 - - // Here localID equals either 0 or 1 - if localID = 0 then - beginIdxLocal <- leftEdge - else - endIdxLocal <- leftEdge - - barrier () - - let beginIdx = beginIdxLocal - let endIdx = endIdxLocal - let firstLocalLength = endIdx - beginIdx - let mutable x = workGroupSize - firstLocalLength - - if endIdx = firstSide then - x <- secondSide - i + localID + beginIdx - - let secondLocalLength = x - - //First indices are from 0 to firstLocalLength - 1 inclusive - //Second indices are from firstLocalLength to firstLocalLength + secondLocalLength - 1 inclusive - let localIndices = localArray workGroupSize - - if localID < firstLocalLength then - localIndices.[localID] <- firstIndicesBuffer.[beginIdx + localID] - - if localID < secondLocalLength then - localIndices.[firstLocalLength + localID] <- secondIndicesBuffer.[i - beginIdx] - - barrier () - - if i < sumOfSides then - let mutable leftEdge = localID + 1 - secondLocalLength - if leftEdge < 0 then leftEdge <- 0 - - let mutable rightEdge = firstLocalLength - 1 - - if rightEdge > localID then - rightEdge <- localID - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = localIndices.[middleIdx] - - let secondIndex = - localIndices.[firstLocalLength + localID - middleIdx] - - if firstIndex < secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 - - let boundaryX = rightEdge - let boundaryY = localID - leftEdge - - // boundaryX and boundaryY can't be off the right edge of array (only off the left edge) - let isValidX = boundaryX >= 0 - let isValidY = boundaryY >= 0 - - let mutable fstIdx = 0 - - if isValidX then - fstIdx <- localIndices.[boundaryX] - - let mutable sndIdx = 0 - - if isValidY then - sndIdx <- localIndices.[firstLocalLength + boundaryY] - - if not isValidX || isValidY && fstIdx < sndIdx then - allIndicesBuffer.[i] <- sndIdx - allValuesBuffer.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] - else - allIndicesBuffer.[i] <- fstIdx - allValuesBuffer.[i] <- firstValuesBuffer.[beginIdx + boundaryX] @> - - let allIndices = Array.zeroCreate sumOfSides - - let allValues = - Array.create sumOfSides Unchecked.defaultof<'a> - - do! - runCommand merge - <| fun kernelPrepare -> - let ndRange = - Range1D(Utils.getDefaultGlobalSize sumOfSides, workGroupSize) - - kernelPrepare ndRange leftIndices leftValues rightIndices rightValues allIndices allValues - - return allIndices, allValues - } diff --git a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/EWiseAdd/PreparePositions.fs b/src/GraphBLAS-sharp.Backend/COOVector/Utilities/EWiseAdd/PreparePositions.fs deleted file mode 100644 index 08fc688b..00000000 --- a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/EWiseAdd/PreparePositions.fs +++ /dev/null @@ -1,40 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.COOVector.Utilities.EWiseAdd - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp.Backend.Common -open Microsoft.FSharp.Quotations - -[] -module internal PreparePositions = - let preparePositions (allIndices: int []) (allValues: 'a []) (plus: Expr<'a -> 'a -> 'a>) : ClTask = - opencl { - let length = allValues.Length - - let preparePositions = - <@ fun (ndRange: Range1D) (allIndicesBuffer: int []) (allValuesBuffer: 'a []) (rawPositionsBuffer: int []) -> - - let i = ndRange.GlobalID0 - - if i < length - 1 - && allIndicesBuffer.[i] = allIndicesBuffer.[i + 1] then - rawPositionsBuffer.[i] <- 0 - - //Do not drop explicit zeroes - allValuesBuffer.[i + 1] <- (%plus) allValuesBuffer.[i] allValuesBuffer.[i + 1] @> - - //Drop explicit zeroes - // let localResultBuffer = (%plus) allValuesBuffer.[i] allValuesBuffer.[i + 1] - // if localResultBuffer = zero then rawPositionsBuffer.[i + 1] <- 0 else allValuesBuffer.[i + 1] <- localResultBuffer - - let rawPositions = Array.create length 1 - - do! - runCommand preparePositions - <| fun kernelPrepare -> - let ndRange = - Range1D(Utils.getDefaultGlobalSize (length - 1), Utils.defaultWorkGroupSize) - - kernelPrepare ndRange allIndices allValues rawPositions - - return rawPositions - } diff --git a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/FillSubVector/Merge.fs b/src/GraphBLAS-sharp.Backend/COOVector/Utilities/FillSubVector/Merge.fs deleted file mode 100644 index 1c561e16..00000000 --- a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/FillSubVector/Merge.fs +++ /dev/null @@ -1,147 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.COOVector.Utilities.FillSubVector - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp -open GraphBLAS.FSharp.Backend.Common - -[] -module internal Merge = - let merge - (leftIndices: int []) - (leftValues: 'a []) - (rightIndices: int []) - (scalar: 'a []) - : ClTask = - opencl { - let workGroupSize = Utils.defaultWorkGroupSize - let firstSide = leftValues.Length - let secondSide = rightIndices.Length - let sumOfSides = firstSide + secondSide - - let merge = - <@ fun (ndRange: Range1D) (firstIndicesBuffer: int []) (firstValuesBuffer: 'a []) (secondIndicesBuffer: int []) (scalarBuffer: 'a []) (allIndicesBuffer: int []) (allValuesBuffer: 'a []) -> - - let i = ndRange.GlobalID0 - - let mutable beginIdxLocal = local () - let mutable endIdxLocal = local () - let localID = ndRange.LocalID0 - - if localID < 2 then - let mutable x = localID * (workGroupSize - 1) + i - 1 - - if x >= sumOfSides then - x <- sumOfSides - 1 - - let diagonalNumber = x - - let mutable leftEdge = diagonalNumber + 1 - secondSide - if leftEdge < 0 then leftEdge <- 0 - - let mutable rightEdge = firstSide - 1 - - if rightEdge > diagonalNumber then - rightEdge <- diagonalNumber - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = firstIndicesBuffer.[middleIdx] - - let secondIndex = - secondIndicesBuffer.[diagonalNumber - middleIdx] - - if firstIndex <= secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 - - // Here localID equals either 0 or 1 - if localID = 0 then - beginIdxLocal <- leftEdge - else - endIdxLocal <- leftEdge - - barrier () - - let beginIdx = beginIdxLocal - let endIdx = endIdxLocal - let firstLocalLength = endIdx - beginIdx - let mutable x = workGroupSize - firstLocalLength - - if endIdx = firstSide then - x <- secondSide - i + localID + beginIdx - - let secondLocalLength = x - - //First indices are from 0 to firstLocalLength - 1 inclusive - //Second indices are from firstLocalLength to firstLocalLength + secondLocalLength - 1 inclusive - let localIndices = localArray workGroupSize - - if localID < firstLocalLength then - localIndices.[localID] <- firstIndicesBuffer.[beginIdx + localID] - - if localID < secondLocalLength then - localIndices.[firstLocalLength + localID] <- secondIndicesBuffer.[i - beginIdx] - - barrier () - - if i < sumOfSides then - let mutable leftEdge = localID + 1 - secondLocalLength - if leftEdge < 0 then leftEdge <- 0 - - let mutable rightEdge = firstLocalLength - 1 - - if rightEdge > localID then - rightEdge <- localID - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = localIndices.[middleIdx] - - let secondIndex = - localIndices.[firstLocalLength + localID - middleIdx] - - if firstIndex <= secondIndex then - leftEdge <- middleIdx + 1 - else - rightEdge <- middleIdx - 1 - - let boundaryX = rightEdge - let boundaryY = localID - leftEdge - - // boundaryX and boundaryY can't be off the right edge of array (only off the left edge) - let isValidX = boundaryX >= 0 - let isValidY = boundaryY >= 0 - - let mutable fstIdx = 0 - - if isValidX then - fstIdx <- localIndices.[boundaryX] - - let mutable sndIdx = 0 - - if isValidY then - sndIdx <- localIndices.[firstLocalLength + boundaryY] - - if not isValidX || isValidY && fstIdx <= sndIdx then - allIndicesBuffer.[i] <- sndIdx - allValuesBuffer.[i] <- scalarBuffer.[0] - else - allIndicesBuffer.[i] <- fstIdx - allValuesBuffer.[i] <- firstValuesBuffer.[beginIdx + boundaryX] @> - - let allIndices = Array.zeroCreate sumOfSides - - let allValues = - Array.create sumOfSides Unchecked.defaultof<'a> - - do! - runCommand merge - <| fun kernelPrepare -> - let ndRange = - Range1D(Utils.getDefaultGlobalSize sumOfSides, workGroupSize) - - kernelPrepare ndRange leftIndices leftValues rightIndices scalar allIndices allValues - - return allIndices, allValues - } diff --git a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/FillSubVector/PreparePositions.fs b/src/GraphBLAS-sharp.Backend/COOVector/Utilities/FillSubVector/PreparePositions.fs deleted file mode 100644 index 14803f5d..00000000 --- a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/FillSubVector/PreparePositions.fs +++ /dev/null @@ -1,32 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.COOVector.Utilities.FillSubVector - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp.Backend.Common - -[] -module internal PreparePositions = - let preparePositions (allIndices: int []) : ClTask = - opencl { - let length = allIndices.Length - - let preparePositions = - <@ fun (ndRange: Range1D) (allIndicesBuffer: int []) (rawPositionsBuffer: int []) -> - - let i = ndRange.GlobalID0 - - if i < length - 1 - && allIndicesBuffer.[i] = allIndicesBuffer.[i + 1] then - rawPositionsBuffer.[i] <- 0 @> - - let rawPositions = Array.create length 1 - - do! - runCommand preparePositions - <| fun kernelPrepare -> - let ndRange = - Range1D(Utils.getDefaultGlobalSize (length - 1), Utils.defaultWorkGroupSize) - - kernelPrepare ndRange allIndices rawPositions - - return rawPositions - } diff --git a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/SetPositions.fs b/src/GraphBLAS-sharp.Backend/COOVector/Utilities/SetPositions.fs deleted file mode 100644 index c63a3f6a..00000000 --- a/src/GraphBLAS-sharp.Backend/COOVector/Utilities/SetPositions.fs +++ /dev/null @@ -1,48 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.COOVector.Utilities - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp.Backend.Common - -[] -module internal SetPositions = - let setPositions (allIndices: int []) (allValues: 'a []) (positions: int []) : ClTask = - opencl { - let prefixSumArrayLength = positions.Length - - let setPositions = - <@ fun (ndRange: Range1D) (allIndicesBuffer: int []) (allValuesBuffer: 'a []) (prefixSumArrayBuffer: int []) (resultIndicesBuffer: int []) (resultValuesBuffer: 'a []) -> - - let i = ndRange.GlobalID0 - - if i = prefixSumArrayLength - 1 - || i < prefixSumArrayLength - && prefixSumArrayBuffer.[i] - <> prefixSumArrayBuffer.[i + 1] then - let index = prefixSumArrayBuffer.[i] - - resultIndicesBuffer.[index] <- allIndicesBuffer.[i] - resultValuesBuffer.[index] <- allValuesBuffer.[i] @> - - let resultLength = Array.zeroCreate 1 - - - failwith "FIX ME! And rewrite." - //do! PrefixSum.runExcludeInplace positions resultLength - //let! _ = ToHost resultLength - let resultLength = resultLength.[0] - - let resultIndices = Array.zeroCreate resultLength - - let resultValues = - Array.create resultLength Unchecked.defaultof<'a> - - do! - runCommand setPositions - <| fun kernelPrepare -> - let ndRange = - Range1D(Utils.getDefaultGlobalSize positions.Length, Utils.defaultWorkGroupSize) - - kernelPrepare ndRange allIndices allValues positions resultIndices resultValues - - return resultIndices, resultValues - } diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index 5db339a7..b104ca55 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -1,5 +1,6 @@ namespace GraphBLAS.FSharp.Backend.Common +open System.Collections.Generic open Brahma.FSharp open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects.ClContext @@ -9,7 +10,7 @@ open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend.Quotes module ClArray = - let init (clContext: ClContext) workGroupSize (initializer: Expr 'a>) = + let init (initializer: Expr 'a>) (clContext: ClContext) workGroupSize = let init = <@ fun (range: Range1D) (outputBuffer: ClArray<'a>) (length: int) -> @@ -189,7 +190,7 @@ module ClArray = getUniqueBitmapLastOccurrence clContext workGroupSize let prefixSumExclude = - PrefixSum.runExcludeInplace <@ (+) @> clContext workGroupSize + PrefixSum.runExcludeInPlace <@ (+) @> clContext workGroupSize fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> @@ -209,7 +210,7 @@ module ClArray = outputArray - let exists (clContext: ClContext) workGroupSize (predicate: Expr<'a -> bool>) = + let exists (predicate: Expr<'a -> bool>) (clContext: ClContext) workGroupSize = let exists = <@ fun (ndRange: Range1D) length (vector: ClArray<'a>) (result: ClCell) -> @@ -238,7 +239,7 @@ module ClArray = result - let map<'a, 'b> (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b>) = + let map<'a, 'b> (op: Expr<'a -> 'b>) (clContext: ClContext) workGroupSize = let map = <@ fun (ndRange: Range1D) lenght (inputArray: ClArray<'a>) (result: ClArray<'b>) -> @@ -266,7 +267,7 @@ module ClArray = result - let map2Inplace<'a, 'b, 'c> (clContext: ClContext) workGroupSize (map: Expr<'a -> 'b -> 'c>) = + let map2InPlace<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c>) (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) length (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) (resultArray: ClArray<'c>) -> @@ -293,9 +294,9 @@ module ClArray = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - let map2<'a, 'b, 'c> (clContext: ClContext) workGroupSize map = + let map2<'a, 'b, 'c> map (clContext: ClContext) workGroupSize = let map2 = - map2Inplace<'a, 'b, 'c> clContext workGroupSize map + map2InPlace<'a, 'b, 'c> map clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) -> @@ -309,7 +310,7 @@ module ClArray = let getUniqueBitmap2General<'a when 'a: equality> getUniqueBitmap (clContext: ClContext) workGroupSize = let map = - map2 clContext workGroupSize <@ fun x y -> x ||| y @> + map2 <@ fun x y -> x ||| y @> clContext workGroupSize let firstGetBitmap = getUniqueBitmap clContext workGroupSize @@ -334,7 +335,7 @@ module ClArray = let getUniqueBitmap2LastOccurrence clContext = getUniqueBitmap2General getUniqueBitmapLastOccurrence clContext - let private assignOption (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b option>) = + let assignOption (op: Expr<'a -> 'b option>) (clContext: ClContext) workGroupSize = let assign = <@ fun (ndRange: Range1D) length (values: ClArray<'a>) (positions: ClArray) (result: ClArray<'b>) resultLength -> @@ -370,16 +371,15 @@ module ClArray = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - let choose<'a, 'b> (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b option>) = + let choose<'a, 'b> (predicate: Expr<'a -> 'b option>) (clContext: ClContext) workGroupSize = let getBitmap = - map<'a, int> clContext workGroupSize - <| Map.chooseBitmap predicate + map<'a, int> (Map.chooseBitmap predicate) clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize let assignValues = - assignOption clContext workGroupSize predicate + assignOption predicate clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (sourceValues: ClArray<'a>) -> @@ -390,14 +390,21 @@ module ClArray = (prefixSum processor positions) .ToHostAndFree(processor) - let result = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + if resultLength = 0 then + positions.Free processor - assignValues processor sourceValues positions result + None + else + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - result + assignValues processor sourceValues positions result - let assignOption2 (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b -> 'c option>) = + positions.Free processor + + Some result + + let assignOption2 (op: Expr<'a -> 'b -> 'c option>) (clContext: ClContext) workGroupSize = let assign = <@ fun (ndRange: Range1D) length (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (positions: ClArray) (result: ClArray<'c>) resultLength -> @@ -444,16 +451,15 @@ module ClArray = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - let choose2 (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b -> 'c option>) = + let choose2 (predicate: Expr<'a -> 'b -> 'c option>) (clContext: ClContext) workGroupSize = let getBitmap = - map2<'a, 'b, int> clContext workGroupSize - <| Map.chooseBitmap2 predicate + map2<'a, 'b, int> (Map.choose2Bitmap predicate) clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize let assignValues = - assignOption2 clContext workGroupSize predicate + assignOption2 predicate clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) -> @@ -470,3 +476,221 @@ module ClArray = assignValues processor firstValues secondValues positions result result + + let sub (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) startIndex count (sourceArray: ClArray<'a>) (targetChunk: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + + if gid < count then + let sourcePosition = gid + startIndex + + targetChunk.[gid] <- sourceArray.[sourcePosition] @> + + let kernel = clContext.Compile kernel + + fun (processor: MailboxProcessor<_>) allocationMode (sourceArray: ClArray<'a>) startIndex count -> + if count <= 0 then + failwith "Count must be greater than zero" + + if startIndex < 0 then + failwith "startIndex must be greater then zero" + + if startIndex + count > sourceArray.Length then + failwith "startIndex and count sum is larger than the size of the array" + + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, count) + + let ndRange = + Range1D.CreateValid(count, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange startIndex count sourceArray result)) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + result + + /// + /// Lazy divides the input array into chunks of size at most chunkSize. + /// + /// Cl context. + /// Work group size. + /// + /// Since calculations are performed lazily, the array should not change. + /// + let lazyChunkBySize (clContext: ClContext) workGroupSize = + + let sub = sub clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode chunkSize (sourceArray: ClArray<'a>) -> + if chunkSize <= 0 then + failwith "The size of the chunk cannot be less than 1" + + let chunkCount = (sourceArray.Length - 1) / chunkSize + 1 + + let sub = sub processor allocationMode sourceArray + + seq { + for i in 0 .. chunkCount - 1 do + let startIndex = i * chunkSize + + let count = + min chunkSize (sourceArray.Length - startIndex) + + yield lazy (sub startIndex count) + } + + /// + /// Divides the input array into chunks of size at most chunkSize. + /// + /// Cl context. + /// Work group size. + let chunkBySize (clContext: ClContext) workGroupSize = + + let chunkBySizeLazy = lazyChunkBySize clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode chunkSize (sourceArray: ClArray<'a>) -> + chunkBySizeLazy processor allocationMode chunkSize sourceArray + |> Seq.map (fun lazyValue -> lazyValue.Value) + |> Seq.toArray + + let blit<'a> (clContext: ClContext) workGroupSize = + + let assign = + <@ fun (ndRange: Range1D) sourceIndex (sourceArray: ClArray<'a>) (targetArray: ClArray<'a>) targetPosition count -> + + let gid = ndRange.GlobalID0 + + if gid < count then + let readPosition = gid + sourceIndex + let writePosition = gid + targetPosition + + targetArray.[writePosition] <- sourceArray.[readPosition] @> + + let kernel = clContext.Compile assign + + fun (processor: MailboxProcessor<_>) (sourceArray: ClArray<'a>) sourceIndex (targetArray: ClArray<'a>) targetIndex count -> + if count = 0 then + // nothing to do + () + else + if count < 0 then + failwith "Count must be greater than zero" + + if sourceIndex < 0 + && sourceIndex + count >= sourceArray.Length then + failwith "The source index does not match" + + if targetIndex < 0 + && targetIndex + count >= targetArray.Length then + failwith "The target index does not match" + + let ndRange = + Range1D.CreateValid(targetArray.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> kernel.KernelFunc ndRange sourceIndex sourceArray targetArray targetIndex count) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + let concat (clContext: ClContext) workGroupSize = + + let blit = blit clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (sourceArrays: ClArray<'a> seq) -> + + let resultLength = + sourceArrays + |> Seq.sumBy (fun array -> array.Length) + + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + // write each array to result + Seq.fold + (fun previousLength (array: ClArray<_>) -> + blit processor array 0 result previousLength array.Length + previousLength + array.Length) + 0 + sourceArrays + |> ignore + + result + + let fill (clContext: ClContext) workGroupSize = + + let fill = + <@ fun (ndRange: Range1D) firstPosition count (value: ClCell<'a>) (targetArray: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + let writePosition = gid + firstPosition + + if gid < count then + targetArray.[writePosition] <- value.Value @> + + let kernel = clContext.Compile fill + + fun (processor: MailboxProcessor<_>) value firstPosition count (targetArray: ClArray<'a>) -> + if count = 0 then + () + else + if count < 0 then + failwith "Count must be greater than zero" + + if firstPosition + count > targetArray.Length then + failwith "The array should fit completely" + + let ndRange = + Range1D.CreateValid(count, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange firstPosition count value targetArray) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + let pairwise (clContext: ClContext) workGroupSize = + + let idGather = + Gather.runInit Map.id clContext workGroupSize + + let incGather = + Gather.runInit Map.inc clContext workGroupSize + + let map = + map2 <@ fun first second -> (first, second) @> clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) -> + if values.Length > 1 then + let resultLength = values.Length - 1 + + let firstItems = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + idGather processor values firstItems + + let secondItems = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + incGather processor values secondItems + + let result = + map processor allocationMode firstItems secondItems + + firstItems.Free processor + secondItems.Free processor + + Some result + else + None diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs index c4f1fa19..791c88de 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Gather.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -29,7 +29,6 @@ module internal Gather = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - /// /// Creates a new array obtained from positions replaced with values from the given array at these positions (indices). /// diff --git a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs index 3e030589..09cdfb5d 100644 --- a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs @@ -144,7 +144,7 @@ module PrefixSum = && localID < workGroupSize - 1 then resultBuffer.[i] <- resultLocalBuffer.[localID + 1] @> - let private runInplace (mirror: bool) scan (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = + let private runInPlace (opAdd: Expr<'a -> 'a -> 'a>) (mirror: bool) scan (clContext: ClContext) workGroupSize = let scan = scan opAdd clContext workGroupSize @@ -200,13 +200,13 @@ module PrefixSum = totalSum - let runExcludeInplace plus = runInplace false scanExclusive plus + let runExcludeInPlace plus = runInPlace plus false scanExclusive - let runIncludeInplace plus = runInplace false scanInclusive plus + let runIncludeInPlace plus = runInPlace plus false scanInclusive - let runBackwardsExcludeInplace plus = runInplace true scanExclusive plus + let runBackwardsExcludeInPlace plus = runInPlace plus true scanExclusive - let runBackwardsIncludeInplace plus = runInplace true scanInclusive plus + let runBackwardsIncludeInPlace plus = runInPlace plus true scanInclusive /// /// Exclude inplace prefix sum. @@ -222,13 +222,14 @@ module PrefixSum = /// > val sum = [| 4 |] /// /// + ///ClContext. ///Should be a power of 2 and greater than 1. ///Associative binary operation. ///Zero element for binary operation. - let standardExcludeInplace (clContext: ClContext) workGroupSize = + let standardExcludeInPlace (clContext: ClContext) workGroupSize = let scan = - runExcludeInplace <@ (+) @> clContext workGroupSize + runExcludeInPlace <@ (+) @> clContext workGroupSize fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> @@ -248,20 +249,21 @@ module PrefixSum = /// > val sum = [| 4 |] /// /// + ///ClContext. ///Should be a power of 2 and greater than 1. ///Associative binary operation. ///Zero element for binary operation. - let standardIncludeInplace (clContext: ClContext) workGroupSize = + let standardIncludeInPlace (clContext: ClContext) workGroupSize = let scan = - runIncludeInplace <@ (+) @> clContext workGroupSize + runIncludeInPlace <@ (+) @> clContext workGroupSize fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> scan processor inputArray 0 module ByKey = - let private sequentialSegments opWrite (clContext: ClContext) workGroupSize opAdd zero = + let private sequentialSegments opWrite opAdd zero (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) lenght uniqueKeysCount (values: ClArray<'a>) (keys: ClArray) (offsets: ClArray) -> @@ -313,8 +315,7 @@ module PrefixSum = /// > val result = [| 0; 0; 1; 2; 0; 1 |] /// /// - let sequentialExclude clContext = - sequentialSegments (Map.fst ()) clContext + let sequentialExclude op = sequentialSegments (Map.fst ()) op /// /// Include scan by key. @@ -327,5 +328,4 @@ module PrefixSum = /// > val result = [| 1; 1; 2; 3; 1; 2 |] /// /// - let sequentialInclude clContext = - sequentialSegments (Map.snd ()) clContext + let sequentialInclude op = sequentialSegments (Map.snd ()) op diff --git a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs index 6bc24183..29f9e26a 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs @@ -7,8 +7,6 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -type Indices = ClArray - module Radix = // the number of bits considered per iteration let defaultBitCount = 4 @@ -36,7 +34,7 @@ module Radix = let bitCount = mask + 1 let kernel = - <@ fun (ndRange: Range1D) length (indices: Indices) (workGroupCount: ClCell) (shift: ClCell) (globalOffsets: Indices) (localOffsets: Indices) -> + <@ fun (ndRange: Range1D) length (indices: ClArray) (workGroupCount: ClCell) (shift: ClCell) (globalOffsets: ClArray) (localOffsets: ClArray) -> let gid = ndRange.GlobalID0 let lid = ndRange.LocalID0 @@ -77,7 +75,7 @@ module Radix = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (indices: Indices) (clWorkGroupCount: ClCell) (shift: ClCell) -> + fun (processor: MailboxProcessor<_>) (indices: ClArray) (clWorkGroupCount: ClCell) (shift: ClCell) -> let ndRange = Range1D.CreateValid(indices.Length, workGroupSize) @@ -113,7 +111,7 @@ module Radix = let scatter (clContext: ClContext) workGroupSize mask = let kernel = - <@ fun (ndRange: Range1D) length (keys: Indices) (shift: ClCell) (workGroupCount: ClCell) (globalOffsets: Indices) (localOffsets: Indices) (result: ClArray) -> + <@ fun (ndRange: Range1D) length (keys: ClArray) (shift: ClCell) (workGroupCount: ClCell) (globalOffsets: ClArray) (localOffsets: ClArray) (result: ClArray) -> let gid = ndRange.GlobalID0 let wgId = gid / workGroupSize @@ -134,7 +132,7 @@ module Radix = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (keys: Indices) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: Indices) (localOffsets: Indices) (result: ClArray) -> + fun (processor: MailboxProcessor<_>) (keys: ClArray) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: ClArray) (localOffsets: ClArray) (result: ClArray) -> let ndRange = Range1D.CreateValid(keys.Length, workGroupSize) @@ -157,11 +155,11 @@ module Radix = let count = count clContext workGroupSize mask let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize let scatter = scatter clContext workGroupSize mask - fun (processor: MailboxProcessor<_>) (keys: Indices) -> + fun (processor: MailboxProcessor<_>) (keys: ClArray) -> if keys.Length <= 1 then copy processor DeviceOnly keys // TODO(allocation mode) else @@ -203,7 +201,7 @@ module Radix = let scatterByKey (clContext: ClContext) workGroupSize mask = let kernel = - <@ fun (ndRange: Range1D) length (keys: Indices) (values: ClArray<'a>) (shift: ClCell) (workGroupCount: ClCell) (globalOffsets: Indices) (localOffsets: Indices) (resultKeys: ClArray) (resultValues: ClArray<'a>) -> + <@ fun (ndRange: Range1D) length (keys: ClArray) (values: ClArray<'a>) (shift: ClCell) (workGroupCount: ClCell) (globalOffsets: ClArray) (localOffsets: ClArray) (resultKeys: ClArray) (resultValues: ClArray<'a>) -> let gid = ndRange.GlobalID0 let wgId = gid / workGroupSize @@ -225,7 +223,7 @@ module Radix = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (keys: Indices) (values: ClArray<'a>) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: Indices) (localOffsets: Indices) (resultKeys: ClArray) (resultValues: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) (keys: ClArray) (values: ClArray<'a>) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: ClArray) (localOffsets: ClArray) (resultKeys: ClArray) (resultValues: ClArray<'a>) -> let ndRange = Range1D.CreateValid(keys.Length, workGroupSize) @@ -260,12 +258,12 @@ module Radix = let count = count clContext workGroupSize mask let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize let scatterByKey = scatterByKey clContext workGroupSize mask - fun (processor: MailboxProcessor<_>) allocationMode (keys: Indices) (values: ClArray<'a>) -> + fun (processor: MailboxProcessor<_>) allocationMode (keys: ClArray) (values: ClArray<'a>) -> if values.Length <> keys.Length then failwith "Mismatch of key lengths and value. Lengths must be the same" diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index bdf1840d..fe7feeb2 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -55,7 +55,7 @@ module Reduce = result - let private scanSum (clContext: ClContext) (workGroupSize: int) (opAdd: Expr<'a -> 'a -> 'a>) zero = + let private scanSum (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) (workGroupSize: int) zero = let subSum = SubSum.sequentialSum opAdd @@ -92,7 +92,7 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - let private scanToCellSum (clContext: ClContext) workGroupSize (opAdd: Expr<'a -> 'a -> 'a>) zero = + let private scanToCellSum (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize zero = let subSum = SubSum.sequentialSum opAdd @@ -139,12 +139,12 @@ module Reduce = /// Work group size. /// Summation operation. /// Neutral element for summation. - let sum (clContext: ClContext) workGroupSize op zero = + let sum op zero (clContext: ClContext) workGroupSize = - let scan = scanSum clContext workGroupSize op zero + let scan = scanSum op clContext workGroupSize zero let scanToCell = - scanToCellSum clContext workGroupSize op zero + scanToCellSum op clContext workGroupSize zero let run = runGeneral clContext workGroupSize scan scanToCell @@ -152,9 +152,9 @@ module Reduce = fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) -> run processor array let private scanReduce<'a when 'a: struct> + (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) (workGroupSize: int) - (opAdd: Expr<'a -> 'a -> 'a>) = let scan = @@ -193,9 +193,9 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) let private scanToCellReduce<'a when 'a: struct> + (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) (workGroupSize: int) - (opAdd: Expr<'a -> 'a -> 'a>) = let scan = @@ -242,12 +242,12 @@ module Reduce = /// ClContext. /// Work group size. /// Reduction operation. - let reduce (clContext: ClContext) workGroupSize op = + let reduce op (clContext: ClContext) workGroupSize = - let scan = scanReduce clContext workGroupSize op + let scan = scanReduce op clContext workGroupSize let scanToCell = - scanToCellReduce clContext workGroupSize op + scanToCellReduce op clContext workGroupSize let run = runGeneral clContext workGroupSize scan scanToCell @@ -267,7 +267,7 @@ module Reduce = /// /// The length of the result must be calculated in advance. /// - let sequential (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + let sequential (reduceOp: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) length (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (reducedKeys: ClArray) -> @@ -315,7 +315,7 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - reducedKeys, reducedValues + reducedValues, reducedKeys /// /// Reduces values by key. Each segment is reduced by one work item. @@ -326,7 +326,7 @@ module Reduce = /// /// The length of the result must be calculated in advance. /// - let segmentSequential (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + let segmentSequential (reduceOp: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (reducedKeys: ClArray) -> @@ -381,7 +381,7 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - reducedKeys, reducedValues + reducedValues, reducedKeys /// /// Reduces values by key. One work group participates in the reduction. @@ -393,7 +393,7 @@ module Reduce = /// Reduces an array of values that does not exceed the size of the workgroup. /// The length of the result must be calculated in advance. /// - let oneWorkGroupSegments (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + let oneWorkGroupSegments (reduceOp: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) length (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (reducedKeys: ClArray) -> @@ -470,7 +470,124 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - reducedKeys, reducedValues + reducedValues, reducedKeys + + module Option = + /// + /// 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> (reduceOp: Expr<'a -> 'a -> 'a option>) (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (resultPositions: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < uniqueKeyCount then + let startPosition = offsets.[gid] + + let firstSourceKey = keys.[startPosition] + + let mutable sum = Some values.[startPosition] + + let mutable currentPosition = startPosition + 1 + + while currentPosition < keysLength + && firstSourceKey = keys.[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 @> + + 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) (keys: ClArray) (values: ClArray<'a>) -> + + let reducedValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let reducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, 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 + keys.Length + offsets + keys + values + reducedValues + reducedKeys + resultPositions) + ) + + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + let resultLength = + (prefixSum processor resultPositions) + .ToHostAndFree processor + + if resultLength = 0 then + None + else + // write values + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + scatterData processor resultPositions reducedValues resultValues + + reducedValues.Free processor + + // write keys + let resultKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + scatterIndices processor resultPositions reducedKeys resultKeys + + reducedKeys.Free processor + resultPositions.Free processor + + Some(resultValues, resultKeys) module ByKey2D = /// @@ -482,7 +599,7 @@ module Reduce = /// /// The length of the result must be calculated in advance. /// - let sequential (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + let sequential (reduceOp: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) length (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (secondReducedKeys: ClArray) -> @@ -550,7 +667,7 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - firstReducedKeys, secondReducedKeys, reducedValues + reducedValues, firstReducedKeys, secondReducedKeys /// /// Reduces values by key. Each segment is reduced by one work item. @@ -561,7 +678,7 @@ module Reduce = /// /// The length of the result must be calculated in advance. /// - let segmentSequential<'a> (clContext: ClContext) workGroupSize (reduceOp: Expr<'a -> 'a -> 'a>) = + let segmentSequential<'a> (reduceOp: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let kernel = <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (secondReducedKeys: ClArray) -> @@ -625,131 +742,138 @@ module Reduce = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - firstReducedKeys, secondReducedKeys, reducedValues + reducedValues, firstReducedKeys, secondReducedKeys - /// - /// 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>) = + module Option = + /// + /// 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> (reduceOp: Expr<'a -> 'a -> 'a option>) (clContext: ClContext) workGroupSize = - 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 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 + let gid = ndRange.GlobalID0 - if gid < uniqueKeyCount then - let startPosition = offsets.[gid] + if gid < uniqueKeyCount then + let startPosition = offsets.[gid] - let firstSourceKey = firstKeys.[startPosition] - let secondSourceKey = secondKeys.[startPosition] + let firstSourceKey = firstKeys.[startPosition] + let secondSourceKey = secondKeys.[startPosition] - let mutable sum = Some values.[startPosition] + let mutable sum = Some values.[startPosition] - let mutable currentPosition = startPosition + 1 + let mutable currentPosition = startPosition + 1 - while currentPosition < keysLength - && firstSourceKey = firstKeys.[currentPosition] - && secondSourceKey = secondKeys.[currentPosition] do + while currentPosition < keysLength + && firstSourceKey = firstKeys.[currentPosition] + && secondSourceKey = secondKeys.[currentPosition] do - match sum with - | Some value -> - let result = - ((%reduceOp) value values.[currentPosition]) // brahma error + match sum with + | Some value -> + let result = + ((%reduceOp) value values.[currentPosition]) // brahma error - sum <- result - | None -> sum <- Some values.[currentPosition] + sum <- result + | None -> sum <- Some values.[currentPosition] - currentPosition <- currentPosition + 1 + currentPosition <- currentPosition + 1 - match sum with - | Some value -> - reducedValues.[gid] <- value - resultPositions.[gid] <- 1 - | None -> resultPositions.[gid] <- 0 + match sum with + | Some value -> + reducedValues.[gid] <- value + resultPositions.[gid] <- 1 + | None -> resultPositions.[gid] <- 0 - firstReducedKeys.[gid] <- firstSourceKey - secondReducedKeys.[gid] <- secondSourceKey @> + firstReducedKeys.[gid] <- firstSourceKey + secondReducedKeys.[gid] <- secondSourceKey @> - let kernel = clContext.Compile kernel + 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>) -> + fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> - let reducedValues = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let reducedValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let firstReducedKeys = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let firstReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let secondReducedKeys = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + let secondReducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - let resultPositions = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + let resultPositions = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - let ndRange = - Range1D.CreateValid(resultLength, workGroupSize) + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) - let kernel = kernel.GetKernel() + 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.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + resultLength + firstKeys.Length + offsets + firstKeys + secondKeys + values + reducedValues + firstReducedKeys + secondReducedKeys + resultPositions) + ) - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.Post(Msg.CreateRunMsg<_, _>(kernel)) - let resultLength = - (prefixSum processor resultPositions) - .ToHostAndFree processor + let resultLength = + (prefixSum processor resultPositions) + .ToHostAndFree processor - let resultValues = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + if resultLength = 0 then + None + else + // write value + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - scatterData processor resultPositions reducedValues resultValues + scatterData processor resultPositions reducedValues resultValues - reducedValues.Free processor + reducedValues.Free processor - let resultFirstKeys = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + // write first keys + let resultFirstKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - scatterIndices processor resultPositions firstReducedKeys resultFirstKeys + scatterIndices processor resultPositions firstReducedKeys resultFirstKeys - firstReducedKeys.Free processor + firstReducedKeys.Free processor - let resultSecondKeys = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + // write second keys + let resultSecondKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) - scatterIndices processor resultPositions secondReducedKeys resultSecondKeys + scatterIndices processor resultPositions secondReducedKeys resultSecondKeys - secondReducedKeys.Free processor + secondReducedKeys.Free processor - resultPositions.Free processor + resultPositions.Free processor - resultFirstKeys, resultSecondKeys, resultValues + Some(resultValues, resultFirstKeys, resultSecondKeys) diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index 48a0f30e..82e534fc 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -18,6 +18,7 @@ + @@ -26,16 +27,25 @@ + - + + + + + + + + + @@ -43,18 +53,13 @@ - - + + + - - - - - - - + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs index cc7c2f72..7700b476 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs @@ -11,7 +11,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext module internal Map = - let preparePositions<'a, 'b> (clContext: ClContext) workGroupSize opAdd = + let preparePositions<'a, 'b> opAdd (clContext: ClContext) workGroupSize = let preparePositions (op: Expr<'a option -> 'b option>) = <@ fun (ndRange: Range1D) rowCount columnCount valuesLength (values: ClArray<'a>) (rows: ClArray) (columns: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'b>) (resultRows: ClArray) (resultColumns: ClArray) -> @@ -84,13 +84,13 @@ module internal Map = resultBitmap, resultValues, resultRows, resultColumns let run<'a, 'b when 'a: struct and 'b: struct and 'b: equality> - (clContext: ClContext) (opAdd: Expr<'a option -> 'b option>) + (clContext: ClContext) workGroupSize = let map = - preparePositions clContext workGroupSize opAdd + preparePositions opAdd clContext workGroupSize let setPositions = Common.setPositions<'b> clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs index 00ac1075..3d79eb9a 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs @@ -10,7 +10,8 @@ open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext module internal Map2 = - let preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = + + let preparePositions<'a, 'b, 'c> opAdd (clContext: ClContext) workGroupSize = let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = <@ fun (ndRange: Range1D) rowCount columnCount leftValuesLength rightValuesLength (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumn: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) -> @@ -93,13 +94,13 @@ module internal Map2 = ///. ///Should be a power of 2 and greater than 1. let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = let map2 = - preparePositions clContext workGroupSize opAdd + preparePositions opAdd clContext workGroupSize let setPositions = Common.setPositions<'c> clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs index dd708c37..ac46e816 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs @@ -6,6 +6,8 @@ open GraphBLAS.FSharp.Backend.Quotes open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix +open GraphBLAS.FSharp.Backend.Objects.ClCell +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions module Matrix = let map = Map.run @@ -63,7 +65,7 @@ module Matrix = let create = ClArray.create clContext workGroupSize let scan = - PrefixSum.runBackwardsIncludeInplace <@ min @> clContext workGroupSize + PrefixSum.runBackwardsIncludeInPlace <@ min @> clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (rowIndices: ClArray) rowCount -> @@ -78,8 +80,7 @@ module Matrix = processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange rowIndices nnz rowPointers)) processor.Post(Msg.CreateRunMsg<_, _> kernel) - let result = scan processor rowPointers nnz - processor.Post <| Msg.CreateFreeMsg(result) + (scan processor rowPointers nnz).Free processor rowPointers @@ -107,14 +108,14 @@ module Matrix = Columns = cols Values = values } - let toCSRInplace (clContext: ClContext) workGroupSize = + let toCSRInPlace (clContext: ClContext) workGroupSize = let prepare = compressRows clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> let rowPointers = prepare processor allocationMode matrix.Rows matrix.RowCount - processor.Post(Msg.CreateFreeMsg(matrix.Rows)) + matrix.Rows.Free processor { Context = clContext RowCount = matrix.RowCount @@ -123,7 +124,7 @@ module Matrix = Columns = matrix.Columns Values = matrix.Values } - let transposeInplace (clContext: ClContext) workGroupSize = + let transposeInPlace (clContext: ClContext) workGroupSize = let sort = Sort.Bitonic.sortKeyValuesInplace clContext workGroupSize @@ -140,7 +141,7 @@ module Matrix = let transpose (clContext: ClContext) workGroupSize = - let transposeInplace = transposeInplace clContext workGroupSize + let transposeInPlace = transposeInPlace clContext workGroupSize let copy = ClArray.copy clContext workGroupSize @@ -154,4 +155,4 @@ module Matrix = Rows = copy queue allocationMode matrix.Rows Columns = copy queue allocationMode matrix.Columns Values = copyData queue allocationMode matrix.Values } - |> transposeInplace queue + |> transposeInPlace queue diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/GetTuples.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/GetTuples.fs deleted file mode 100644 index 573badec..00000000 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/GetTuples.fs +++ /dev/null @@ -1,46 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.CSRMatrix - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp -open GraphBLAS.FSharp.Backend.Common - -module internal GetTuples = - let fromMatrix (matrix: CSRMatrix<'a>) = - opencl { - if matrix.Values.Length = 0 then - return - { RowIndices = [||] - ColumnIndices = [||] - Values = [||] } - - else - let rowCount = matrix.RowCount - - let expandCsrRows = - <@ fun (ndRange: Range1D) (rowPointers: int []) (outputRowIndices: int []) -> - - let gid = ndRange.GlobalID0 - - if gid < rowCount then - for idx = rowPointers.[gid] to rowPointers.[gid + 1] - 1 do - outputRowIndices.[idx] <- gid @> - - let rowIndices = - Array.zeroCreate matrix.Values.Length - - do! - runCommand expandCsrRows - <| fun kernelPrepare -> - kernelPrepare - <| Range1D(rowCount |> Utils.getDefaultGlobalSize, Utils.defaultWorkGroupSize) - <| matrix.RowPointers - <| rowIndices - - let! colIndices = Copy.copyArray matrix.ColumnIndices - let! vals = Copy.copyArray matrix.Values - - return - { RowIndices = rowIndices - ColumnIndices = colIndices - Values = vals } - } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs index 67e73b93..0ca4148f 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs @@ -11,7 +11,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext module internal Map = - let preparePositions<'a, 'b> (clContext: ClContext) workGroupSize op = + let preparePositions<'a, 'b> op (clContext: ClContext) workGroupSize = let preparePositions (op: Expr<'a option -> 'b option>) = <@ fun (ndRange: Range1D) rowCount columnCount (values: ClArray<'a>) (rowPointers: ClArray) (columns: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'b>) (resultRows: ClArray) (resultColumns: ClArray) -> @@ -81,14 +81,14 @@ module internal Map = resultBitmap, resultValues, resultRows, resultColumns - let runToCOO<'a, 'b when 'a: struct and 'b: struct and 'b: equality> - (clContext: ClContext) + let run<'a, 'b when 'a: struct and 'b: struct and 'b: equality> (opAdd: Expr<'a option -> 'b option>) + (clContext: ClContext) workGroupSize = let map = - preparePositions clContext workGroupSize opAdd + preparePositions opAdd clContext workGroupSize let setPositions = Common.setPositions<'b> clContext workGroupSize @@ -112,18 +112,3 @@ module internal Map = Rows = resultRows Columns = resultColumns Values = resultValues } - - let run<'a, 'b when 'a: struct and 'b: struct and 'b: equality> - (clContext: ClContext) - (opAdd: Expr<'a option -> 'b option>) - workGroupSize - = - - let mapToCOO = runToCOO clContext opAdd workGroupSize - - let toCSRInplace = - Matrix.toCSRInplace clContext workGroupSize - - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> - mapToCOO queue allocationMode matrix - |> toCSRInplace queue allocationMode diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs index 78360ddb..bfd5f161 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs @@ -11,7 +11,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Matrix.COO module internal Map2 = - let preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = + let preparePositions<'a, 'b, 'c> opAdd (clContext: ClContext) workGroupSize = let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = <@ fun (ndRange: Range1D) rowCount columnCount (leftValues: ClArray<'a>) (leftRowPointers: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRowPointers: ClArray) (rightColumn: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) -> @@ -94,14 +94,14 @@ module internal Map2 = ///. ///. ///Should be a power of 2 and greater than 1. - let runToCOO<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> (opAdd: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = let map2 = - preparePositions clContext workGroupSize opAdd + preparePositions opAdd clContext workGroupSize let setPositions = Common.setPositions<'c> clContext workGroupSize @@ -135,25 +135,10 @@ module internal Map2 = Columns = resultColumns Values = resultValues } - let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) - (opAdd: Expr<'a option -> 'b option -> 'c option>) - workGroupSize - = - - let map2ToCOO = runToCOO clContext opAdd workGroupSize - - let toCSRInplace = - Matrix.toCSRInplace clContext workGroupSize - - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> - map2ToCOO queue allocationMode matrixLeft matrixRight - |> toCSRInplace queue allocationMode - module AtLeastOne = let preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = @@ -214,9 +199,9 @@ module internal Map2 = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) rowPositions, allValues - let runToCOO<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> (opAdd: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = @@ -224,10 +209,10 @@ module internal Map2 = GraphBLAS.FSharp.Backend.Matrix.CSR.Merge.run clContext workGroupSize let preparePositions = - preparePositions clContext opAdd workGroupSize + preparePositions opAdd clContext workGroupSize let setPositions = - Matrix.Common.setPositions<'c> clContext workGroupSize + Common.setPositions<'c> clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> @@ -256,18 +241,3 @@ module internal Map2 = Rows = resultRows Columns = resultColumns Values = resultValues } - - let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) - (opAdd: Expr<'a option -> 'b option -> 'c option>) - workGroupSize - = - - let elementwiseToCOO = runToCOO clContext opAdd workGroupSize - - let toCSRInPlace = - Matrix.toCSRInplace clContext workGroupSize - - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> - elementwiseToCOO queue allocationMode matrixLeft matrixRight - |> toCSRInPlace queue allocationMode diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 12f42b57..dd41f748 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -8,8 +8,9 @@ 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.ClVector open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -open GraphBLAS.FSharp.Backend.Objects.ClCell + module Matrix = let toCOO (clContext: ClContext) workGroupSize = @@ -58,31 +59,23 @@ module Matrix = let map2 = Map2.run - let map2AtLeastOneToCOO<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) - (opAdd: Expr -> 'c option>) - workGroupSize - = - - Map2.AtLeastOne.runToCOO clContext (Convert.atLeastOneToOption opAdd) workGroupSize - let map2AtLeastOne<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = - Map2.AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize + Map2.AtLeastOne.run (Convert.atLeastOneToOption opAdd) clContext workGroupSize let transposeInPlace (clContext: ClContext) workGroupSize = let toCOOInPlace = toCOOInPlace clContext workGroupSize let transposeInPlace = - COO.Matrix.transposeInplace clContext workGroupSize + COO.Matrix.transposeInPlace clContext workGroupSize let toCSRInPlace = - COO.Matrix.toCSRInplace clContext workGroupSize + COO.Matrix.toCSRInPlace clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> toCOOInPlace queue allocationMode matrix @@ -94,49 +87,92 @@ module Matrix = let toCOO = toCOO clContext workGroupSize let transposeInPlace = - COO.Matrix.transposeInplace clContext workGroupSize + COO.Matrix.transposeInPlace clContext workGroupSize let toCSRInPlace = - COO.Matrix.toCSRInplace clContext workGroupSize + COO.Matrix.toCSRInPlace clContext workGroupSize + fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> toCOO queue allocationMode matrix |> transposeInPlace queue |> toCSRInPlace queue allocationMode - module SpGeMM = - let masked - (clContext: ClContext) - workGroupSize - (opAdd: Expr<'c -> 'c -> 'c option>) - (opMul: Expr<'a -> 'b -> 'c option>) - = + let byRowsLazy (clContext: ClContext) workGroupSize = - let run = - SpGeMM.Masked.run clContext workGroupSize opAdd opMul + let getChunkValues = ClArray.sub clContext workGroupSize - fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> + let getChunkIndices = ClArray.sub clContext workGroupSize - run queue matrixLeft matrixRight mask + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> - let expand - (clContext: ClContext) - workGroupSize - (opAdd: Expr<'c -> 'c -> 'c option>) - (opMul: Expr<'a -> 'b -> 'c option>) - = + let getChunkValues = + getChunkValues processor allocationMode matrix.Values - let run = - SpGeMM.Expand.run clContext workGroupSize opAdd opMul + let getChunkIndices = + getChunkIndices processor allocationMode matrix.Columns - fun (queue: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + let creatSparseVector values columns = + { Context = clContext + Indices = columns + Values = values + Size = matrix.ColumnCount } - let values, columns, rows = - run queue allocationMode leftMatrix rightMatrix + matrix.RowPointers.ToHost processor + |> Seq.pairwise + |> Seq.map + (fun (first, second) -> + lazy + (let count = second - first - { COO.Context = clContext - ColumnCount = rightMatrix.ColumnCount - RowCount = leftMatrix.RowCount - Values = values - Columns = columns - Rows = rows } + if count > 0 then + let values = getChunkValues first count + let columns = getChunkIndices first count + + Some <| creatSparseVector values columns + else + None)) + + let byRows (clContext: ClContext) workGroupSize = + + let runLazy = byRowsLazy clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + runLazy processor allocationMode matrix + |> Seq.map (fun lazyValue -> lazyValue.Value) + + let toLIL (clContext: ClContext) workGroupSize = + + let byRows = byRows clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + let rows = + byRows processor allocationMode matrix + |> Seq.toList + + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + Rows = rows + NNZ = matrix.NNZ } + + let NNZInRows (clContext: ClContext) workGroupSize = + + let pairwise = ClArray.pairwise clContext workGroupSize + + let subtract = + ClArray.map <@ fun (fst, snd) -> snd - fst @> clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'b>) -> + let pointerPairs = + pairwise processor DeviceOnly matrix.RowPointers + // since row pointers length in matrix always >= 2 + |> Option.defaultWith + (fun () -> failwith "The state of the matrix is broken. The length of the rowPointers must be >= 2") + + let rowsLength = + subtract processor allocationMode pointerPairs + + pointerPairs.Free processor + + rowsLength diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Merge.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Merge.fs index 05402e21..cf98d531 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Merge.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Merge.fs @@ -3,6 +3,7 @@ namespace GraphBLAS.FSharp.Backend.Matrix.CSR open Brahma.FSharp open System open GraphBLAS.FSharp.Backend.Objects + open GraphBLAS.FSharp.Backend.Objects.ClContext module Merge = diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Expand.fs deleted file mode 100644 index 37cefdce..00000000 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Expand.fs +++ /dev/null @@ -1,333 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM - -open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Common.Sort -open GraphBLAS.FSharp.Backend.Matrix -open GraphBLAS.FSharp.Backend.Quotes -open GraphBLAS.FSharp.Backend.Objects.ClContext -open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Backend.Objects.ClCell -open FSharp.Quotations - -type Indices = ClArray - -type Values<'a> = ClArray<'a> - -module Expand = - let getSegmentPointers (clContext: ClContext) workGroupSize = - - let subtract = - ClArray.map2 clContext workGroupSize Map.subtraction - - let idGather = - Gather.runInit Map.id clContext workGroupSize - - let incGather = - Gather.runInit Map.inc clContext workGroupSize - - let gather = Gather.run clContext workGroupSize - - let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - - let positionsLength = rightMatrix.RowPointers.Length - 1 - - // extract first rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers - // (right matrix row pointers without last item) - let firstPointers = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) - - idGather processor rightMatrix.RowPointers firstPointers - - // extract last rightMatrix.RowPointers.Lengths - 1 indices from rightMatrix.RowPointers - // (right matrix row pointers without first item) - let lastPointers = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, positionsLength) - - incGather processor rightMatrix.RowPointers lastPointers - - // subtract - let rightMatrixRowsLengths = - subtract processor DeviceOnly lastPointers firstPointers - - firstPointers.Free processor - lastPointers.Free processor - - let segmentsLengths = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrix.Columns.Length) - - // extract needed lengths by left matrix nnz - gather processor leftMatrix.Columns rightMatrixRowsLengths segmentsLengths - - rightMatrixRowsLengths.Free processor - - // compute pointers - let length = - (prefixSum processor segmentsLengths) - .ToHostAndFree processor - - length, segmentsLengths - - let multiply (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b -> 'c option>) = - let getBitmap = - ClArray.map2<'a, 'b, int> clContext workGroupSize - <| Map.chooseBitmap2 predicate - - let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize - - let assignValues = - ClArray.assignOption2 clContext workGroupSize predicate - - let scatter = - Scatter.lastOccurrence clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (columns: Indices) (rows: Indices) -> - - let positions = - getBitmap processor DeviceOnly firstValues secondValues - - let resultLength = - (prefixSum processor positions) - .ToHostAndFree(processor) - - let resultColumns = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - - scatter processor positions columns resultColumns - - let resultRows = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - - scatter processor positions rows resultRows - - let resultValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - - assignValues processor firstValues secondValues positions resultValues - - resultValues, resultColumns, resultRows - - let expand (clContext: ClContext) workGroupSize = - - let idScatter = - Scatter.initLastOccurrence Map.id clContext workGroupSize - - let scatter = - Scatter.lastOccurrence clContext workGroupSize - - let zeroCreate = - ClArray.zeroCreate clContext workGroupSize - - let maxPrefixSum = - PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize - - let create = ClArray.create clContext workGroupSize - - let gather = Gather.run clContext workGroupSize - - let segmentPrefixSum = - PrefixSum.ByKey.sequentialInclude clContext workGroupSize <@ (+) @> 0 - - let removeDuplicates = - ClArray.removeDuplications clContext workGroupSize - - let expandRowPointers = - Common.expandRowPointers clContext workGroupSize - - let leftMatrixGather = Gather.run clContext workGroupSize - - let rightMatrixGather = Gather.run clContext workGroupSize - - fun (processor: MailboxProcessor<_>) lengths (segmentsPointers: Indices) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - - // Compute left matrix positions - let leftMatrixPositions = zeroCreate processor DeviceOnly lengths - - idScatter processor segmentsPointers leftMatrixPositions - - (maxPrefixSum processor leftMatrixPositions 0) - .Free processor - - // Compute right matrix positions - let rightMatrixPositions = create processor DeviceOnly lengths 1 - - let requiredRightMatrixPointers = - zeroCreate processor DeviceOnly leftMatrix.Columns.Length - - gather processor leftMatrix.Columns rightMatrix.RowPointers requiredRightMatrixPointers - - scatter processor segmentsPointers requiredRightMatrixPointers rightMatrixPositions - - requiredRightMatrixPointers.Free processor - - // another way to get offsets ??? - let offsets = - removeDuplicates processor segmentsPointers - - segmentPrefixSum processor offsets.Length rightMatrixPositions leftMatrixPositions offsets - - offsets.Free processor - - // compute columns - let columns = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) - - gather processor rightMatrixPositions rightMatrix.Columns columns - - // compute rows - let leftMatrixRows = - expandRowPointers processor DeviceOnly leftMatrix.RowPointers leftMatrix.NNZ leftMatrix.RowCount - - let rows = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) - - gather processor leftMatrixPositions leftMatrixRows rows - - leftMatrixRows.Free processor - - // compute left matrix values - let leftMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) - - leftMatrixGather processor leftMatrixPositions leftMatrix.Values leftMatrixValues - - leftMatrixPositions.Free processor - - // compute right matrix values - let rightMatrixValues = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, lengths) - - rightMatrixGather processor rightMatrixPositions rightMatrix.Values rightMatrixValues - - rightMatrixPositions.Free processor - - // left, right matrix values, columns and rows indices - leftMatrixValues, rightMatrixValues, columns, rows - - let sortByColumnsAndRows (clContext: ClContext) workGroupSize = - - let sortByKeyIndices = - Radix.runByKeysStandard clContext workGroupSize - - let sortByKeyValues = - Radix.runByKeysStandard clContext workGroupSize - - let sortKeys = - Radix.standardRunKeysOnly clContext workGroupSize - - fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> - // sort by columns - let valuesSortedByColumns = - sortByKeyValues processor DeviceOnly columns values - - let rowsSortedByColumns = - sortByKeyIndices processor DeviceOnly columns rows - - let sortedColumns = sortKeys processor columns - - // sort by rows - let valuesSortedByRows = - sortByKeyValues processor DeviceOnly rowsSortedByColumns valuesSortedByColumns - - let columnsSortedByRows = - sortByKeyIndices processor DeviceOnly rowsSortedByColumns sortedColumns - - let sortedRows = sortKeys processor rowsSortedByColumns - - valuesSortedByColumns.Free processor - rowsSortedByColumns.Free processor - sortedColumns.Free processor - - valuesSortedByRows, columnsSortedByRows, sortedRows - - let reduce (clContext: ClContext) workGroupSize opAdd = - - let reduce = - Reduce.ByKey2D.segmentSequentialOption clContext workGroupSize opAdd - - let getUniqueBitmap = - ClArray.getUniqueBitmap2LastOccurrence clContext workGroupSize - - let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize - - let idScatter = - Scatter.initFirsOccurrence Map.id clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: Indices) (rows: Indices) -> - - let bitmap = - getUniqueBitmap processor DeviceOnly columns rows - - let uniqueKeysCount = - (prefixSum processor bitmap) - .ToHostAndFree processor - - let offsets = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) - - idScatter processor bitmap offsets - - bitmap.Free processor - - let reducedColumns, reducedRows, reducedValues = // by size variance TODO() - reduce processor allocationMode uniqueKeysCount offsets columns rows values - - offsets.Free processor - - reducedValues, reducedColumns, reducedRows - - let run (clContext: ClContext) workGroupSize opAdd opMul = - - let getSegmentPointers = - getSegmentPointers clContext workGroupSize - - let expand = expand clContext workGroupSize - - let multiply = multiply clContext workGroupSize opMul - - let sort = - sortByColumnsAndRows clContext workGroupSize - - let reduce = reduce clContext workGroupSize opAdd - - fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - - let length, segmentPointers = - getSegmentPointers processor leftMatrix rightMatrix - - // expand - let leftMatrixValues, rightMatrixValues, columns, rows = - expand processor length segmentPointers leftMatrix rightMatrix - - // multiply - let resultValues, resultColumns, resultRows = - multiply processor leftMatrixValues rightMatrixValues columns rows - - leftMatrixValues.Free processor - rightMatrixValues.Free processor - columns.Free processor - rows.Free processor - - // sort - let sortedValues, sortedColumns, sortedRows = - sort processor resultValues resultColumns resultRows - - resultValues.Free processor - resultColumns.Free processor - resultRows.Free processor - - // addition - let reducedValues, reducedColumns, reducedRows = - reduce processor allocationMode sortedValues sortedColumns sortedRows - - sortedValues.Free processor - sortedColumns.Free processor - sortedRows.Free processor - - reducedValues, reducedColumns, reducedRows diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpMSpV.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpMSpV.fs deleted file mode 100644 index 419e3ace..00000000 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpMSpV.fs +++ /dev/null @@ -1,321 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.CSRMatrix - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp -open GraphBLAS.FSharp.Backend.Common - -module internal rec SpMSpV = - let unmasked (matrix: CSRMatrix<'a>) (vector: COOVector<'a>) (semiring: ISemiring<'a>) = - opencl { - if matrix.Values.Length = 0 - || vector.Values.Length = 0 then - return - { Size = matrix.RowCount - Indices = [||] - Values = [||] } - - else - let rowCount = matrix.RowCount - let vectorNnz = vector.Values.Length - let wgSize = Utils.defaultWorkGroupSize - - let (ClosedBinaryOp plus) = semiring.Plus - let (ClosedBinaryOp times) = semiring.Times - let zero = semiring.Zero - - let calcValuesPerRow = - <@ fun (range: Range1D) (matrixRowPointers: int []) (matrixColumnIndices: int []) (matrixValues: 'a []) (vectorIndices: int []) (vectorValues: 'a []) (countOfProductsPerRow: int []) (valuesPerRow: 'a []) -> - - let gid = range.GlobalID0 - let lid = range.LocalID0 - let groupId = gid / wgSize // rowId - - let localCountAccum = localArray wgSize - localCountAccum.[lid] <- 0 - - let localValuesAccum = localArray<'a> wgSize - localValuesAccum.[lid] <- zero - - barrier () - - let mutable i = matrixRowPointers.[groupId] + lid - let _end = matrixRowPointers.[groupId + 1] - - while i < _end do - let col = matrixColumnIndices.[i] - let value = matrixValues.[i] - - let mutable l = 0 - let mutable r = vectorNnz - let mutable m = l + ((r - l) / 2) - let mutable idx = -1 - let mutable _break = false - - while l < r && not _break do - if vectorIndices.[m] = col then - idx <- m - _break <- true - elif vectorIndices.[m] < col then - l <- m + 1 - else - r <- m - - m <- l + ((r - l) / 2) - - if idx <> -1 then - let vectorValue = vectorValues.[idx] - localCountAccum.[lid] <- localCountAccum.[lid] + 1 - localValuesAccum.[lid] <- (%plus) localValuesAccum.[lid] ((%times) value vectorValue) - - i <- i + wgSize - - barrier () - - if lid = 0 then - let mutable countAcc = 0 - let mutable valueAcc = zero - - for i = 0 to wgSize - 1 do - countAcc <- countAcc + localCountAccum.[i] - valueAcc <- (%plus) valueAcc localValuesAccum.[i] - - countOfProductsPerRow.[groupId] <- countAcc - valuesPerRow.[groupId] <- valueAcc @> - - let countOfProductsPerRow = Array.zeroCreate rowCount - let valuesPerRow = Array.zeroCreate<'a> rowCount - - do! - runCommand calcValuesPerRow - <| fun kernelPrepare -> - kernelPrepare - <| Range1D(rowCount * Utils.defaultWorkGroupSize, Utils.defaultWorkGroupSize) - <| matrix.RowPointers - <| matrix.ColumnIndices - <| matrix.Values - <| vector.Indices - <| vector.Values - <| countOfProductsPerRow - <| valuesPerRow - - let getNonzeroBitmap = - <@ fun (range: Range1D) (count: int []) (bitmap: int []) -> - - let gid = range.GlobalID0 - - if gid < rowCount && count.[gid] = 0 then - bitmap.[gid] <- 0 @> - - let bitmap = Array.create rowCount 1 - - do! - runCommand getNonzeroBitmap - <| fun kernelPrepare -> - kernelPrepare - <| Range1D(Utils.getDefaultGlobalSize rowCount, Utils.defaultWorkGroupSize) - <| countOfProductsPerRow - <| bitmap - - let! (positions, totalSum) = PrefixSum.runExclude bitmap - failwith "FIX ME! And rewrite." - //let! _ = ToHost totalSum - let resultLength = totalSum.[0] - - if resultLength = 0 then - return - { Size = matrix.RowCount - Indices = [||] - Values = [||] } - - else - let getOutputVector = - <@ fun (range: Range1D) (count: int []) (values: 'a []) (positions: int []) (outputValues: 'a []) (outputIndices: int []) -> - - let gid = range.GlobalID0 - - if gid < rowCount && count.[gid] <> 0 then - outputValues.[positions.[gid]] <- values.[gid] - outputIndices.[positions.[gid]] <- gid @> - - let outputValues = Array.zeroCreate<'a> resultLength - let outputIndices = Array.zeroCreate resultLength - - do! - runCommand getOutputVector - <| fun kernelPrepare -> - kernelPrepare - <| Range1D(Utils.getDefaultGlobalSize rowCount, Utils.defaultWorkGroupSize) - <| countOfProductsPerRow - <| valuesPerRow - <| positions - <| outputValues - <| outputIndices - - return - { Size = rowCount - Indices = outputIndices - Values = outputValues } - } - - let masked (matrix: CSRMatrix<'a>) (vector: COOVector<'a>) (semiring: ISemiring<'a>) (mask: Mask1D) = - opencl { - if matrix.Values.Length = 0 - || vector.Values.Length = 0 then - return - { Size = matrix.RowCount - Indices = [||] - Values = [||] } - - elif mask.Indices.Length = 0 && not mask.IsComplemented - || mask.Indices.Length = mask.Size - && mask.IsComplemented then - return - { Size = matrix.RowCount - Indices = [||] - Values = [||] } - - else - let rowCount = matrix.RowCount - let vectorNnz = vector.Values.Length - let wgSize = Utils.defaultWorkGroupSize - let maskNnz = mask.Indices.Length - - let (ClosedBinaryOp plus) = semiring.Plus - let (ClosedBinaryOp times) = semiring.Times - let zero = semiring.Zero - - let calcValuesPerRow = - <@ fun (range: Range1D) (mask: int []) (matrixRowPointers: int []) (matrixColumnIndices: int []) (matrixValues: 'a []) (vectorIndices: int []) (vectorValues: 'a []) (countOfProductsPerRow: int []) (valuesPerRow: 'a []) -> - - let gid = range.GlobalID0 - let lid = range.LocalID0 - let groupId = gid / wgSize - let rowId = mask.[groupId] - - let localCountAccum = localArray wgSize - localCountAccum.[lid] <- 0 - - let localValuesAccum = localArray<'a> wgSize - localValuesAccum.[lid] <- zero - - barrier () - - let mutable i = matrixRowPointers.[rowId] + lid - let _end = matrixRowPointers.[rowId + 1] - - while i < _end do - let col = matrixColumnIndices.[i] - let value = matrixValues.[i] - - let mutable l = 0 - let mutable r = vectorNnz - let mutable m = l + ((r - l) / 2) - let mutable idx = -1 - let mutable _break = false - - while l < r && not _break do - if vectorIndices.[m] = col then - idx <- m - _break <- true - elif vectorIndices.[m] < col then - l <- m + 1 - else - r <- m - - m <- l + ((r - l) / 2) - - if idx <> -1 then - let vectorValue = vectorValues.[idx] - localCountAccum.[lid] <- localCountAccum.[lid] + 1 - localValuesAccum.[lid] <- (%plus) localValuesAccum.[lid] ((%times) value vectorValue) - - i <- i + wgSize - - barrier () - - if lid = 0 then - let mutable countAcc = 0 - let mutable valueAcc = zero - - for i = 0 to wgSize - 1 do - countAcc <- countAcc + localCountAccum.[i] - valueAcc <- (%plus) valueAcc localValuesAccum.[i] - - countOfProductsPerRow.[rowId] <- countAcc - valuesPerRow.[rowId] <- valueAcc @> - - let countOfProductsPerRow = Array.zeroCreate rowCount - let valuesPerRow = Array.zeroCreate<'a> rowCount - - do! - runCommand calcValuesPerRow - <| fun kernelPrepare -> - kernelPrepare - <| Range1D(maskNnz * Utils.defaultWorkGroupSize, Utils.defaultWorkGroupSize) - <| mask.Indices - <| matrix.RowPointers - <| matrix.ColumnIndices - <| matrix.Values - <| vector.Indices - <| vector.Values - <| countOfProductsPerRow - <| valuesPerRow - - let getNonzeroBitmap = - <@ fun (range: Range1D) (count: int []) (bitmap: int []) -> - - let gid = range.GlobalID0 - - if gid < rowCount && count.[gid] = 0 then - bitmap.[gid] <- 0 @> - - let bitmap = Array.create rowCount 1 - - do! - runCommand getNonzeroBitmap - <| fun kernelPrepare -> - kernelPrepare - <| Range1D(Utils.getDefaultGlobalSize rowCount, Utils.defaultWorkGroupSize) - <| countOfProductsPerRow - <| bitmap - - let! (positions, totalSum) = PrefixSum.runExclude bitmap - failwith "FIX ME! And rewrite." - //let! _ = ToHost totalSum - let resultLength = totalSum.[0] - - if resultLength = 0 then - return - { Size = matrix.RowCount - Indices = [||] - Values = [||] } - - else - let getOutputVector = - <@ fun (range: Range1D) (count: int []) (values: 'a []) (positions: int []) (outputValues: 'a []) (outputIndices: int []) -> - - let gid = range.GlobalID0 - - if gid < rowCount && count.[gid] <> 0 then - outputValues.[positions.[gid]] <- values.[gid] - outputIndices.[positions.[gid]] <- gid @> - - let outputValues = Array.zeroCreate<'a> resultLength - let outputIndices = Array.zeroCreate resultLength - - do! - runCommand getOutputVector - <| fun kernelPrepare -> - kernelPrepare - <| Range1D(Utils.getDefaultGlobalSize rowCount, Utils.defaultWorkGroupSize) - <| countOfProductsPerRow - <| valuesPerRow - <| positions - <| outputValues - <| outputIndices - - return - { Size = rowCount - Indices = outputIndices - Values = outputValues } - } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Transpose.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Transpose.fs deleted file mode 100644 index a73ebd8b..00000000 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Transpose.fs +++ /dev/null @@ -1,225 +0,0 @@ -namespace GraphBLAS.FSharp.Backend.CSRMatrix - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp -open GraphBLAS.FSharp.Backend.Common - -module internal rec Transpose = - let transposeMatrix (matrix: CSRMatrix<'a>) = - opencl { - if matrix.Values.Length = 0 then - return - { RowCount = matrix.ColumnCount - ColumnCount = matrix.RowCount - RowPointers = [| 0; 0 |] - ColumnIndices = [||] - Values = [||] } - else - let! coo = csr2coo matrix - let! packedIndices = pack coo.Columns coo.Rows - - do! BitonicSort.sortKeyValuesInplace packedIndices coo.Values - let! (rows, cols) = unpack packedIndices - - let! compressedRows = compressRows matrix.ColumnCount rows - - return - { RowCount = matrix.ColumnCount - ColumnCount = matrix.RowCount - RowPointers = compressedRows - ColumnIndices = cols - Values = coo.Values } - } - - let private csr2coo (matrix: CSRMatrix<'a>) = - opencl { - let wgSize = Utils.defaultWorkGroupSize - - let expandRows = - <@ fun (range: Range1D) (rowPointers: int []) (rowIndices: int []) -> - - let lid = range.LocalID0 - let groupId = range.GlobalID0 / wgSize - - let rowStart = rowPointers.[groupId] - let rowEnd = rowPointers.[groupId + 1] - let rowLength = rowEnd - rowStart - - let mutable i = lid - - while i < rowLength do - rowIndices.[rowStart + i] <- groupId - i <- i + wgSize @> - - let rowIndices = - Array.zeroCreate matrix.Values.Length - - do! - runCommand expandRows - <| fun kernelPrepare -> - kernelPrepare - <| Range1D(wgSize * matrix.RowCount, wgSize) - <| matrix.RowPointers - <| rowIndices - - let! colIndices = Copy.copyArray matrix.ColumnIndices - let! values = Copy.copyArray matrix.Values - - return - { RowCount = matrix.RowCount - ColumnCount = matrix.ColumnCount - Rows = rowIndices - Columns = colIndices - Values = values } - } - - let private pack (firstArray: int []) (secondArray: int []) = - opencl { - let length = firstArray.Length - - let kernel = - <@ fun (range: Range1D) (firstArray: int []) (secondArray: int []) (packed: uint64 []) -> - - let gid = range.GlobalID0 - - if gid < length then - packed.[gid] <- - (uint64 firstArray.[gid] <<< 32) - ||| (uint64 secondArray.[gid]) @> - - let packedArray = Array.zeroCreate length - - do! - runCommand kernel - <| fun kernelPrepare -> - kernelPrepare - <| Range1D(Utils.getDefaultGlobalSize length, Utils.defaultWorkGroupSize) - <| firstArray - <| secondArray - <| packedArray - - return packedArray - } - - let private unpack (packedArray: uint64 []) = - opencl { - let length = packedArray.Length - - let kernel = - <@ fun (range: Range1D) (packedArray: uint64 []) (firstArray: int []) (secondArray: int []) -> - - let gid = range.GlobalID0 - - if gid < length then - firstArray.[gid] <- int ((packedArray.[gid] &&& 0xFFFFFFFF0000000UL) >>> 32) - secondArray.[gid] <- int (packedArray.[gid] &&& 0xFFFFFFFUL) @> - - let firstArray = Array.zeroCreate length - let secondArray = Array.zeroCreate length - - do! - runCommand kernel - <| fun kernelPrepare -> - kernelPrepare - <| Range1D(Utils.getDefaultGlobalSize length, Utils.defaultWorkGroupSize) - <| packedArray - <| firstArray - <| secondArray - - return firstArray, secondArray - } - - let private compressRows rowCount (rowIndices: int []) = - opencl { - let nnz = rowIndices.Length - - let getUniqueBitmap = - <@ fun (ndRange: Range1D) (inputArray: int []) (isUniqueBitmap: int []) -> - - let i = ndRange.GlobalID0 - - if i < nnz - 1 && inputArray.[i] = inputArray.[i + 1] then - isUniqueBitmap.[i] <- 0 @> - - let bitmap = Array.create nnz 1 - - do! - runCommand getUniqueBitmap - <| fun kernelPrepare -> - kernelPrepare - <| Range1D(Utils.getDefaultGlobalSize nnz, Utils.defaultWorkGroupSize) - <| rowIndices - <| bitmap - - let! (positions, totalSum) = PrefixSum.runExclude bitmap - failwith "FIX ME! And rewrite." - //let! _ = ToHost totalSum - let totalSum = totalSum.[0] - - let calcHyperSparseRows = - <@ fun (ndRange: Range1D) (rowsIndices: int []) (bitmap: int []) (positions: int []) (nonZeroRowsIndices: int []) (nonZeroRowsPointers: int []) -> - - let gid = ndRange.GlobalID0 - - if gid < nnz && bitmap.[gid] = 1 then - nonZeroRowsIndices.[positions.[gid]] <- rowsIndices.[gid] - nonZeroRowsPointers.[positions.[gid]] <- gid + 1 @> - - let nonZeroRowsIndices = Array.zeroCreate totalSum - let nonZeroRowsPointers = Array.zeroCreate totalSum - - do! - runCommand calcHyperSparseRows - <| fun kernelPrepare -> - kernelPrepare - <| Range1D(Utils.getDefaultGlobalSize nnz, Utils.defaultWorkGroupSize) - <| rowIndices - <| bitmap - <| positions - <| nonZeroRowsIndices - <| nonZeroRowsPointers - - let calcNnzPerRowSparse = - <@ fun (ndRange: Range1D) (nonZeroRowsPointers: int []) (nnzPerRowSparse: int []) -> - - let gid = ndRange.GlobalID0 - - if gid = 0 then - nnzPerRowSparse.[gid] <- nonZeroRowsPointers.[gid] - elif gid < totalSum then - nnzPerRowSparse.[gid] <- - nonZeroRowsPointers.[gid] - - nonZeroRowsPointers.[gid - 1] @> - - let nnzPerRowSparse = Array.zeroCreate totalSum - - do! - runCommand calcNnzPerRowSparse - <| fun kernelPrepare -> - kernelPrepare - <| Range1D(Utils.getDefaultGlobalSize totalSum, Utils.defaultWorkGroupSize) - <| nonZeroRowsPointers - <| nnzPerRowSparse - - let expandSparseNnzPerRow = - <@ fun (ndRange: Range1D) (nnzPerRowSparse: int []) (nonZeroRowsIndices: int []) (off2: int []) -> - - let gid = ndRange.GlobalID0 - - if gid < totalSum then - off2.[nonZeroRowsIndices.[gid] + 1] <- nnzPerRowSparse.[gid] @> - - let expandedNnzPerRow = Array.zeroCreate (rowCount + 1) - - do! - runCommand expandSparseNnzPerRow - <| fun kernelPrepare -> - kernelPrepare - <| Range1D(Utils.getDefaultGlobalSize totalSum, Utils.defaultWorkGroupSize) - <| nnzPerRowSparse - <| nonZeroRowsIndices - <| expandedNnzPerRow - - let! (rowPointers, _) = PrefixSum.runInclude expandedNnzPerRow - return rowPointers - } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs index ea26fd7f..edf5efef 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs @@ -17,7 +17,7 @@ module Common = Scatter.lastOccurrence clContext workGroupSize let sum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (allRows: ClArray) (allColumns: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> @@ -60,7 +60,7 @@ module Common = ClArray.zeroCreate clContext workGroupSize let scan = - PrefixSum.runIncludeInplace <@ max @> clContext workGroupSize + PrefixSum.runIncludeInPlace <@ max @> clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (rowPointers: ClArray) nnz rowCount -> diff --git a/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs new file mode 100644 index 00000000..34eff782 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs @@ -0,0 +1,45 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.LIL + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ClMatrix + +module Matrix = + let toCSR (clContext: ClContext) workGroupSize = + + let concatIndices = ClArray.concat clContext workGroupSize + + let concatValues = ClArray.concat clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: LIL<'a>) -> + + let rowsPointers = + matrix.Rows + |> List.map + (function + | None -> 0 + | Some vector -> vector.Values.Length) + |> List.toArray + // prefix sum + |> Array.scan (+) 0 + |> fun pointers -> clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, pointers) + + let valuesByRows, columnsIndicesByRows = + matrix.Rows + |> List.choose id + |> List.map (fun vector -> vector.Values, vector.Indices) + |> List.unzip + + let values = + concatValues processor allocationMode valuesByRows + + let columnsIndices = + concatIndices processor allocationMode columnsIndicesByRows + + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + RowPointers = rowsPointers + Columns = columnsIndices + Values = values } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 3458a4f8..b8df2c6c 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -6,13 +6,18 @@ open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Matrix open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix +open GraphBLAS.FSharp.Backend.Vector module Matrix = let copy (clContext: ClContext) workGroupSize = + let copy = ClArray.copy clContext workGroupSize let copyData = ClArray.copy clContext workGroupSize + let vectorCopy = + Sparse.Vector.copy clContext workGroupSize + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO m -> @@ -39,6 +44,16 @@ module Matrix = Rows = copy processor allocationMode m.Rows ColumnPointers = copy processor allocationMode m.ColumnPointers Values = copyData processor allocationMode m.Values } + | ClMatrix.LIL matrix -> + matrix.Rows + |> List.map (Option.map (vectorCopy processor allocationMode)) + |> fun rows -> + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + Rows = rows + NNZ = matrix.NNZ } + |> ClMatrix.LIL /// /// Creates a new matrix, represented in CSR format, that is equal to the given one. @@ -53,6 +68,8 @@ module Matrix = let transpose = CSR.Matrix.transpose clContext workGroupSize + let rowsToCSR = LIL.Matrix.toCSR clContext workGroupSize + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO m -> toCSR processor allocationMode m |> ClMatrix.CSR @@ -61,6 +78,9 @@ module Matrix = m.ToCSR |> transpose processor allocationMode |> ClMatrix.CSR + | ClMatrix.LIL m -> + rowsToCSR processor allocationMode m + |> ClMatrix.CSR /// /// Returns the matrix, represented in CSR format, that is equal to the given one. @@ -68,23 +88,24 @@ module Matrix = /// ///OpenCL context. ///Should be a power of 2 and greater than 1. - let toCSRInplace (clContext: ClContext) workGroupSize = - let toCSRInplace = - COO.Matrix.toCSRInplace clContext workGroupSize + let toCSRInPlace (clContext: ClContext) workGroupSize = + let toCSRInPlace = + COO.Matrix.toCSRInPlace clContext workGroupSize - let transposeInplace = + let transposeInPlace = CSR.Matrix.transposeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO m -> - toCSRInplace processor allocationMode m + toCSRInPlace processor allocationMode m |> ClMatrix.CSR | ClMatrix.CSR _ -> matrix | ClMatrix.CSC m -> m.ToCSR - |> transposeInplace processor allocationMode + |> transposeInPlace processor allocationMode |> ClMatrix.CSR + | _ -> failwith "Not yet implemented" /// /// Creates a new matrix, represented in COO format, that is equal to the given one. @@ -96,8 +117,10 @@ module Matrix = let copy = copy clContext workGroupSize - let transposeInplace = - COO.Matrix.transposeInplace clContext workGroupSize + let transposeInPlace = + COO.Matrix.transposeInPlace clContext workGroupSize + + let rowsToCSR = LIL.Matrix.toCSR clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with @@ -106,7 +129,11 @@ module Matrix = | ClMatrix.CSC m -> m.ToCSR |> toCOO processor allocationMode - |> transposeInplace processor + |> transposeInPlace processor + |> ClMatrix.COO + | ClMatrix.LIL m -> + rowsToCSR processor allocationMode m + |> toCOO processor allocationMode |> ClMatrix.COO /// @@ -115,24 +142,25 @@ module Matrix = /// ///OpenCL context. ///Should be a power of 2 and greater than 1. - let toCOOInplace (clContext: ClContext) workGroupSize = - let toCOOInplace = + let toCOOInPlace (clContext: ClContext) workGroupSize = + let toCOOInPlace = CSR.Matrix.toCOOInPlace clContext workGroupSize - let transposeInplace = - COO.Matrix.transposeInplace clContext workGroupSize + let transposeInPlace = + COO.Matrix.transposeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO _ -> matrix | ClMatrix.CSR m -> - toCOOInplace processor allocationMode m + toCOOInPlace processor allocationMode m |> ClMatrix.COO | ClMatrix.CSC m -> m.ToCSR - |> toCOOInplace processor allocationMode - |> transposeInplace processor + |> toCOOInPlace processor allocationMode + |> transposeInPlace processor |> ClMatrix.COO + | _ -> failwith "Not yet implemented" /// /// Creates a new matrix, represented in CSC format, that is equal to the given one. @@ -140,7 +168,7 @@ module Matrix = ///OpenCL context. ///Should be a power of 2 and greater than 1. let toCSC (clContext: ClContext) workGroupSize = - let toCSR = COO.Matrix.toCSR clContext workGroupSize + let COOtoCSR = COO.Matrix.toCSR clContext workGroupSize let copy = copy clContext workGroupSize @@ -150,6 +178,8 @@ module Matrix = let transposeCOO = COO.Matrix.transpose clContext workGroupSize + let rowsToCSR = LIL.Matrix.toCSR clContext workGroupSize + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.CSC _ -> copy processor allocationMode matrix @@ -158,9 +188,14 @@ module Matrix = |> ClMatrix.CSC | ClMatrix.COO m -> (transposeCOO processor allocationMode m - |> toCSR processor allocationMode) + |> COOtoCSR processor allocationMode) .ToCSC |> ClMatrix.CSC + | ClMatrix.LIL m -> + rowsToCSR processor allocationMode m + |> transposeCSR processor allocationMode + |> fun m -> m.ToCSC + |> ClMatrix.CSC /// /// Returns the matrix, represented in CSC format, that is equal to the given one. @@ -168,50 +203,86 @@ module Matrix = /// ///OpenCL context. ///Should be a power of 2 and greater than 1. - let toCSCInplace (clContext: ClContext) workGroupSize = - let toCSRInplace = - COO.Matrix.toCSRInplace clContext workGroupSize + let toCSCInPlace (clContext: ClContext) workGroupSize = + let toCSRInPlace = + COO.Matrix.toCSRInPlace clContext workGroupSize - let transposeCSRInplace = + let transposeCSRInPlace = CSR.Matrix.transposeInPlace clContext workGroupSize - let transposeCOOInplace = - COO.Matrix.transposeInplace clContext workGroupSize + let transposeCOOInPlace = + COO.Matrix.transposeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.CSC _ -> matrix | ClMatrix.CSR m -> - (transposeCSRInplace processor allocationMode m) + (transposeCSRInPlace processor allocationMode m) .ToCSC |> ClMatrix.CSC | ClMatrix.COO m -> - (transposeCOOInplace processor m - |> toCSRInplace processor allocationMode) + (transposeCOOInPlace processor m + |> toCSRInPlace processor allocationMode) .ToCSC |> ClMatrix.CSC + | _ -> failwith "Not yet implemented" + + let toLIL (clContext: ClContext) workGroupSize = + + let copy = copy clContext workGroupSize - let map (clContext: ClContext) (opAdd: Expr<'a option -> 'b option>) workGroupSize = + let COOToCSR = COO.Matrix.toCSR clContext workGroupSize + + let transposeCSR = + CSR.Matrix.transpose clContext workGroupSize + + let CSRToLIL = CSR.Matrix.toLIL clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + match matrix with + | ClMatrix.CSC m -> + m.ToCSR + |> transposeCSR processor allocationMode + |> CSRToLIL processor allocationMode + |> ClMatrix.LIL + | ClMatrix.CSR m -> + CSRToLIL processor allocationMode m + |> ClMatrix.LIL + | ClMatrix.COO m -> + COOToCSR processor allocationMode m + |> CSRToLIL processor allocationMode + |> ClMatrix.LIL + | ClMatrix.LIL _ -> copy processor allocationMode matrix + + let map (opAdd: Expr<'a option -> 'b option>) (clContext: ClContext) workGroupSize = let mapCOO = - COO.Matrix.map clContext opAdd workGroupSize + COO.Matrix.map opAdd clContext workGroupSize let mapCSR = - CSR.Matrix.map clContext opAdd workGroupSize + CSR.Matrix.map opAdd clContext workGroupSize + + let transposeCOO = + COO.Matrix.transposeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode matrix -> match matrix with | ClMatrix.COO m -> mapCOO processor allocationMode m |> ClMatrix.COO - | ClMatrix.CSR m -> mapCSR processor allocationMode m |> ClMatrix.CSR + | ClMatrix.CSR m -> mapCSR processor allocationMode m |> ClMatrix.COO | ClMatrix.CSC m -> - (mapCSR processor allocationMode m.ToCSR).ToCSC - |> ClMatrix.CSC + (mapCSR processor allocationMode m.ToCSR) + |> transposeCOO processor + |> ClMatrix.COO + | _ -> failwith "Not yet implemented" - let map2 (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = // TODO() + let map2 (opAdd: Expr<'a option -> 'b option -> 'c option>) (clContext: ClContext) workGroupSize = let map2COO = - COO.Matrix.map2 clContext opAdd workGroupSize + COO.Matrix.map2 opAdd clContext workGroupSize let map2CSR = - CSR.Matrix.map2 clContext opAdd workGroupSize + CSR.Matrix.map2 opAdd clContext workGroupSize + + let transposeCOO = + COO.Matrix.transposeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> match matrix1, matrix2 with @@ -220,55 +291,34 @@ module Matrix = |> ClMatrix.COO | ClMatrix.CSR m1, ClMatrix.CSR m2 -> map2CSR processor allocationMode m1 m2 - |> ClMatrix.CSR + |> ClMatrix.COO | ClMatrix.CSC m1, ClMatrix.CSC m2 -> (map2CSR processor allocationMode m1.ToCSR m2.ToCSR) - .ToCSC - |> ClMatrix.CSC - | _ -> failwith "Matrix formats are not matching" - - let map2AtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = - let COOElementwise = - COO.Matrix.map2AtLeastOne clContext opAdd workGroupSize - - let CSRElementwise = - CSR.Matrix.map2AtLeastOne clContext opAdd workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> - match matrix1, matrix2 with - | ClMatrix.COO m1, ClMatrix.COO m2 -> - COOElementwise processor allocationMode m1 m2 + |> transposeCOO processor |> ClMatrix.COO - | ClMatrix.CSR m1, ClMatrix.CSR m2 -> - CSRElementwise processor allocationMode m1 m2 - |> ClMatrix.CSR - | ClMatrix.CSC m1, ClMatrix.CSC m2 -> - (CSRElementwise processor allocationMode m1.ToCSR m2.ToCSR) - .ToCSC - |> ClMatrix.CSC | _ -> failwith "Matrix formats are not matching" - let map2AtLeastOneToCOO (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = - let COOElementwise = + let map2AtLeastOne (opAdd: Expr -> 'c option>) (clContext: ClContext) workGroupSize = + let COOMap2 = COO.Matrix.map2AtLeastOne clContext opAdd workGroupSize - let CSRElementwise = - CSR.Matrix.map2AtLeastOneToCOO clContext opAdd workGroupSize + let CSRMap2 = + CSR.Matrix.map2AtLeastOne clContext opAdd workGroupSize - let transposeCOOInplace = - COO.Matrix.transposeInplace clContext workGroupSize + let COOTranspose = + COO.Matrix.transposeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> match matrix1, matrix2 with | ClMatrix.COO m1, ClMatrix.COO m2 -> - COOElementwise processor allocationMode m1 m2 + COOMap2 processor allocationMode m1 m2 |> ClMatrix.COO | ClMatrix.CSR m1, ClMatrix.CSR m2 -> - CSRElementwise processor allocationMode m1 m2 + CSRMap2 processor allocationMode m1 m2 |> ClMatrix.COO | ClMatrix.CSC m1, ClMatrix.CSC m2 -> - CSRElementwise processor allocationMode m1.ToCSR m2.ToCSR - |> transposeCOOInplace processor + (CSRMap2 processor allocationMode m1.ToCSR m2.ToCSR) + |> COOTranspose processor |> ClMatrix.COO | _ -> failwith "Matrix formats are not matching" @@ -285,15 +335,16 @@ module Matrix = /// ///OpenCL context. ///Should be a power of 2 and greater than 1. - let transposeInplace (clContext: ClContext) workGroupSize = - let COOtransposeInplace = - COO.Matrix.transposeInplace clContext workGroupSize + let transposeInPlace (clContext: ClContext) workGroupSize = + let COOTransposeInPlace = + COO.Matrix.transposeInPlace clContext workGroupSize fun (processor: MailboxProcessor<_>) matrix -> match matrix with - | ClMatrix.COO m -> COOtransposeInplace processor m |> ClMatrix.COO + | ClMatrix.COO m -> COOTransposeInPlace processor m |> ClMatrix.COO | ClMatrix.CSR m -> ClMatrix.CSC m.ToCSC | ClMatrix.CSC m -> ClMatrix.CSR m.ToCSR + | ClMatrix.LIL _ -> failwith "Not yet implemented" /// /// Transposes the given matrix and returns result as a new matrix. @@ -308,7 +359,7 @@ module Matrix = ///OpenCL context. ///Should be a power of 2 and greater than 1. let transpose (clContext: ClContext) workGroupSize = - let COOtranspose = + let COOTranspose = COO.Matrix.transpose clContext workGroupSize let copy = ClArray.copy clContext workGroupSize @@ -318,7 +369,7 @@ module Matrix = fun (processor: MailboxProcessor<_>) allocationMode matrix -> match matrix with | ClMatrix.COO m -> - COOtranspose processor allocationMode m + COOTranspose processor allocationMode m |> ClMatrix.COO | ClMatrix.CSR m -> { Context = m.Context @@ -336,6 +387,7 @@ module Matrix = Columns = copy processor allocationMode m.Rows Values = copyData processor allocationMode m.Values } |> ClMatrix.CSR + | ClMatrix.LIL _ -> failwith "Not yet implemented" module SpGeMM = let masked @@ -346,7 +398,7 @@ module Matrix = = let runCSRnCSC = - CSR.Matrix.SpGeMM.masked clContext workGroupSize opAdd opMul + SpGeMM.Masked.run opAdd opMul clContext workGroupSize fun (queue: MailboxProcessor<_>) (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) (mask: ClMatrix<_>) -> match matrix1, matrix2, mask with @@ -354,18 +406,18 @@ module Matrix = | _ -> failwith "Matrix formats are not matching" let expand - (clContext: ClContext) - workGroupSize (opAdd: Expr<'c -> 'c -> 'c option>) (opMul: Expr<'a -> 'b -> 'c option>) + (clContext: ClContext) + workGroupSize = let run = - CSR.Matrix.SpGeMM.expand clContext workGroupSize opAdd opMul + SpGeMM.Expand.run 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 + ClMatrix.LIL + <| run processor allocationMode leftMatrix rightMatrix | _ -> failwith "Matrix formats are not matching" diff --git a/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs new file mode 100644 index 00000000..38cb28bb --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Expand.fs @@ -0,0 +1,333 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.SpGeMM + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Common.Sort +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClCell +open FSharp.Quotations +open GraphBLAS.FSharp.Backend.Objects.ClVector +open GraphBLAS.FSharp.Backend.Objects.ClMatrix + +module Expand = + let getSegmentPointers (clContext: ClContext) workGroupSize = + + let gather = Gather.run clContext workGroupSize + + let prefixSum = + PrefixSum.standardExcludeInPlace clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (leftMatrixRow: ClVector.Sparse<'a>) (rightMatrixRowsLengths: ClArray) -> + + let segmentsLengths = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrixRow.NNZ) + + // extract needed lengths by left matrix nnz + gather processor leftMatrixRow.Indices rightMatrixRowsLengths segmentsLengths + + // compute pointers + let length = + (prefixSum processor segmentsLengths) + .ToHostAndFree processor + + length, segmentsLengths + + let expand (clContext: ClContext) workGroupSize = + + let idScatter = + Scatter.initLastOccurrence Map.id clContext workGroupSize + + let scatter = + Scatter.lastOccurrence clContext workGroupSize + + let zeroCreate = + ClArray.zeroCreate clContext workGroupSize + + let maxPrefixSum = + PrefixSum.runIncludeInPlace <@ max @> clContext workGroupSize + + let create = ClArray.create clContext workGroupSize + + let gather = Gather.run clContext workGroupSize + + let segmentPrefixSum = + PrefixSum.ByKey.sequentialInclude <@ (+) @> 0 clContext workGroupSize + + let removeDuplicates = + ClArray.removeDuplications clContext workGroupSize + + let leftMatrixGather = Gather.run clContext workGroupSize + + let rightMatrixGather = Gather.run clContext workGroupSize + + fun (processor: MailboxProcessor<_>) length (segmentsPointers: ClArray) (leftMatrixRow: ClVector.Sparse<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + if length = 0 then + None + else + // Compute left matrix positions + let leftMatrixPositions = zeroCreate processor DeviceOnly length + + idScatter processor segmentsPointers leftMatrixPositions + + (maxPrefixSum processor leftMatrixPositions 0) + .Free processor + + // Compute right matrix positions + let rightMatrixPositions = create processor DeviceOnly length 1 + + let requiredRightMatrixPointers = + zeroCreate processor DeviceOnly leftMatrixRow.Indices.Length + + gather processor leftMatrixRow.Indices rightMatrix.RowPointers requiredRightMatrixPointers + + scatter processor segmentsPointers requiredRightMatrixPointers rightMatrixPositions + + requiredRightMatrixPointers.Free processor + + // another way to get offsets ??? + let offsets = + removeDuplicates processor segmentsPointers + + segmentPrefixSum processor offsets.Length rightMatrixPositions leftMatrixPositions offsets + + offsets.Free processor + + // compute columns + let columns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) + + gather processor rightMatrixPositions rightMatrix.Columns columns + + // compute left matrix values + let leftMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) + + leftMatrixGather processor leftMatrixPositions leftMatrixRow.Values leftMatrixValues + + leftMatrixPositions.Free processor + + // compute right matrix values + let rightMatrixValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, length) + + rightMatrixGather processor rightMatrixPositions rightMatrix.Values rightMatrixValues + + rightMatrixPositions.Free processor + + // left, right matrix values, columns indices + Some(leftMatrixValues, rightMatrixValues, columns) + + let multiply (clContext: ClContext) workGroupSize (predicate: Expr<'a -> 'b -> 'c option>) = + let getBitmap = + ClArray.map2<'a, 'b, int> (Map.choose2Bitmap predicate) clContext workGroupSize + + let prefixSum = + PrefixSum.standardExcludeInPlace clContext workGroupSize + + let assignValues = + ClArray.assignOption2 predicate clContext workGroupSize + + let scatter = + Scatter.lastOccurrence clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (columns: ClArray) -> + + let positions = + getBitmap processor DeviceOnly firstValues secondValues + + let resultLength = + (prefixSum processor positions) + .ToHostAndFree(processor) + + if resultLength = 0 then + positions.Free processor + + None + else + let resultIndices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + scatter processor positions columns resultIndices + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + assignValues processor firstValues secondValues positions resultValues + + positions.Free processor + + Some(resultValues, resultIndices) + + let sortByColumns (clContext: ClContext) workGroupSize = + + let sortByKeyValues = + Radix.runByKeysStandard clContext workGroupSize + + let sortKeys = + Radix.standardRunKeysOnly clContext workGroupSize + + fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (columns: ClArray) -> + // sort by columns + let sortedValues = + sortByKeyValues processor DeviceOnly columns values + + let sortedColumns = sortKeys processor columns + + sortedValues, sortedColumns + + let reduce (clContext: ClContext) workGroupSize opAdd = + + let reduce = + Reduce.ByKey.Option.segmentSequential opAdd clContext workGroupSize + + let getUniqueBitmap = + ClArray.getUniqueBitmapLastOccurrence clContext workGroupSize + + let prefixSum = + PrefixSum.standardExcludeInPlace clContext workGroupSize + + let idScatter = + Scatter.initFirsOccurrence Map.id clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: ClArray) -> + + let bitmap = + getUniqueBitmap processor DeviceOnly columns + + let uniqueKeysCount = + (prefixSum processor bitmap) + .ToHostAndFree processor + + let offsets = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) + + idScatter processor bitmap offsets + + bitmap.Free processor + + let reduceResult = // by size variance TODO() + reduce processor allocationMode uniqueKeysCount offsets columns values + + offsets.Free processor + + reduceResult + + let runRow (clContext: ClContext) workGroupSize opAdd opMul = + let getSegmentPointers = + getSegmentPointers clContext workGroupSize + + let expand = expand clContext workGroupSize + + let multiply = multiply clContext workGroupSize opMul + + let sort = sortByColumns clContext workGroupSize + + let reduce = reduce clContext workGroupSize opAdd + + // left matrix last --- for curring + fun (processor: MailboxProcessor<_>) allocationMode (rightMatrix: ClMatrix.CSR<'b>) (leftMatrixRowsLengths: ClArray) (leftMatrixRow: ClVector.Sparse<'a>) -> + // TODO(sort in range) + // required right matrix lengths + let length, segmentPointers = + getSegmentPointers processor leftMatrixRow leftMatrixRowsLengths + + // expand + let expandResult = + expand processor length segmentPointers leftMatrixRow rightMatrix + + segmentPointers.Free processor + + expandResult + |> Option.bind + (fun (leftMatrixValues, rightMatrixValues, columns) -> + // multiplication + let mulResult = + multiply processor leftMatrixValues rightMatrixValues columns + + leftMatrixValues.Free processor + rightMatrixValues.Free processor + columns.Free processor + + // check multiplication result + mulResult + |> Option.bind + (fun (resultValues, resultColumns) -> + // sort + let sortedValues, sortedColumns = + sort processor resultValues resultColumns + + resultValues.Free processor + resultColumns.Free processor + + let reduceResult = + reduce processor allocationMode sortedValues sortedColumns + + sortedValues.Free processor + sortedColumns.Free processor + + // create sparse vector (TODO(empty vector)) + reduceResult + |> Option.map + (fun (values, columns) -> + { Context = clContext + Indices = columns + Values = values + Size = rightMatrix.ColumnCount }))) + + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + (clContext: ClContext) + workGroupSize + opAdd + (opMul: Expr<'a -> 'b -> 'c option>) + = + + let getNNZInRows = + CSR.Matrix.NNZInRows clContext workGroupSize + + let split = + CSR.Matrix.byRowsLazy clContext workGroupSize + + let runRow = + runRow clContext workGroupSize opAdd opMul + + fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + + let rightMatrixRowsLengths = + getNNZInRows processor DeviceOnly rightMatrix + + let runRow = + runRow processor allocationMode rightMatrix rightMatrixRowsLengths + + split processor allocationMode leftMatrix + |> Seq.map + (fun lazyRow -> + Option.bind + (fun row -> + let result = runRow row + row.Dispose processor + + result) + lazyRow.Value) + |> Seq.toList + |> fun rows -> + rightMatrixRowsLengths.Free processor + + // compute nnz + let nnz = + rows + |> Seq.fold + (fun count -> + function + | Some row -> count + row.Size + | None -> count) + 0 + + { LIL.Context = clContext + RowCount = leftMatrix.RowCount + ColumnCount = rightMatrix.ColumnCount + Rows = rows + NNZ = nnz } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Masked.fs b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Masked.fs similarity index 91% rename from src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Masked.fs rename to src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Masked.fs index b4f3fcbd..700018c3 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/SpGEMM/Masked.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/SpGeMM/Masked.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM +namespace GraphBLAS.FSharp.Backend.Matrix.SpGeMM open GraphBLAS.FSharp.Backend.Common open Brahma.FSharp @@ -10,10 +10,10 @@ open GraphBLAS.FSharp.Backend.Objects.ClCell module internal Masked = let private calculate - (context: ClContext) - workGroupSize (opAdd: Expr<'c -> 'c -> 'c option>) (opMul: Expr<'a -> 'b -> 'c option>) + (context: ClContext) + workGroupSize = let run = @@ -142,14 +142,14 @@ module internal Masked = values, bitmap let run - (context: ClContext) - workGroupSize (opAdd: Expr<'c -> 'c -> 'c option>) (opMul: Expr<'a -> 'b -> 'c option>) + (context: ClContext) + workGroupSize = let calculate = - calculate context workGroupSize opAdd opMul + calculate opAdd opMul context workGroupSize let scatter = Scatter.lastOccurrence context workGroupSize @@ -157,8 +157,8 @@ module internal Masked = let scatterData = Scatter.lastOccurrence context workGroupSize - let scanInplace = - PrefixSum.standardExcludeInplace context workGroupSize + let scanInPlace = + PrefixSum.standardExcludeInPlace context workGroupSize fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> @@ -166,15 +166,15 @@ module internal Masked = calculate queue matrixLeft matrixRight mask let resultNNZ = - (scanInplace queue positions).ToHostAndFree(queue) + (scanInPlace queue positions).ToHostAndFree(queue) let resultRows = context.CreateClArray resultNNZ - let resultCols = context.CreateClArray resultNNZ - let resultVals = context.CreateClArray<'c> resultNNZ + let resultColumns = context.CreateClArray resultNNZ + let resultValues = context.CreateClArray<'c> resultNNZ scatter queue positions mask.Rows resultRows - scatter queue positions mask.Columns resultCols - scatterData queue positions values resultVals + scatter queue positions mask.Columns resultColumns + scatterData queue positions values resultValues queue.Post(Msg.CreateFreeMsg<_>(values)) queue.Post(Msg.CreateFreeMsg<_>(positions)) @@ -183,5 +183,5 @@ module internal Masked = RowCount = matrixLeft.RowCount ColumnCount = matrixRight.ColumnCount Rows = resultRows - Columns = resultCols - Values = resultVals } + Columns = resultColumns + Values = resultValues } diff --git a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs index 1603a010..650c40b3 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs @@ -6,6 +6,7 @@ type MatrixFormat = | CSR | COO | CSC + | LIL module ClMatrix = type CSR<'elem when 'elem: struct> = @@ -81,6 +82,19 @@ module ClMatrix = member this.NNZ = this.Values.Length + type LIL<'elem when 'elem: struct> = + { Context: ClContext + RowCount: int + ColumnCount: int + Rows: ClVector.Sparse<'elem> option list + NNZ: int } + + interface IDeviceMemObject with + member this.Dispose q = + this.Rows + |> Seq.choose id + |> Seq.iter (fun vector -> vector.Dispose q) + type Tuple<'elem when 'elem: struct> = { Context: ClContext RowIndices: ClArray @@ -103,27 +117,32 @@ type ClMatrix<'a when 'a: struct> = | CSR of ClMatrix.CSR<'a> | COO of ClMatrix.COO<'a> | CSC of ClMatrix.CSC<'a> + | LIL of ClMatrix.LIL<'a> member this.RowCount = match this with | ClMatrix.CSR matrix -> matrix.RowCount | ClMatrix.COO matrix -> matrix.RowCount | ClMatrix.CSC matrix -> matrix.RowCount + | ClMatrix.LIL matrix -> matrix.RowCount member this.ColumnCount = match this with | ClMatrix.CSR matrix -> matrix.ColumnCount | ClMatrix.COO matrix -> matrix.ColumnCount | ClMatrix.CSC matrix -> matrix.ColumnCount + | ClMatrix.LIL matrix -> matrix.ColumnCount member this.Dispose q = match this with - | ClMatrix.CSR matrix -> matrix.Dispose q - | ClMatrix.COO matrix -> matrix.Dispose q - | ClMatrix.CSC matrix -> matrix.Dispose q + | ClMatrix.CSR matrix -> (matrix :> IDeviceMemObject).Dispose q + | ClMatrix.COO matrix -> (matrix :> IDeviceMemObject).Dispose q + | ClMatrix.CSC matrix -> (matrix :> IDeviceMemObject).Dispose q + | ClMatrix.LIL matrix -> (matrix :> IDeviceMemObject).Dispose q member this.NNZ = match this with | ClMatrix.CSR matrix -> matrix.NNZ | ClMatrix.COO matrix -> matrix.NNZ | ClMatrix.CSC matrix -> matrix.NNZ + | ClMatrix.LIL matrix -> matrix.NNZ diff --git a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs index fb8cdcc8..f7430242 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs @@ -22,6 +22,8 @@ module ClVector = member this.Dispose(q) = (this :> IDeviceMemObject).Dispose(q) + member this.NNZ = this.Values.Length + [] type ClVector<'a when 'a: struct> = | Sparse of ClVector.Sparse<'a> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 5e0ba6c4..737f196e 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -56,7 +56,7 @@ module ArithmeticOperations = if res = zero then None else Some res @> - let boolSum = + let boolSumOption = <@ fun (x: bool option) (y: bool option) -> let mutable res = false diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs b/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs index 774b41f2..d779ba5a 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Convert.fs @@ -23,3 +23,11 @@ module Convert = match rightItem with | Some _ -> (%op) leftItem None | None -> (%op) leftItem (Some value) @> + + let map2ToMapLeftNone (op: Expr<'a option -> 'b option -> 'c option>) = + <@ fun rightItem -> (%op) None rightItem @> + + let map2ToMapRightNone (op: Expr<'a option -> 'b option -> 'c option>) = + <@ fun leftItem -> (%op) leftItem None @> + + let map2ToNoneNone (op: Expr<'a option -> 'b option -> 'c option>) = <@ (%op) None None @> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs index f0750dac..2f74a7c5 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs @@ -22,7 +22,7 @@ module Map = | Some _ -> 1 | None -> 0 @> - let chooseBitmap2<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c option>) = + let choose2Bitmap<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c option>) = <@ fun (leftItem: 'a) (rightItem: 'b) -> match (%map) leftItem rightItem with | Some _ -> 1 diff --git a/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs b/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs index b16d4ebc..1fbcaa0a 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/SubSum.fs @@ -72,6 +72,4 @@ module SubSum = barrierLocal () array.[lid] <- value @> - - let localIntPrefixSum = localPrefixSum <@ (+) @> diff --git a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs similarity index 75% rename from src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs rename to src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs index 3d37a595..53f8de3e 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/DenseVector/DenseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs @@ -8,15 +8,15 @@ open GraphBLAS.FSharp.Backend.Objects.ClVector open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClCell -module DenseVector = - let map2Inplace<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> - (clContext: ClContext) +module Vector = + let map2InPlace<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (opAdd: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = let map2InPlace = - ClArray.map2Inplace clContext workGroupSize opAdd + ClArray.map2InPlace opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> @@ -24,25 +24,25 @@ module DenseVector = let map2<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> - (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = let map2 = - ClArray.map2 clContext workGroupSize opAdd + ClArray.map2 opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> map2 processor allocationMode leftVector rightVector - let map2AtLeastOne clContext op workGroupSize = - map2 clContext (Convert.atLeastOneToOption op) workGroupSize + let map2AtLeastOne op clContext workGroupSize = + map2 (Convert.atLeastOneToOption op) clContext workGroupSize - let assignByMaskInplace<'a, 'b when 'a: struct and 'b: struct> - (clContext: ClContext) + let assignByMaskInPlace<'a, 'b when 'a: struct and 'b: struct> (maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>) + (clContext: ClContext) workGroupSize = @@ -71,13 +71,13 @@ module DenseVector = processor.Post(Msg.CreateRunMsg<_, _>(kernel)) let assignByMask<'a, 'b when 'a: struct and 'b: struct> - (clContext: ClContext) (maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>) + (clContext: ClContext) workGroupSize = let assignByMask = - assignByMaskInplace clContext maskOp workGroupSize + assignByMaskInPlace maskOp clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: ClCell<'a>) -> let resultVector = @@ -96,18 +96,16 @@ module DenseVector = Scatter.lastOccurrence clContext workGroupSize let getBitmap = - ClArray.map clContext workGroupSize - <| Map.option 1 0 + ClArray.map (Map.option 1 0) clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize let allIndices = - ClArray.init clContext workGroupSize Map.id + ClArray.init Map.id clContext workGroupSize let allValues = - ClArray.map clContext workGroupSize - <| Map.optionToValueOrZero Unchecked.defaultof<'a> + ClArray.map (Map.optionToValueOrZero Unchecked.defaultof<'a>) clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (vector: ClArray<'a option>) -> @@ -145,31 +143,21 @@ module DenseVector = Values = resultValues Size = vector.Length } - let reduce<'a when 'a: struct> (clContext: ClContext) workGroupSize (opAdd: Expr<'a -> 'a -> 'a>) = + let reduce<'a when 'a: struct> (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let choose = - ClArray.choose clContext workGroupSize Map.id + ClArray.choose Map.id clContext workGroupSize let reduce = - Reduce.reduce clContext workGroupSize opAdd - - let containsNonZero = - ClArray.exists clContext workGroupSize Predicates.isSome + Reduce.reduce opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> + choose processor DeviceOnly vector + |> function + | Some values -> + let result = reduce processor values - let notEmpty = - (containsNonZero processor vector) - .ToHostAndFree processor - - if notEmpty then - let values = choose processor DeviceOnly vector - - let result = reduce processor values - - processor.Post(Msg.CreateFreeMsg<_>(values)) - - result + processor.Post(Msg.CreateFreeMsg<_>(values)) - else - clContext.CreateClCell Unchecked.defaultof<'a> + result + | None -> clContext.CreateClCell Unchecked.defaultof<'a> diff --git a/src/GraphBLAS-sharp.Backend/Vector/SpMV.fs b/src/GraphBLAS-sharp.Backend/Vector/SpMV.fs index 4de83189..46895b0c 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SpMV.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/SpMV.fs @@ -8,9 +8,9 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext module SpMV = let runTo - (clContext: ClContext) (add: Expr<'c option -> 'c option -> 'c option>) (mul: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = @@ -144,12 +144,12 @@ module SpMV = queue.Post(Msg.CreateFreeMsg intermediateArray) let run - (clContext: ClContext) (add: Expr<'c option -> 'c option -> 'c option>) (mul: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) workGroupSize = - let runTo = runTo clContext add mul workGroupSize + let runTo = runTo add mul clContext workGroupSize fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) (vector: ClArray<'b option>) -> diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs similarity index 95% rename from src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs rename to src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs index d44c5a4b..93b809c1 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs @@ -10,7 +10,7 @@ module internal Common = let setPositions<'a when 'a: struct> (clContext: ClContext) workGroupSize = let sum = - PrefixSum.standardExcludeInplace clContext workGroupSize + PrefixSum.standardExcludeInPlace clContext workGroupSize let valuesScatter = Scatter.lastOccurrence clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs similarity index 96% rename from src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs rename to src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs index 38137487..1b8ef660 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs @@ -9,7 +9,7 @@ open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Quotes module internal Map2 = - let private preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = + let private preparePositions<'a, 'b, 'c> opAdd (clContext: ClContext) workGroupSize = let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = <@ fun (ndRange: Range1D) length leftValuesLength rightValuesLength (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultIndices: ClArray) -> @@ -72,10 +72,10 @@ module internal Map2 = resultBitmap, resultValues, resultIndices - let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) op workGroupSize = + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> op (clContext: ClContext) workGroupSize = let prepare = - preparePositions<'a, 'b, 'c> clContext workGroupSize op + preparePositions<'a, 'b, 'c> op clContext workGroupSize let setPositions = Common.setPositions clContext workGroupSize @@ -104,8 +104,8 @@ module internal Map2 = Size = max leftVector.Size rightVector.Size } let private preparePositionsAssignByMask<'a, 'b when 'a: struct and 'b: struct> - (clContext: ClContext) op + (clContext: ClContext) workGroupSize = @@ -175,10 +175,10 @@ module internal Map2 = ///. ///. ///Should be a power of 2 and greater than 1. - let assignByMask<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) op workGroupSize = + let assignByMask<'a, 'b when 'a: struct and 'b: struct> op (clContext: ClContext) workGroupSize = let prepare = - preparePositionsAssignByMask clContext op workGroupSize + preparePositionsAssignByMask op clContext workGroupSize let setPositions = Common.setPositions clContext workGroupSize @@ -209,8 +209,8 @@ module internal Map2 = module AtLeastOne = let private preparePositions<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> - (clContext: ClContext) op + (clContext: ClContext) workGroupSize = @@ -272,12 +272,12 @@ module internal Map2 = ///. ///. ///Should be a power of 2 and greater than 1. - let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> (clContext: ClContext) op workGroupSize = + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> op (clContext: ClContext) workGroupSize = let merge = Merge.run clContext workGroupSize let prepare = - preparePositions<'a, 'b, 'c> clContext op workGroupSize + preparePositions<'a, 'b, 'c> op clContext workGroupSize let setPositions = Common.setPositions clContext workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/Merge.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Merge.fs similarity index 100% rename from src/GraphBLAS-sharp.Backend/Vector/SparseVector/Merge.fs rename to src/GraphBLAS-sharp.Backend/Vector/Sparse/Merge.fs diff --git a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs similarity index 67% rename from src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs rename to src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs index 18d33dd3..deaab095 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/SparseVector/SparseVector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs @@ -8,11 +8,22 @@ open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClVector -module SparseVector = +module Vector = + let copy (clContext: ClContext) workGroupSize = + let copy = ClArray.copy clContext workGroupSize + + let copyData = ClArray.copy clContext workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode (vector: Sparse<'a>) -> + { Context = clContext + Indices = copy processor allocationMode vector.Indices + Values = copyData processor allocationMode vector.Values + Size = vector.Size } + let map2 = Map2.run - let map2AtLeastOne (clContext: ClContext) opAdd workGroupSize allocationMode = - Map2.AtLeastOne.run clContext (Convert.atLeastOneToOption opAdd) workGroupSize allocationMode + let map2AtLeastOne opAdd (clContext: ClContext) workGroupSize allocationMode = + Map2.AtLeastOne.run (Convert.atLeastOneToOption opAdd) clContext workGroupSize allocationMode let assignByMask = Map2.assignByMask @@ -51,9 +62,9 @@ module SparseVector = resultVector - let reduce<'a when 'a: struct> (clContext: ClContext) workGroupSize (opAdd: Expr<'a -> 'a -> 'a>) = + let reduce<'a when 'a: struct> (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let reduce = - Reduce.reduce clContext workGroupSize opAdd + Reduce.reduce opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClVector.Sparse<'a>) -> reduce processor vector.Values diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index 1e36d108..9c94992b 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -5,8 +5,6 @@ open GraphBLAS.FSharp.Backend.Quotes open Microsoft.FSharp.Control open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend.Vector.Dense -open GraphBLAS.FSharp.Backend.Vector.Sparse open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Objects.ClVector @@ -41,7 +39,7 @@ module Vector = ClArray.zeroCreate clContext workGroupSize let map = - ClArray.map clContext workGroupSize <@ Some @> + ClArray.map <@ Some @> clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode format size (elements: (int * 'a) list) -> match format with @@ -79,29 +77,23 @@ module Vector = ClVector.Dense result let copy (clContext: ClContext) workGroupSize = - let copy = ClArray.copy clContext workGroupSize - - let copyData = ClArray.copy clContext workGroupSize + let sparseCopy = + Sparse.Vector.copy clContext workGroupSize let copyOptionData = ClArray.copy clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) -> match vector with | ClVector.Sparse vector -> - { Context = clContext - Indices = copy processor allocationMode vector.Indices - Values = copyData processor allocationMode vector.Values - Size = vector.Size } - |> ClVector.Sparse + ClVector.Sparse + <| sparseCopy processor allocationMode vector | ClVector.Dense vector -> ClVector.Dense <| copyOptionData processor allocationMode vector - let mask = copy - let toSparse (clContext: ClContext) workGroupSize = let toSparse = - DenseVector.toSparse clContext workGroupSize + Dense.Vector.toSparse clContext workGroupSize let copy = copy clContext workGroupSize @@ -114,7 +106,7 @@ module Vector = let toDense (clContext: ClContext) workGroupSize = let toDense = - SparseVector.toDense clContext workGroupSize + Sparse.Vector.toDense clContext workGroupSize let copy = ClArray.copy clContext workGroupSize @@ -127,12 +119,12 @@ module Vector = ClVector.Dense <| toDense processor allocationMode vector - let map2 (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = + let map2 (opAdd: Expr<'a option -> 'b option -> 'c option>) (clContext: ClContext) workGroupSize = let map2Dense = - DenseVector.map2 clContext opAdd workGroupSize + Dense.Vector.map2 opAdd clContext workGroupSize let map2Sparse = - SparseVector.map2 clContext opAdd workGroupSize + Sparse.Vector.map2 opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with @@ -144,12 +136,12 @@ module Vector = <| map2Sparse processor allocationMode left right | _ -> failwith "Vector formats are not matching." - let map2AtLeastOne (clContext: ClContext) (opAdd: Expr -> 'c option>) workGroupSize = + let map2AtLeastOne (opAdd: Expr -> 'c option>) (clContext: ClContext) workGroupSize = let map2Sparse = - SparseVector.map2AtLeastOne clContext opAdd workGroupSize + Sparse.Vector.map2AtLeastOne opAdd clContext workGroupSize let map2Dense = - DenseVector.map2AtLeastOne clContext opAdd workGroupSize + Dense.Vector.map2AtLeastOne opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with @@ -161,13 +153,13 @@ module Vector = <| map2Dense processor allocationMode left right | _ -> failwith "Vector formats are not matching." - let private assignByMaskGeneral<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) op workGroupSize = + let private assignByMaskGeneral<'a, 'b when 'a: struct and 'b: struct> op (clContext: ClContext) workGroupSize = let sparseFillVector = - SparseVector.assignByMask clContext op workGroupSize + Sparse.Vector.assignByMask op clContext workGroupSize let denseFillVector = - DenseVector.assignByMask clContext op workGroupSize + Dense.Vector.assignByMask op clContext workGroupSize fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) (mask: ClVector<'b>) (value: ClCell<'a>) -> match vector, mask with @@ -179,18 +171,18 @@ module Vector = <| denseFillVector processor allocationMode vector mask value | _ -> failwith "Vector formats are not matching." - let assignByMask<'a, 'b when 'a: struct and 'b: struct> clContext op workGroupSize = - assignByMaskGeneral<'a, 'b> clContext (Convert.assignToOption op) workGroupSize + let assignByMask<'a, 'b when 'a: struct and 'b: struct> op clContext workGroupSize = + assignByMaskGeneral<'a, 'b> (Convert.assignToOption op) clContext workGroupSize - let assignByMaskComplemented<'a, 'b when 'a: struct and 'b: struct> clContext op workGroupSize = - assignByMaskGeneral<'a, 'b> clContext (Convert.assignComplementedToOption op) workGroupSize + let assignByMaskComplemented<'a, 'b when 'a: struct and 'b: struct> op clContext workGroupSize = + assignByMaskGeneral<'a, 'b> (Convert.assignComplementedToOption op) clContext workGroupSize - let reduce (clContext: ClContext) workGroupSize (opAdd: Expr<'a -> 'a -> 'a>) = + let reduce (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let sparseReduce = - SparseVector.reduce clContext workGroupSize opAdd + Sparse.Vector.reduce opAdd clContext workGroupSize let denseReduce = - DenseVector.reduce clContext workGroupSize opAdd + Dense.Vector.reduce opAdd clContext workGroupSize fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> match vector with diff --git a/src/GraphBLAS-sharp.Backend/paket.references b/src/GraphBLAS-sharp.Backend/paket.references index 6f164f37..6051b92a 100644 --- a/src/GraphBLAS-sharp.Backend/paket.references +++ b/src/GraphBLAS-sharp.Backend/paket.references @@ -1,4 +1,4 @@ FSharp.Core Microsoft.SourceLink.GitHub - Brahma.FSharp +FSharp.Quotations.Evaluator \ No newline at end of file diff --git a/src/GraphBLAS-sharp/AlgebraicStructures.fs b/src/GraphBLAS-sharp/AlgebraicStructures.fs deleted file mode 100644 index 8a048043..00000000 --- a/src/GraphBLAS-sharp/AlgebraicStructures.fs +++ /dev/null @@ -1,55 +0,0 @@ -namespace GraphBLAS.FSharp - -open Microsoft.FSharp.Quotations - -type UnaryOp<'a, 'b> = UnaryOp of Expr<'a -> 'b> -type BinaryOp<'a, 'b, 'c> = BinaryOp of Expr<'a -> 'b -> 'c> - -type ClosedUnaryOp<'a> = ClosedUnaryOp of Expr<'a -> 'a> -type ClosedBinaryOp<'a> = ClosedBinaryOp of Expr<'a -> 'a -> 'a> - -/// Magma with associative (magma is set with closed binary operator) -type ISemigroup<'a> = - abstract Op : ClosedBinaryOp<'a> - -/// Semigroup with identity -type IMonoid<'a> = - abstract Plus : ClosedBinaryOp<'a> - abstract Zero : 'a - -/// Monoid with associative binary operator, -/// for wich Zero is annihilator -type ISemiring<'a> = - abstract Zero : 'a - abstract Plus : ClosedBinaryOp<'a> - abstract Times : ClosedBinaryOp<'a> - -type Semigroup<'a> = - { AssociativeOp: ClosedBinaryOp<'a> } - - interface ISemigroup<'a> with - member this.Op = this.AssociativeOp - -type Monoid<'a> = - { AssociativeOp: ClosedBinaryOp<'a> - Identity: 'a } - - interface ISemigroup<'a> with - member this.Op = this.AssociativeOp - - interface IMonoid<'a> with - member this.Plus = this.AssociativeOp - member this.Zero = this.Identity - -type Semiring<'a> = - { PlusMonoid: Monoid<'a> - TimesSemigroup: Semigroup<'a> } - - interface IMonoid<'a> with - member this.Zero = this.PlusMonoid.Identity - member this.Plus = this.PlusMonoid.AssociativeOp - - interface ISemiring<'a> with - member this.Times = this.TimesSemigroup.AssociativeOp - member this.Zero = this.PlusMonoid.Identity - member this.Plus = this.PlusMonoid.AssociativeOp diff --git a/src/GraphBLAS-sharp/Algorithms/BFS.fs b/src/GraphBLAS-sharp/Algorithms/BFS.fs deleted file mode 100644 index 5972939b..00000000 --- a/src/GraphBLAS-sharp/Algorithms/BFS.fs +++ /dev/null @@ -1,38 +0,0 @@ -namespace GraphBLAS.FSharp.Algorithms - -open GraphBLAS.FSharp.Predefined -open GraphBLAS.FSharp - -module BFS = - let levelSingleSource (matrix: Matrix) (source: int) = - graphblas { - let vertexCount = Matrix.rowCount matrix - let! levels = Vector.zeroCreate vertexCount // v - let! frontier = Vector.ofList vertexCount [ source, 1 ] // q[s] = true - let! transposed = Matrix.transpose matrix // A' - - let mutable currentLevel = 0 - let mutable break' = false - - while not break' do - currentLevel <- currentLevel + 1 - - let! currentLevelScalar = Scalar.create currentLevel - - let! frontierMask = Vector.mask frontier - do! Vector.fillSubVector levels frontierMask currentLevelScalar // v[q] = d - - let! levelsComplemented = Vector.complemented levels - - do! - Matrix.mxvWithMask AddMult.int levelsComplemented transposed frontier // q[!v] = (A' ||.&& q)' = q' ||.&& A -- replace + comp - >>= Vector.assignVector frontier - - let! succ = - Vector.reduce AddMult.int frontier - >>= Scalar.exportValue - - break' <- succ = 0 - - return levels - } diff --git a/src/GraphBLAS-sharp/Algorithms/BetweennessCentrality.fs b/src/GraphBLAS-sharp/Algorithms/BetweennessCentrality.fs deleted file mode 100644 index f07c1ebc..00000000 --- a/src/GraphBLAS-sharp/Algorithms/BetweennessCentrality.fs +++ /dev/null @@ -1,89 +0,0 @@ -namespace GraphBLAS.FSharp.Algorithms - -open GraphBLAS.FSharp.Predefined -open GraphBLAS.FSharp - -module BetweennessCentrality = - // NOTE matrix of bool? - let metric (matrix: Matrix) (source: int) = - graphblas { - let n = Matrix.rowCount matrix - let! delta = Vector.zeroCreate n - let! sigma = Matrix.zeroCreate n n - let! q = Vector.ofList n [ source, 1 ] - let! p = Vector.copy q - - let! pMask = Vector.complemented p - - do! - Matrix.vxmWithMask AddMult.int pMask q matrix - >>= Vector.assignVector q - - let mutable d = 0 - let mutable sum = 0 - let mutable break' = false - - while not break' || sum <> 0 do - break' <- true - - do! Matrix.assignRow sigma d q - - do! - Vector.eWiseAdd Add.int p q - >>= Vector.assignVector p // ? - - let! pMask = Vector.complemented p - - do! - Matrix.vxmWithMask AddMult.int pMask q matrix - >>= Vector.assignVector q - - let! sum' = Vector.reduce Add.int q >>= Scalar.exportValue - - sum <- sum' - d <- d + 1 - - let! t1 = Vector.zeroCreate n - let! t2 = Vector.zeroCreate n - let! t3 = Vector.zeroCreate n - let! t4 = Vector.zeroCreate n - - for i = d - 1 downto 1 do - // t1 <- 1 + delta - do! - Vector.apply (UnaryOp <@ (+) 1.f @>) delta - >>= Vector.assignVector t1 - - // t2 <- sigma.[i, *] - do! - Matrix.extractRow sigma i - >>= Vector.apply (UnaryOp <@ float32 @>) - >>= Vector.assignVector t2 - - // t2 <- t1 / t2 - let! qMask = Vector.mask q - - do! - Vector.apply (UnaryOp <@ (/) 1.f @>) t2 - >>= fun x -> Vector.eWiseMultWithMask AddMult.float32 qMask t1 x - >>= Vector.assignVector t2 - - do! - Matrix.apply (UnaryOp <@ float32 @>) matrix - >>= fun matrix -> Matrix.mxv AddMult.float32 matrix t2 - >>= Vector.assignVector t3 - - // t4 <- sigma.[i - 1, *] * t3 - do! - Matrix.extractRow sigma (i - 1) - >>= Vector.apply (UnaryOp <@ float32 @>) - >>= fun x -> Vector.eWiseMult AddMult.float32 x t3 - >>= Vector.assignVector t4 - - // delta <- delta + t4 - do! - Vector.eWiseAdd Add.float32 delta t4 - >>= Vector.assignVector delta - - return delta - } diff --git a/src/GraphBLAS-sharp/Algorithms/ShortestPath.fs b/src/GraphBLAS-sharp/Algorithms/ShortestPath.fs deleted file mode 100644 index 4fa82474..00000000 --- a/src/GraphBLAS-sharp/Algorithms/ShortestPath.fs +++ /dev/null @@ -1,24 +0,0 @@ -namespace GraphBLAS.FSharp.Algorithms - -open GraphBLAS.FSharp.Predefined -open GraphBLAS.FSharp -open Brahma.FSharp.OpenCL - -module ShortestPath = - // FIXME Unsupported call: min - let singleSource (matrix: Matrix) (source: int) = - graphblas { - let vertexCount = Matrix.rowCount matrix - let! distance = Vector.ofList vertexCount [ source, 0. ] - - let! transposed = Matrix.transpose matrix // A' - - // TODO terminate earlier if we reach a fixed point - for _ = 1 to vertexCount - 1 do - failwith "FIX ME! And rewrite." - //do! - // Matrix.mxv MinAdd.float transposed distance - // >>= Vector.assignVector distance - - return distance - } diff --git a/src/GraphBLAS-sharp/Algorithms/TriangleCounting.fs b/src/GraphBLAS-sharp/Algorithms/TriangleCounting.fs deleted file mode 100644 index e04a97a4..00000000 --- a/src/GraphBLAS-sharp/Algorithms/TriangleCounting.fs +++ /dev/null @@ -1,30 +0,0 @@ -namespace GraphBLAS.FSharp.Algorithms - -open GraphBLAS.FSharp.Predefined -open GraphBLAS.FSharp - -module TriangleCounting = - let sandia (matrix: Matrix) = - graphblas { - let! lowerTriangular = - matrix - |> Matrix.select (UnaryOp <@ fun (i, j, _) -> i <= j @>) - - let! matrix' = - lowerTriangular - |> Matrix.apply ( - UnaryOp - <@ function - | true -> 1 - | false -> 0 @> - ) - - let! transposed = matrix' |> Matrix.transpose - - let! lowerTriangularMask = lowerTriangular |> Matrix.mask - - return! - Matrix.mxmWithMask AddMult.int lowerTriangularMask matrix' transposed - >>= Matrix.reduce Add.int - >>= Scalar.exportValue - } diff --git a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj index 96e59d55..698b8a17 100644 --- a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj +++ b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj @@ -16,21 +16,12 @@ - - + - - - - - - - - Always diff --git a/src/GraphBLAS-sharp/GraphblasEvaluation.fs b/src/GraphBLAS-sharp/GraphblasEvaluation.fs deleted file mode 100644 index 4997a79a..00000000 --- a/src/GraphBLAS-sharp/GraphblasEvaluation.fs +++ /dev/null @@ -1,88 +0,0 @@ -namespace GraphBLAS.FSharp -// -//open Brahma.FSharp.ClTaskImpl -//open Brahma.FSharp.ClTask -//open Brahma.FSharp -// -//type GraphblasContext = { ClContext: ClContext } -// -//type GraphblasEvaluation<'a> = EvalGB of (GraphblasContext -> 'a) -// -//module EvalGB = -// let defaultEnv = { ClContext = ClContext() } -// -// let private runCl env (ClTask f) = f env -// -// let run env (EvalGB action) = action env -// -// let ask = EvalGB id -// -// let asks f = EvalGB f -// -// let bind f reader = -// EvalGB -// <| fun env -> -// let x = run env reader -// run env (f x) -// -// let (>>=) x f = bind f x -// -// let return' x = EvalGB <| fun _ -> x -// -// let returnFrom x = x -// -// let fromCl clEvaluation = -// EvalGB -// <| fun env -> runCl env.ClContext clEvaluation -// -// let withClContext clContext (EvalGB action) = -// ask -// >>= fun env -> -// return' -// <| action { env with ClContext = clContext } -// -// let runSync (EvalGB action) = -// let result = action defaultEnv -// result -// -//type GraphblasBuilder() = -// member this.Bind(x, f) = EvalGB.bind f x -// member this.Return x = EvalGB.return' x -// member this.ReturnFrom x = x -// -// member this.Zero() = EvalGB.return' () -// -// member this.Combine(m1, m2) = -// EvalGB -// <| fun env -> -// EvalGB.run env m1 -// EvalGB.run env m2 -// -// member this.Delay rest = -// EvalGB <| fun env -> EvalGB.run env <| rest () -// -// member this.While(predicate, body) = -// EvalGB -// <| fun env -> -// while predicate () do -// EvalGB.run env body -// -// member this.For(sequence, f) = -// EvalGB -// <| fun env -> -// for elem in sequence do -// EvalGB.run env (f elem) -// -// member this.TryWith(tryBlock, handler) = -// EvalGB -// <| fun env -> -// try -// EvalGB.run env tryBlock -// with -// | e -> EvalGB.run env (handler e) -// -//[] -//module GraphblasBuilder = -// let graphblas = GraphblasBuilder() -// -// let (>>=) x f = EvalGB.bind f x diff --git a/src/GraphBLAS-sharp/IO/MtxReader.fs b/src/GraphBLAS-sharp/IO/MtxReader.fs index 6059b8bc..f25ce8c0 100644 --- a/src/GraphBLAS-sharp/IO/MtxReader.fs +++ b/src/GraphBLAS-sharp/IO/MtxReader.fs @@ -34,15 +34,15 @@ type MtxReader(pathToFile: string) = streamReader.ReadLine().Split(' ') |> Array.map int - let nrows = size.[0] - let ncols = size.[1] + let rowsCount = size.[0] + let columnsCount = size.[1] let nnz = size.[2] - {| RowCount = nrows - ColumnCount = ncols - Nnz = nnz |} + {| RowCount = rowsCount + ColumnCount = columnsCount + NNZ = nnz |} - member this.ReadMatrix(converter: string -> 'a) : Matrix<'a> = + member this.ReadMatrix(converter: string -> 'a) : Matrix.COO<'a> = if object <> MtxMatrix then failwith "Object is not matrix" @@ -119,12 +119,11 @@ type MtxReader(pathToFile: string) = values.[i] <- value) sortedData - Matrix.COO - { Rows = rows - Columns = cols - Values = values - RowCount = n - ColumnCount = m } + { Matrix.COO.Rows = rows + Matrix.COO.Columns = cols + Matrix.COO.Values = values + Matrix.COO.RowCount = n + Matrix.COO.ColumnCount = m } match format with | Coordinate -> matrixFromCoordinateFormat () diff --git a/src/GraphBLAS-sharp/Objects/Matrix.fs b/src/GraphBLAS-sharp/Objects/Matrix.fs index 5213e750..45754431 100644 --- a/src/GraphBLAS-sharp/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp/Objects/Matrix.fs @@ -5,6 +5,51 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix module Matrix = + type CSR<'a when 'a: struct> = + { RowCount: int + ColumnCount: int + RowPointers: int [] + ColumnIndices: int [] + Values: 'a [] } + + static member FromArray2D(array: 'a [,], isZero: 'a -> bool) = + let rowsCount = array |> Array2D.length1 + let columnsCount = array |> Array2D.length2 + + let convertedMatrix = + [ for i in 0 .. rowsCount - 1 -> array.[i, *] |> List.ofArray ] + |> List.map + (fun row -> + row + |> List.mapi (fun i x -> (x, i)) + |> List.filter (fun pair -> not <| isZero (fst pair))) + |> List.fold + (fun (rowPointers, valueInx) row -> + ((rowPointers.Head + row.Length) :: rowPointers), valueInx @ row) + ([ 0 ], []) + + { Values = + convertedMatrix + |> (snd >> List.unzip >> fst) + |> List.toArray + ColumnIndices = + convertedMatrix + |> (snd >> List.unzip >> snd) + |> List.toArray + RowPointers = convertedMatrix |> fst |> List.rev |> List.toArray + RowCount = rowsCount + ColumnCount = columnsCount } + + member this.NNZ = this.Values.Length + + member this.ToDevice(context: ClContext) = + { Context = context + RowCount = this.RowCount + ColumnCount = this.ColumnCount + RowPointers = context.CreateClArray this.RowPointers + Columns = context.CreateClArray this.ColumnIndices + Values = context.CreateClArray this.Values } + type COO<'a when 'a: struct> = { RowCount: int ColumnCount: int @@ -29,7 +74,7 @@ module Matrix = Values = values } static member FromArray2D(array: 'a [,], isZero: 'a -> bool) = - let rows, cols, vals = + let rows, cols, values = array |> Seq.cast<'a> |> Seq.mapi (fun idx v -> (idx / Array2D.length2 array, idx % Array2D.length2 array, v)) @@ -37,7 +82,7 @@ module Matrix = |> Array.ofSeq |> Array.unzip3 - COO.FromTuples(Array2D.length1 array, Array2D.length2 array, rows, cols, vals) + COO.FromTuples(Array2D.length1 array, Array2D.length2 array, rows, cols, values) member this.ToDevice(context: ClContext) = { Context = context @@ -47,49 +92,20 @@ module Matrix = Columns = context.CreateClArray this.Columns Values = context.CreateClArray this.Values } - type CSR<'a when 'a: struct> = - { RowCount: int - ColumnCount: int - RowPointers: int [] - ColumnIndices: int [] - Values: 'a [] } + member this.ToCSR = + let rowPointers = + let pointers = Array.zeroCreate this.RowCount - static member FromArray2D(array: 'a [,], isZero: 'a -> bool) = - let rowsCount = array |> Array2D.length1 - let columnsCount = array |> Array2D.length2 + Array.countBy id this.Rows + |> Array.iter (fun (index, count) -> pointers.[index] <- count) - let convertedMatrix = - [ for i in 0 .. rowsCount - 1 -> array.[i, *] |> List.ofArray ] - |> List.map - (fun row -> - row - |> List.mapi (fun i x -> (x, i)) - |> List.filter (fun pair -> not <| isZero (fst pair))) - |> List.fold - (fun (rowPtrs, valueInx) row -> ((rowPtrs.Head + row.Length) :: rowPtrs), valueInx @ row) - ([ 0 ], []) - - { Values = - convertedMatrix - |> (snd >> List.unzip >> fst) - |> List.toArray - ColumnIndices = - convertedMatrix - |> (snd >> List.unzip >> snd) - |> List.toArray - RowPointers = convertedMatrix |> fst |> List.rev |> List.toArray - RowCount = rowsCount - ColumnCount = columnsCount } - - member this.NNZ = this.Values.Length + Array.scan (+) 0 pointers - member this.ToDevice(context: ClContext) = - { Context = context - RowCount = this.RowCount + { RowCount = this.RowCount ColumnCount = this.ColumnCount - RowPointers = context.CreateClArray this.RowPointers - Columns = context.CreateClArray this.ColumnIndices - Values = context.CreateClArray this.Values } + RowPointers = rowPointers + ColumnIndices = this.Columns + Values = this.Values } type CSC<'a when 'a: struct> = { RowCount: int @@ -110,7 +126,8 @@ module Matrix = |> List.mapi (fun i x -> (x, i)) |> List.filter (fun pair -> not <| isZero (fst pair))) |> List.fold - (fun (colPtrs, valueInx) col -> ((colPtrs.Head + col.Length) :: colPtrs), valueInx @ col) + (fun (colPointers, valueInx) col -> + ((colPointers.Head + col.Length) :: colPointers), valueInx @ col) ([ 0 ], []) { Values = @@ -135,6 +152,44 @@ module Matrix = ColumnPointers = context.CreateClArray this.ColumnPointers Values = context.CreateClArray this.Values } + type LIL<'a when 'a: struct> = + { RowCount: int + ColumnCount: int + Rows: Vector.Sparse<'a> option list + NNZ: int } + + static member FromArray2D(array: 'a [,], isZero: 'a -> bool) = + let mutable nnz = 0 + + let rows = + [ for i in 0 .. Array2D.length1 array - 1 do + let vector = + Vector.Sparse.FromArray(array.[i, *], isZero) + + nnz <- nnz + vector.NNZ + + if vector.NNZ > 0 then + Some vector + else + None ] + + { RowCount = Array2D.length1 array + ColumnCount = Array2D.length2 array + Rows = rows + NNZ = nnz } + + member this.ToDevice(context: ClContext) = + + let rows = + this.Rows + |> List.map (Option.map (fun vector -> vector.ToDevice(context))) + + { Context = context + RowCount = this.RowCount + ColumnCount = this.ColumnCount + Rows = rows + NNZ = this.NNZ } + type Tuples<'a> = { RowIndices: int [] ColumnIndices: int [] @@ -145,27 +200,32 @@ type Matrix<'a when 'a: struct> = | CSR of Matrix.CSR<'a> | COO of Matrix.COO<'a> | CSC of Matrix.CSC<'a> + | LIL of Matrix.LIL<'a> member this.RowCount = match this with | CSR matrix -> matrix.RowCount | COO matrix -> matrix.RowCount | CSC matrix -> matrix.RowCount + | LIL matrix -> matrix.RowCount member this.ColumnCount = match this with | CSR matrix -> matrix.ColumnCount | COO matrix -> matrix.ColumnCount | CSC matrix -> matrix.ColumnCount + | LIL matrix -> matrix.ColumnCount member this.NNZ = match this with | COO m -> m.NNZ | CSR m -> m.NNZ | CSC m -> m.NNZ + | LIL m -> m.NNZ member this.ToDevice(context: ClContext) = match this with | COO matrix -> ClMatrix.COO <| matrix.ToDevice context | CSR matrix -> ClMatrix.CSR <| matrix.ToDevice context | CSC matrix -> ClMatrix.CSC <| matrix.ToDevice context + | LIL matrix -> ClMatrix.LIL <| matrix.ToDevice context diff --git a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs index b30ff16e..d79a5d97 100644 --- a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs @@ -3,68 +3,46 @@ namespace GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Backend.Objects open Brahma.FSharp open Matrix +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.ClVectorExtensions module MatrixExtensions = type ClMatrix<'a when 'a: struct> with member this.ToHost(q: MailboxProcessor<_>) = match this with | ClMatrix.COO m -> - let rows = Array.zeroCreate m.Rows.Length - let columns = Array.zeroCreate m.Columns.Length - let values = Array.zeroCreate m.Values.Length - - q.Post(Msg.CreateToHostMsg(m.Rows, rows)) - - q.Post(Msg.CreateToHostMsg(m.Columns, columns)) - - ignore - <| q.PostAndReply(fun ch -> Msg.CreateToHostMsg(m.Values, values, ch)) - - let result = - { RowCount = m.RowCount - ColumnCount = m.ColumnCount - Rows = rows - Columns = columns - Values = values } - - Matrix.COO result + { RowCount = m.RowCount + ColumnCount = m.ColumnCount + Rows = m.Rows.ToHost q + Columns = m.Columns.ToHost q + Values = m.Values.ToHost q } + |> Matrix.COO | ClMatrix.CSR m -> - let rows = Array.zeroCreate m.RowPointers.Length - let columns = Array.zeroCreate m.Columns.Length - let values = Array.zeroCreate m.Values.Length - - q.Post(Msg.CreateToHostMsg(m.RowPointers, rows)) - - q.Post(Msg.CreateToHostMsg(m.Columns, columns)) - - ignore - <| q.PostAndReply(fun ch -> Msg.CreateToHostMsg(m.Values, values, ch)) - - let result = - { RowCount = m.RowCount - ColumnCount = m.ColumnCount - RowPointers = rows - ColumnIndices = columns - Values = values } - - Matrix.CSR result + { RowCount = m.RowCount + ColumnCount = m.ColumnCount + RowPointers = m.RowPointers.ToHost q + ColumnIndices = m.Columns.ToHost q + Values = m.Values.ToHost q } + |> Matrix.CSR | ClMatrix.CSC m -> - let rows = Array.zeroCreate m.Rows.Length - let columns = Array.zeroCreate m.ColumnPointers.Length - let values = Array.zeroCreate m.Values.Length - - q.Post(Msg.CreateToHostMsg(m.Rows, rows)) - - q.Post(Msg.CreateToHostMsg(m.ColumnPointers, columns)) - - ignore - <| q.PostAndReply(fun ch -> Msg.CreateToHostMsg(m.Values, values, ch)) - - let result = - { RowCount = m.RowCount - ColumnCount = m.ColumnCount - RowIndices = rows - ColumnPointers = columns - Values = values } - - Matrix.CSC result + { RowCount = m.RowCount + ColumnCount = m.ColumnCount + RowIndices = m.Rows.ToHost q + ColumnPointers = m.ColumnPointers.ToHost q + Values = m.Values.ToHost q } + |> Matrix.CSC + | ClMatrix.LIL m -> + { RowCount = m.RowCount + ColumnCount = m.ColumnCount + Rows = + m.Rows + |> List.map (Option.map (fun row -> row.ToHost q)) + NNZ = m.NNZ } + |> Matrix.LIL + + member this.ToHostAndDispose(processor: MailboxProcessor<_>) = + let result = this.ToHost processor + + this.Dispose processor + + result diff --git a/src/GraphBLAS-sharp/Objects/Vector.fs b/src/GraphBLAS-sharp/Objects/Vector.fs index 7caa47b6..19b7e01a 100644 --- a/src/GraphBLAS-sharp/Objects/Vector.fs +++ b/src/GraphBLAS-sharp/Objects/Vector.fs @@ -33,15 +33,14 @@ module Vector = Size = size } static member FromArray(array: 'a [], isZero: 'a -> bool) = - let (indices, vals) = + let indices, values = array - |> Seq.cast<'a> |> Seq.mapi (fun idx v -> (idx, v)) |> Seq.filter (fun (_, v) -> not (isZero v)) |> Array.ofSeq |> Array.unzip - Sparse.FromTuples(indices, vals, array.Length) + Sparse.FromTuples(indices, values, array.Length) member this.NNZ = this.Values.Length diff --git a/src/GraphBLAS-sharp/Objects/VectorExtensions.fs b/src/GraphBLAS-sharp/Objects/VectorExtensions.fs index ad9333be..4bdb6a01 100644 --- a/src/GraphBLAS-sharp/Objects/VectorExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/VectorExtensions.fs @@ -2,23 +2,17 @@ namespace GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend.Objects -open Brahma.FSharp +open GraphBLAS.FSharp.Objects.Vector module ClVectorExtensions = + type ClVector.Sparse<'a> with + member this.ToHost(q: MailboxProcessor<_>) = + { Indices = this.Indices.ToHost q + Values = this.Values.ToHost q + Size = this.Size } + type ClVector<'a when 'a: struct> with member this.ToHost(q: MailboxProcessor<_>) = match this with - | ClVector.Sparse vector -> - let indices = Array.zeroCreate vector.Indices.Length - let values = Array.zeroCreate vector.Values.Length - - q.Post(Msg.CreateToHostMsg(vector.Indices, indices)) - - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(vector.Values, values, ch)) - |> ignore - - Vector.Sparse - <| { Indices = indices - Values = values - Size = this.Size } + | ClVector.Sparse vector -> Vector.Sparse <| vector.ToHost q | ClVector.Dense vector -> Vector.Dense <| vector.ToHost q diff --git a/src/GraphBLAS-sharp/Operations/Matrix.fs b/src/GraphBLAS-sharp/Operations/Matrix.fs deleted file mode 100644 index c36c7973..00000000 --- a/src/GraphBLAS-sharp/Operations/Matrix.fs +++ /dev/null @@ -1,371 +0,0 @@ -namespace GraphBLAS.FSharp - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp.Backend - -[] -module Matrix = - - (* - constructors - *) - - let build - (rowCount: int) - (columnCount: int) - (rows: int []) - (columns: int []) - (values: 'a []) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let ofTuples (rowCount: int) (columnCount: int) (tuples: MatrixTuples<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let ofList (rowCount: int) (columnCount: int) (elements: (int * int * 'a) list) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - // можно оставить, но с условием, что будет создаваться full matrix, - // которую можно будет проредить потом (но вообще это initом эмулируется) - // let ofArray2D (array: 'a[,]) : GraphblasEvaluation> = - // failwith "Not Implemented yet"" - - let init (rowCount: int) (columnCount: int) (initializer: int -> int -> 'a) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let create (rowCount: int) (columnCount: int) (value: 'a) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let zeroCreate<'a when 'a: struct> (rowCount: int) (columnCount: int) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - (* - methods - *) - - let rowCount (matrix: Matrix<'a>) : int = matrix.RowCount - let columnCount (matrix: Matrix<'a>) : int = matrix.ColumnCount - - let copy (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" - - let resize (rowCount: int) (columnCount: int) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - // NOTE int cant be sync - let nnz (matrix: Matrix<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" - - let tuples (matrix: Matrix<'a>) : GraphblasEvaluation> = - match matrix with - | MatrixCOO matrix -> COOMatrix.GetTuples.fromMatrix matrix - | MatrixCSR matrix -> CSRMatrix.GetTuples.fromMatrix matrix - |> EvalGB.fromCl - - let mask (matrix: Matrix<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" - let complemented (matrix: Matrix<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" - - let switch (matrixFormat: MatrixFromat) (matrix: Matrix<'a>) : GraphblasEvaluation> = - match matrix, matrixFormat with - | MatrixCOO matrix, CSR -> - opencl { - let! result = CSRMatrix.Convert.fromCoo matrix - return MatrixCSR result - } - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - let synchronize (matrix: Matrix<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" - - let synchronizeAndReturn (matrix: Matrix<'a>) : GraphblasEvaluation> = - match matrix with - | MatrixCSR matrix -> - opencl { - let! _ = - if matrix.RowPointers.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME! And rewrite." - //ToHost matrix.RowPointers - - let! _ = - if matrix.ColumnIndices.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME! And rewrite." - //ToHost matrix.ColumnIndices - - let! _ = - if matrix.Values.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME! And rewrite." - //ToHost matrix.Values - - return MatrixCSR matrix - } - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - (* - assignment, extraction and filling - *) - - /// mat.[mask] - let extractSubMatrix (matrix: Matrix<'a>) (mask: Mask2D) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - /// mat.[rowIdx. *] - let extractRow (matrix: Matrix<'a>) (rowIdx: int) : GraphblasEvaluation> = failwith "Not Implemented yet" - - /// mat.[rowIdx, mask] - let extractSubRow (matrix: Matrix<'a>) (rowIdx: int) (mask: Mask2D) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - /// mat.[*, colIdx] - let extractCol (matrix: Matrix<'a>) (colIdx: int) : GraphblasEvaluation> = failwith "Not Implemented yet" - - /// mat.[mask. colIdx] - let extractSubCol (matrix: Matrix<'a>) (mask: Mask2D) (colIdx: int) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - /// mat.[rowIdx, colIdx] - let extractValue (matrix: Matrix<'a>) (rowIdx: int) (colIdx: int) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - /// t <- s - let assignMatrix (target: Matrix<'a>) (source: Matrix<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// t.[mask] <- s - let assignSubMatrix (target: Matrix<'a>) (mask: Mask2D) (source: Matrix<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// t.[rowIdx, *] <- s - let assignRow (target: Matrix<'a>) (rowIdx: int) (source: Vector<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// t.[rowIdx, mask] <- s - let assignSubRow - (target: Matrix<'a>) - (rowIdx: int) - (mask: Mask1D) - (source: Vector<'a>) - : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// t.[*, colIdx] <- s - let assignCol (target: Matrix<'a>) (colIdx: int) (source: Vector<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// t.[mask, colIdx] <- s - let assignSubCol - (target: Matrix<'a>) - (colIdx: int) - (mask: Mask1D) - (source: Vector<'a>) - : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// mat.[*, *] <- value - let fillMatrix (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" - - /// mat.[mask] <- value - let fillSubMatrix (mask: Mask2D) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// mat.[rowIdx, *] <- value - let fillRow (rowIdx: int) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// mat.[rowIdx, mask] <- value - let fillSubRow (rowIdx: int) (mask: Mask1D) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// mat.[*, colIdx] <- value - let fillCol (colIdx: int) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// mat.[mask, colIdx] <- value - let fillSubCol (colIdx: int) (mask: Mask1D) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - (* - closed unmasked operations - *) - - let mxm - (semiring: ISemiring<'a>) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented" - - let mxv (semiring: ISemiring<'a>) (matrix: Matrix<'a>) (vector: Vector<'a>) : GraphblasEvaluation> = - match matrix, vector with - | MatrixCSR matrix, VectorCOO vector -> - opencl { - let! result = CSRMatrix.SpMSpV.unmasked matrix vector semiring - return VectorCOO result - } - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - let vxm (semiring: ISemiring<'a>) (vector: Vector<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented" - - let eWiseAdd - (monoid: IMonoid<'a>) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - match leftMatrix, rightMatrix with - | MatrixCOO left, MatrixCOO right -> failwith "FIX ME! And rewrite." - //opencl { - // let! result = COOMatrix.EWiseAdd.run left right None monoid - // return MatrixCOO result - //} - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - let eWiseMult - (semiring: ISemiring<'a>) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let apply (mapper: UnaryOp<'a, 'b>) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let select (predicate: UnaryOp) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let reduceRows (monoid: IMonoid<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let reduceCols (monoid: IMonoid<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let reduce (monoid: IMonoid<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let transpose (matrix: Matrix<'a>) : GraphblasEvaluation> = - match matrix with - | MatrixCSR matrix -> - // map - opencl { - let! transposed = CSRMatrix.Transpose.transposeMatrix matrix - return MatrixCSR transposed - } - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - let kronecker - (semiring: ISemiring<'a>) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - (* - closed masked operations - *) - - let mxmWithMask - (semiring: ISemiring<'a>) - (mask: Mask2D) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let mxvWithMask - (semiring: ISemiring<'a>) - (mask: Mask1D) - (matrix: Matrix<'a>) - (vector: Vector<'a>) - : GraphblasEvaluation> = - match matrix, vector, mask with - | MatrixCSR matrix, VectorCOO vector, mask when not mask.IsComplemented -> - opencl { - let! result = CSRMatrix.SpMSpV.masked matrix vector semiring mask - return VectorCOO result - } - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - let vxmWithMask - (semiring: ISemiring<'a>) - (mask: Mask1D) - (vector: Vector<'a>) - (matrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let eWiseAddWithMask - (monoid: IMonoid<'a>) - (mask: Mask2D) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let eWiseMultWithMask - (semiring: ISemiring<'a>) - (mask: Mask2D) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let applyWithMask (mapper: UnaryOp<'a, 'b>) (mask: Mask2D) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let selectWithMask - (predicate: UnaryOp) - (mask: Mask2D) - (matrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let reduceRowsWithMask (monoid: IMonoid<'a>) (mask: Mask1D) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let reduceColsWithMask (monoid: IMonoid<'a>) (mask: Mask1D) (matrix: Matrix<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let kroneckerWithMask - (semiring: ISemiring<'a>) - (mask: Mask2D) - (leftMatrix: Matrix<'a>) - (rightMatrix: Matrix<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - -[] -module MatrixTuples = - let synchronize (matrixTuples: MatrixTuples<'a>) = - opencl { - let! _ = - if matrixTuples.RowIndices.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost matrixTuples.RowIndices - - let! _ = - if matrixTuples.ColumnIndices.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost matrixTuples.ColumnIndices - - let! _ = - if matrixTuples.Values.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost matrixTuples.Values - - return () - } - |> EvalGB.fromCl diff --git a/src/GraphBLAS-sharp/Operations/Scalar.fs b/src/GraphBLAS-sharp/Operations/Scalar.fs deleted file mode 100644 index 4c39d1da..00000000 --- a/src/GraphBLAS-sharp/Operations/Scalar.fs +++ /dev/null @@ -1,44 +0,0 @@ -namespace GraphBLAS.FSharp -// -//open Brahma.FSharp -// -//[] -//module Scalar = -// -// (* -// constructors -// *) -// -// let create (value: 'a) : GraphblasEvaluation> = -// graphblas { return ScalarWrapped { Value = [| value |] } } -// -// (* -// methods -// *) -// -// let copy (scalar: Scalar<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" -// -// let synchronize (scalar: Scalar<'a>) : GraphblasEvaluation = -// match scalar with -// | ScalarWrapped scalar -> -// opencl { -// failwith "FIX ME!" -// //let! _ = ToHost scalar.Value -// return () -// } -// |> EvalGB.fromCl -// -// (* -// assignment and extraction -// *) -// -// let exportValue (scalar: Scalar<'a>) : GraphblasEvaluation<'a> = -// graphblas { -// do! synchronize scalar -// -// match scalar with -// | ScalarWrapped scalar -> return scalar.Value.[0] -// } -// -// let assignValue (scalar: Scalar<'a>) (target: Scalar<'a>) : GraphblasEvaluation = -// failwith "Not Implemented yet" diff --git a/src/GraphBLAS-sharp/Operations/Vector.fs b/src/GraphBLAS-sharp/Operations/Vector.fs deleted file mode 100644 index 072ddfca..00000000 --- a/src/GraphBLAS-sharp/Operations/Vector.fs +++ /dev/null @@ -1,316 +0,0 @@ -namespace GraphBLAS.FSharp - -open Brahma.FSharp.OpenCL -open GraphBLAS.FSharp.Backend -open GraphBLAS.FSharp.Backend.Common - -[] -module Vector = - - (* - constructors - *) - - let build (size: int) (indices: int []) (values: 'a []) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let ofTuples (size: int) (tuples: VectorTuples<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let ofList (size: int) (elements: (int * 'a) list) : GraphblasEvaluation> = - let (indices, values) = - elements - |> Array.ofList - |> Array.sortBy fst - |> Array.unzip - - graphblas { - return - VectorCOO - <| COOVector.FromTuples(size, indices, values) - } - - // можно оставить, но с условием, что будет создаваться full vector - // let ofArray (array: 'a[]) : GraphblasEvaluation> = - // failwith "Not Implemented yet" - - let init (size: int) (initializer: int -> 'a) : GraphblasEvaluation> = failwith "Not Implemented yet" - - let create (size: int) (value: 'a) : GraphblasEvaluation> = failwith "Not Implemented yet" - - let zeroCreate<'a when 'a: struct> (size: int) : GraphblasEvaluation> = - graphblas { - return - VectorCOO - <| COOVector.FromTuples(size, [||], [||]) - } - - (* - methods - *) - - let size (vector: Vector<'a>) : int = failwith "Not Implemented yet" - let copy (vector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" - let resize (size: int) (vector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" - - // NOTE int cant be sync - let nnz (vector: Vector<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" - - let tuples (vector: Vector<'a>) : GraphblasEvaluation> = - match vector with - | VectorCOO vector -> - opencl { - if vector.Values.Length = 0 then - return { Indices = [||]; Values = [||] } - else - failwith "FIX ME!" - let ind = [||] //let! ind = Copy.copyArray vector.Indices - let vals = [||] //let! vals = Copy.copyArray vector.Values - - return { Indices = ind; Values = vals } - } - |> EvalGB.fromCl - - let mask (vector: Vector<'a>) : GraphblasEvaluation = - match vector with - | VectorCOO vector -> - opencl { - failwith "FIX ME!" - let indices = [||] //let! indices = Copy.copyArray vector.Indices - return Mask1D(indices, vector.Size, false) - } - |> EvalGB.fromCl - - let complemented (vector: Vector<'a>) : GraphblasEvaluation = - match vector with - | VectorCOO vector -> - opencl { - failwith "FIX ME!" - let indices = [||] //let! indices = Copy.copyArray vector.Indices - - let! complementedMask = - Mask.GetComplemented.mask1D - <| Mask1D(indices, vector.Size, true) - - return complementedMask - } - |> EvalGB.fromCl - - let switch (vectorFormat: VectorFormat) (vector: Vector<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let synchronize (vector: Vector<'a>) : GraphblasEvaluation = - match vector with - | VectorCOO vector -> - opencl { - let! _ = - if vector.Indices.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vector.Indices - - let! _ = - if vector.Values.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vector.Values - - return () - } - |> EvalGB.fromCl - - let synchronizeAndReturn (vector: Vector<'a>) : GraphblasEvaluation> = - match vector with - | VectorCOO vector -> - opencl { - let! _ = - if vector.Indices.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vector.Indices - - let! _ = - if vector.Values.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vector.Values - - return VectorCOO vector - } - |> EvalGB.fromCl - - (* - assignment, extraction and filling - *) - - /// vec.[mask] - let extractSubVector (vector: Vector<'a>) (mask: Mask1D) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - /// vec.[idx] - let extractValue (vector: Vector<'a>) (idx: int) : GraphblasEvaluation> = failwith "Not Implemented yet" - - // assignToVector - /// t <- vec - let assignVector (target: Vector<'a>) (source: Vector<'a>) : GraphblasEvaluation = - if target.Size <> source.Size then - invalidArg "source" - <| sprintf "The size of source vector must be %A. Received: %A" target.Size source.Size - - match source, target with - | VectorCOO source, VectorCOO target -> - opencl { - target.Indices <- source.Indices - target.Values <- source.Values - } - |> EvalGB.fromCl - - /// t.[mask] <- vec - let assignSubVector (target: Vector<'a>) (mask: Mask1D) (source: Vector<'a>) : GraphblasEvaluation = - if target.Size <> mask.Size then - invalidArg "mask" - <| sprintf "The size of mask must be %A. Received: %A" target.Size mask.Size - - if target.Size <> source.Size then - invalidArg "source" - <| sprintf "The size of source vector must be %A. Received: %A" target.Size source.Size - - match source, target, mask with - | VectorCOO source, VectorCOO target, mask when not mask.IsComplemented -> - opencl { - let! (resultIndices, resultValues) = - COOVector.AssignSubVector.run target.Indices target.Values source.Indices source.Values mask.Indices - - target.Indices <- resultIndices - target.Values <- resultValues - } - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - /// t.[idx] <- value - let assignValue (target: Vector<'a>) (idx: int) (value: Scalar<'a>) : GraphblasEvaluation = - failwith "Not Implemented yet" - - /// vec.[*] <- value - let fillVector (vector: Vector<'a>) (value: Scalar<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" - - /// vec.[mask] <- value - let fillSubVector (vector: Vector<'a>) (mask: Mask1D) (value: Scalar<'a>) : GraphblasEvaluation = - match vector, value, mask with - | VectorCOO vector, ScalarWrapped scalar, mask when not mask.IsComplemented -> - opencl { - let! (resultIndices, resultValues) = - COOVector.FillSubVector.run vector.Indices vector.Values mask.Indices scalar.Value - - vector.Indices <- resultIndices - vector.Values <- resultValues - } - | _ -> failwith "Not Implemented" - |> EvalGB.fromCl - - (* - operations - *) - - let eWiseAdd - (monoid: IMonoid<'a>) - (leftVector: Vector<'a>) - (rightVector: Vector<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let eWiseMult - (semiring: ISemiring<'a>) - (leftVector: Vector<'a>) - (rightVector: Vector<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let apply (mapper: UnaryOp<'a, 'b>) (vector: Vector<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let select (predicate: UnaryOp<'a, bool>) (vector: Vector<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let reduce (monoid: IMonoid<'a>) (vector: Vector<'a>) : GraphblasEvaluation> = - let (ClosedBinaryOp plus) = monoid.Plus - - match vector with - | VectorCOO vector -> - opencl { - let! result = Sum.run vector.Values plus monoid.Zero - return ScalarWrapped { Value = result } - } - |> EvalGB.fromCl - - let eWiseAddWithMask - (monoid: IMonoid<'a>) - (mask: Mask1D) - (leftVector: Vector<'a>) - (rightVector: Vector<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let eWiseMultWithMask - (semiring: ISemiring<'a>) - (mask: Mask1D) - (leftVector: Vector<'a>) - (rightVector: Vector<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let applyWithMask (mapper: UnaryOp<'a, 'b>) (mask: Mask1D) (vector: Vector<'a>) : GraphblasEvaluation> = - failwith "Not Implemented yet" - - let selectWithMask - (predicate: UnaryOp<'a, bool>) - (mask: Mask1D) - (vector: Vector<'a>) - : GraphblasEvaluation> = - failwith "Not Implemented yet" - -[] -module VectorTuples = - let synchronize (vectorTuples: VectorTuples<'a>) = - opencl { - let! _ = - if vectorTuples.Indices.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vectorTuples.Indices - - let! _ = - if vectorTuples.Values.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vectorTuples.Values - - return () - } - |> EvalGB.fromCl - - let synchronizeAndReturn (vectorTuples: VectorTuples<'a>) = - opencl { - let! _ = - if vectorTuples.Indices.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vectorTuples.Indices - - let! _ = - if vectorTuples.Values.Length = 0 then - opencl { return [||] } - else - failwith "FIX ME!" - //ToHost vectorTuples.Values - - return vectorTuples - } - |> EvalGB.fromCl diff --git a/src/GraphBLAS-sharp/Predefined/Monoids/Add.fs b/src/GraphBLAS-sharp/Predefined/Monoids/Add.fs deleted file mode 100644 index 24af1458..00000000 --- a/src/GraphBLAS-sharp/Predefined/Monoids/Add.fs +++ /dev/null @@ -1,32 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module Add = - let int: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = 0 } - - let float: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = 0. } - - let float32: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = 0.f } - - let sbyte: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = 0y } - - let byte: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = 0uy } - - let int16: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = 0s } - - let uint16: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = 0us } diff --git a/src/GraphBLAS-sharp/Predefined/Monoids/Any.fs b/src/GraphBLAS-sharp/Predefined/Monoids/Any.fs deleted file mode 100644 index 3cbfa8d3..00000000 --- a/src/GraphBLAS-sharp/Predefined/Monoids/Any.fs +++ /dev/null @@ -1,8 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module Any = - let bool: Monoid = - { AssociativeOp = ClosedBinaryOp <@ (||) @> - Identity = false } diff --git a/src/GraphBLAS-sharp/Predefined/Monoids/Min.fs b/src/GraphBLAS-sharp/Predefined/Monoids/Min.fs deleted file mode 100644 index 9249925d..00000000 --- a/src/GraphBLAS-sharp/Predefined/Monoids/Min.fs +++ /dev/null @@ -1,12 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module Min = - let int: Monoid = - { AssociativeOp = ClosedBinaryOp <@ fun x y -> System.Math.Min(x, y) @> - Identity = System.Int32.MaxValue } - - let float: Monoid = - { AssociativeOp = ClosedBinaryOp <@ fun x y -> System.Math.Min(x, y) @> - Identity = System.Double.PositiveInfinity } diff --git a/src/GraphBLAS-sharp/Predefined/Semirings/AddMult.fs b/src/GraphBLAS-sharp/Predefined/Semirings/AddMult.fs deleted file mode 100644 index 4253e33f..00000000 --- a/src/GraphBLAS-sharp/Predefined/Semirings/AddMult.fs +++ /dev/null @@ -1,32 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module AddMult = - let int: Semiring = - { PlusMonoid = Add.int - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } - - let float: Semiring = - { PlusMonoid = Add.float - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } - - let float32: Semiring = - { PlusMonoid = Add.float32 - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } - - let sbyte: Semiring = - { PlusMonoid = Add.sbyte - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } - - let byte: Semiring = - { PlusMonoid = Add.byte - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } - - let int16: Semiring = - { PlusMonoid = Add.int16 - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } - - let uint16: Semiring = - { PlusMonoid = Add.uint16 - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } diff --git a/src/GraphBLAS-sharp/Predefined/Semirings/AnyAll.fs b/src/GraphBLAS-sharp/Predefined/Semirings/AnyAll.fs deleted file mode 100644 index ea0d532b..00000000 --- a/src/GraphBLAS-sharp/Predefined/Semirings/AnyAll.fs +++ /dev/null @@ -1,8 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module AnyAll = - let bool: Semiring = - { PlusMonoid = Any.bool - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (&&) @> } } diff --git a/src/GraphBLAS-sharp/Predefined/Semirings/MinAdd.fs b/src/GraphBLAS-sharp/Predefined/Semirings/MinAdd.fs deleted file mode 100644 index fd23eb3f..00000000 --- a/src/GraphBLAS-sharp/Predefined/Semirings/MinAdd.fs +++ /dev/null @@ -1,8 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module MinAdd = - let float: Semiring = - { PlusMonoid = Min.float - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (+) @> } } diff --git a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/BFS.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Algorithms/BFS.fs index 4c7f76d6..a85d8424 100644 --- a/tests/GraphBLAS-sharp.Tests/Algorithms/BFS.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/BFS.fs @@ -23,9 +23,9 @@ let testFixtures (testContext: TestContext) = let bfs = Algorithms.BFS.singleSource - context ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption + context workGroupSize testPropertyWithConfig config testName diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Blit.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Blit.fs new file mode 100644 index 00000000..771f3501 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Blit.fs @@ -0,0 +1,49 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Blit + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let makeTest<'a> isEqual testFun (source: 'a [], sourceIndex, target: 'a [], targetIndex, count) = + + if source.Length > 0 && target.Length > 0 then + + let clSource = context.CreateClArray source + let clTarget = context.CreateClArray target + + testFun processor clSource sourceIndex clTarget targetIndex count + + clSource.Free processor + let actual = clTarget.ToHostAndFree processor + + // write to target --- target expected + Array.blit source sourceIndex target targetIndex count + + "Results should be the same" + |> Utils.compareArrays isEqual actual target + +let createTest<'a when 'a: equality> isEqual = + ClArray.blit context Utils.defaultWorkGroupSize + |> makeTest<'a> isEqual + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest (=) + + if Utils.isFloat64Available context.ClDevice then + createTest Utils.floatIsEqual + + createTest Utils.float32IsEqual + createTest (=) ] + |> testList "Blit" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs similarity index 57% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs index 7c1cfdea..c79d035f 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Choose.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs @@ -13,37 +13,31 @@ let workGroupSize = Utils.defaultWorkGroupSize let config = Utils.defaultConfig -let context = Context.defaultContext.ClContext - -let processor = defaultContext.Queue +let makeTest<'a, 'b> testContext mapFun isEqual choose (array: 'a []) = + let context = testContext.ClContext + let q = testContext.Queue -let makeTest<'a, 'b> testContext choose mapFun isEqual (array: 'a []) = if array.Length > 0 then - let context = testContext.ClContext - let q = testContext.Queue - - let clArray = - context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, array) - - let (clResult: ClArray<'b>) = choose q HostInterop clArray - let hostResult = Array.zeroCreate clResult.Length + let clArray = context.CreateClArray array - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clResult, hostResult, ch)) - |> ignore + let (clResult: ClArray<'b> option) = choose q HostInterop clArray let expectedResult = Array.choose mapFun array - "Result should be the same" - |> Utils.compareArrays isEqual hostResult expectedResult + match clResult with + | Some clResult -> + let hostResult = clResult.ToHostAndFree testContext.Queue -let createTest<'a, 'b> testContext mapFun mapFunQ isEqual = - let context = testContext.ClContext + "Result should be the same" + |> Utils.compareArrays isEqual hostResult expectedResult + | None -> + "Result must be empty" + |> Expect.isTrue (expectedResult.Length = 0) - let choose = - ClArray.choose context workGroupSize mapFunQ - - makeTest<'a, 'b> testContext choose mapFun isEqual +let createTest<'a, 'b> testContext mapFun mapFunQ isEqual = + ClArray.choose mapFunQ testContext.ClContext workGroupSize + |> makeTest<'a, 'b> testContext mapFun isEqual |> testPropertyWithConfig config $"test on %A{typeof<'a>} -> %A{typeof<'b>}" let testFixtures testContext = @@ -61,7 +55,10 @@ let testFixtures testContext = let tests = TestCases.gpuTests "choose id" testFixtures -let makeTest2 isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) = +let makeTest2 testContext isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) = + let context = testContext.ClContext + let processor = testContext.Queue + if firstArray.Length > 0 && secondArray.Length > 0 then let expected = @@ -81,21 +78,23 @@ let makeTest2 isEqual opMap testFun (firstArray: 'a [], secondArray: 'a []) = "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 +let createTest2 testsContext (isEqual: 'a -> 'a -> bool) (opMapQ, opMap) testFun = + testFun opMapQ testsContext.ClContext Utils.defaultWorkGroupSize + |> makeTest2 testsContext isEqual opMap |> testPropertyWithConfig config $"test on %A{typeof<'a>}" -let tests2 = - [ createTest2 (=) ArithmeticOperations.intAdd ClArray.choose2 +let testsFixtures2 testContext = + let context = testContext.ClContext + + [ createTest2 testContext (=) ArithmeticOperations.intAdd ClArray.choose2 if Utils.isFloat64Available context.ClDevice then - createTest2 (=) ArithmeticOperations.floatAdd ClArray.choose2 + createTest2 testContext (=) ArithmeticOperations.floatAdd ClArray.choose2 - createTest2 (=) ArithmeticOperations.float32Add ClArray.choose2 - createTest2 (=) ArithmeticOperations.boolAdd ClArray.choose2 ] - |> testList "choose2 add" + createTest2 testContext (=) ArithmeticOperations.float32Add ClArray.choose2 + createTest2 testContext (=) ArithmeticOperations.boolAdd ClArray.choose2 ] + +let tests2 = + TestCases.gpuTests "choose2 add" testsFixtures2 let allTests = testList "Choose" [ tests; tests2 ] diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ChunkBySize.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ChunkBySize.fs new file mode 100644 index 00000000..ae282f9a --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ChunkBySize.fs @@ -0,0 +1,114 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.ChunkBySize + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let makeTestGetChunk<'a when 'a: equality> testFun (array: 'a [], startPosition, count) = + + if array.Length > 0 then + + let clArray = context.CreateClArray array + + let (clActual: ClArray<'a>) = + testFun processor HostInterop clArray startPosition count + + clArray.Free processor + let actual = clActual.ToHostAndFree processor + + "Results must be the same" + |> Expect.sequenceEqual actual (Array.sub array startPosition count) + +let creatTestSub<'a when 'a: equality> = + ClArray.sub context Utils.defaultWorkGroupSize + |> makeTestGetChunk<'a> + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let subTests = + [ creatTestSub + + if Utils.isFloat64Available context.ClDevice then + creatTestSub + + creatTestSub + creatTestSub + creatTestSub ] + |> testList "getChunk" + +let makeTestChunkBySize<'a when 'a: equality> isEqual testFun (array: 'a [], chunkSize: int) = + + if chunkSize > 0 && array.Length > 0 then + + let clArray = context.CreateClArray array + + let clActual: ClArray<'a> [] = + (testFun processor HostInterop chunkSize clArray) + + clArray.Free processor + + let actual = + clActual + |> Array.map (fun clArray -> clArray.ToHostAndFree processor) + + let expected = Array.chunkBySize chunkSize array + + "Results must be the same" + |> Utils.compareChunksArrays isEqual actual expected + +let chunkBySizeConfig = + { config with + arbitrary = [ typeof ] } + +let creatTestChunkBySize<'a when 'a: equality> isEqual = + ClArray.chunkBySize context Utils.defaultWorkGroupSize + |> makeTestChunkBySize<'a> isEqual + |> testPropertyWithConfig chunkBySizeConfig $"test on %A{typeof<'a>}" + +let chunkBySizeTests = + [ creatTestChunkBySize (=) + + if Utils.isFloat64Available context.ClDevice then + creatTestChunkBySize Utils.floatIsEqual + + creatTestChunkBySize Utils.float32IsEqual + creatTestChunkBySize (=) + creatTestChunkBySize (=) ] + |> testList "chanBySize" + +let creatTestChunkBySizeLazy<'a when 'a: equality> isEqual = + (fun processor allocationMode chunkSize array -> + ClArray.lazyChunkBySize context Utils.defaultWorkGroupSize processor allocationMode chunkSize array + |> Seq.map (fun lazyValue -> lazyValue.Value) + |> Seq.toArray) + |> makeTestChunkBySize<'a> isEqual + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let lazyChunkBySizeTests = + [ creatTestChunkBySizeLazy (=) + + if Utils.isFloat64Available context.ClDevice then + creatTestChunkBySizeLazy Utils.floatIsEqual + + creatTestChunkBySizeLazy Utils.float32IsEqual + creatTestChunkBySizeLazy (=) + creatTestChunkBySizeLazy (=) ] + |> testList "chunkBySize lazy" + +let allTests = + testList + "chunk" + [ subTests + chunkBySizeTests + lazyChunkBySizeTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Concat.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Concat.fs new file mode 100644 index 00000000..d27cdebf --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Concat.fs @@ -0,0 +1,50 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Concat + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClContext + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = Utils.defaultConfig + +let makeTest<'a> isEqual testFun (arrays: 'a [] []) = + + if Seq.length arrays > 0 + && arrays + |> Seq.forall (fun array -> array.Length > 0) then + + let clArrays = arrays |> Seq.map context.CreateClArray + + let clActual: ClArray<'a> = testFun processor HostInterop clArrays + + // release + let actual = clActual.ToHostAndFree processor + + clArrays + |> Seq.iter (fun array -> array.Free processor) + + let expected = Seq.concat arrays |> Seq.toArray + + "Results must be the same" + |> Utils.compareArrays isEqual actual expected + +let createTest<'a> isEqual = + ClArray.concat context Utils.defaultWorkGroupSize + |> makeTest<'a> isEqual + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest (=) + + if Utils.isFloat64Available context.ClDevice then + createTest Utils.floatIsEqual + + createTest Utils.float32IsEqual + createTest (=) ] + |> testList "Concat" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Copy.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Copy.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Copy.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Exists.fs similarity index 80% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Exists.fs index dbbb3415..ff061074 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Exists.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Exists.fs @@ -8,6 +8,7 @@ open Context open Brahma.FSharp open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Objects.ClCell let logger = Log.create "ClArray.containsNonZero.Tests" @@ -28,17 +29,7 @@ let correctnessGenericTest<'a when 'a: struct and 'a: equality> isZero exists (a let result = match vector.ToDevice context with - | ClVector.Dense clArray -> - let resultCell = exists q clArray - let result = Array.zeroCreate 1 - - let res = - q.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(resultCell, result, ch)) - - q.Post(Msg.CreateFreeMsg<_>(resultCell)) - - res.[0] - + | ClVector.Dense clArray -> (exists q clArray: ClCell<_>).ToHostAndFree q | _ -> failwith "Unsupported vector format" $"The results should be the same, vector : {vector}" @@ -46,7 +37,7 @@ let correctnessGenericTest<'a when 'a: struct and 'a: equality> isZero exists (a let createTest<'a when 'a: struct and 'a: equality> isEqual zero = let exists = - ClArray.exists context wgSize Predicates.isSome + ClArray.exists Predicates.isSome context wgSize [ correctnessGenericTest<'a> (isEqual zero) exists |> testPropertyWithConfig config "FSCheck data" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Fill.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Fill.fs new file mode 100644 index 00000000..0921ff26 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Fill.fs @@ -0,0 +1,49 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Fill + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClContext + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let makeTest<'a> isEqual testFun (value: 'a, targetPosition, count, target: 'a []) = + if target.Length > 0 then + + let clTarget = context.CreateClArray target + let clValue = context.CreateClCell value + + testFun processor clValue targetPosition count clTarget + + // release + let actual = clTarget.ToHostAndFree processor + + // write to target + Array.fill target targetPosition count value + + "Results must be the same" + |> Utils.compareArrays isEqual actual target + +let createTest<'a> isEqual = + ClArray.fill context Utils.defaultWorkGroupSize + |> makeTest<'a> isEqual + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest (=) + + if Utils.isFloat64Available context.ClDevice then + createTest (=) + + createTest (=) + createTest (=) ] + |> testList "Fill" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map.fs similarity index 96% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map.fs index be501e41..a49ea492 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map.fs @@ -44,8 +44,7 @@ let createTest<'a when 'a: equality> (testContext: TestContext) (zero: 'a) isEqu let context = testContext.ClContext let map = - ClArray.map context wgSize - <| Map.optionToValueOrZero zero + ClArray.map (Map.optionToValueOrZero zero) context wgSize makeTest testContext map zero isEqual |> testPropertyWithConfig config $"Correctness on {typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map2.fs similarity index 98% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map2.fs index c1ab2af8..ae4342b8 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map2.fs @@ -42,7 +42,7 @@ let createTest<'a when 'a: equality> (testContext: TestContext) isEqual hostMapF let context = testContext.ClContext - let map = ClArray.map2 context wgSize mapFunQ + let map = ClArray.map2 mapFunQ context wgSize makeTest<'a> testContext map hostMapFun isEqual |> testPropertyWithConfig config $"Correctness on {typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Pairwise.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Pairwise.fs new file mode 100644 index 00000000..5bd6957d --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Pairwise.fs @@ -0,0 +1,49 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.Pairwise + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Objects.ClContext + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let makeTest<'a> isEqual testFun (array: 'a []) = + if array.Length > 0 then + + let clArray = context.CreateClArray array + + match testFun processor HostInterop clArray with + | Some (actual: ClArray<_>) -> + let actual = actual.ToHostAndFree processor + + let expected = Array.pairwise array + + "First results must be the same" + |> Utils.compareArrays isEqual actual expected + | None -> + "Result must be empty" + |> Expect.isTrue (array.Size <= 1) + +let createTest<'a> isEqual = + ClArray.pairwise context Utils.defaultWorkGroupSize + |> makeTest<'a> isEqual + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest (=) + + if Utils.isFloat64Available context.ClDevice then + createTest (=) + + createTest (=) + createTest (=) ] + |> testList "Pairwise" diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/RemoveDuplicates.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/RemoveDuplicates.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/RemoveDuplicates.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/RemoveDuplicates.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Replicate.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/ClArray/Replicate.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Replicate.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/Gather.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Gather.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/Gather.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Gather.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/Merge.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Merge.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/Merge.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Merge.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Reduce.fs similarity index 97% rename from tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Reduce.fs index d6d47640..3500e639 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Reduce.fs @@ -52,7 +52,7 @@ let makeTest (reduce: MailboxProcessor<_> -> ClArray<'a> -> ClCell<'a>) plus zer |> Expect.equal actualSum expectedSum let testFixtures plus plusQ zero name = - let reduce = Reduce.reduce context wgSize plusQ + let reduce = Reduce.reduce plusQ context wgSize makeTest reduce plus zero |> testPropertyWithConfig config $"Correctness on %s{name}" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/ReduceByKey.fs similarity index 73% rename from tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/ReduceByKey.fs index 09e0b21a..772eafb5 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/ReduceByKey.fs @@ -49,7 +49,7 @@ let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = let resultLength = Array.length <| Array.distinct keys - let clActualKeys, clActualValues: ClArray * ClArray<'a> = + let clActualValues, clActualKeys: ClArray<'a> * ClArray = reduce processor HostInterop resultLength clKeys clValues clValues.Free processor @@ -63,7 +63,7 @@ let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = let createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = - Reduce.ByKey.sequential context Utils.defaultWorkGroupSize reduceOpQ + Reduce.ByKey.sequential reduceOpQ context Utils.defaultWorkGroupSize makeTest isEqual reduce reduceOp |> testPropertyWithConfig config $"test on {typeof<'a>}" @@ -97,7 +97,7 @@ let sequentialTest = let createTestOneWorkGroup<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = - Reduce.ByKey.oneWorkGroupSegments context Utils.defaultWorkGroupSize reduceOpQ + Reduce.ByKey.oneWorkGroupSegments reduceOpQ context Utils.defaultWorkGroupSize makeTest isEqual reduce reduceOp |> testPropertyWithConfig @@ -155,7 +155,7 @@ let makeTestSequentialSegments isEqual reduce reduceOp (valuesAndKeys: (int * 'a let clValues = context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) - let clReducedKeys, clReducedValues: ClArray * ClArray<'a> = + let clReducedValues, clReducedKeys: ClArray<'a> * ClArray = reduce processor DeviceOnly resultLength clOffsets clKeys clValues let reducedKeys = clReducedKeys.ToHostAndFree processor @@ -166,7 +166,7 @@ let makeTestSequentialSegments isEqual reduce reduceOp (valuesAndKeys: (int * 'a let createTestSequentialSegments<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = - Reduce.ByKey.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ + Reduce.ByKey.segmentSequential reduceOpQ context Utils.defaultWorkGroupSize makeTestSequentialSegments isEqual reduce reduceOp |> testPropertyWithConfig { config with startSize = 1000 } $"test on {typeof<'a>}" @@ -232,7 +232,7 @@ let makeTest2D isEqual reduce reduceOp (array: (int * int * 'a) []) = Array.length <| Array.distinctBy (fun (fst, snd, _) -> (fst, snd)) array - let clFirstActualKeys, clSecondActualKeys, clActualValues: ClArray * ClArray * ClArray<'a> = + let clActualValues, clFirstActualKeys, clSecondActualKeys: ClArray<'a> * ClArray * ClArray = reduce processor HostInterop resultLength clFirstKeys clSecondKeys clValues clValues.Free processor @@ -252,12 +252,12 @@ let makeTest2D isEqual reduce reduceOp (array: (int * int * 'a) []) = let createTestSequential2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = - Reduce.ByKey2D.sequential context Utils.defaultWorkGroupSize reduceOpQ + Reduce.ByKey2D.sequential reduceOpQ context Utils.defaultWorkGroupSize makeTest2D isEqual reduce reduceOp |> testPropertyWithConfig { config with - arbitrary = [ typeof ] + arbitrary = [ typeof ] endSize = 10 } $"test on {typeof<'a>}" @@ -316,7 +316,7 @@ let makeTestSequentialSegments2D isEqual reduce reduceOp (array: (int * int * 'a let clValues = context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) - let clFirstActualKeys, clSecondActualKeys, clReducedValues: ClArray * ClArray * ClArray<'a> = + let clReducedValues, clFirstActualKeys, clSecondActualKeys: ClArray<'a> * ClArray * ClArray = reduce processor DeviceOnly resultLength clOffsets clFirstKeys clSecondKeys clValues let reducedFirsKeys = @@ -331,12 +331,12 @@ let makeTestSequentialSegments2D isEqual reduce reduceOp (array: (int * int * 'a let createTestSequentialSegments2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = - Reduce.ByKey2D.segmentSequential context Utils.defaultWorkGroupSize reduceOpQ + Reduce.ByKey2D.segmentSequential reduceOpQ context Utils.defaultWorkGroupSize makeTestSequentialSegments2D isEqual reduce reduceOp |> testPropertyWithConfig { config with - arbitrary = [ typeof ] } + arbitrary = [ typeof ] } $"test on {typeof<'a>}" let sequentialSegment2DTests = @@ -366,14 +366,91 @@ let sequentialSegment2DTests = testList "Sequential segments 2D" [ addTests; mulTests ] -let checkResult2DOption isEqual firstActualKeys secondActualKeys actualValues firstKeys secondKeys values reduceOp = +// segments sequential Option +let createReduceOp reduceOp left right = + match left, right with + | Some left, Some right -> reduceOp left right + | Some value, None + | None, Some value -> Some value + | _ -> None + +let checkResultOption isEqual keys values reduceOp actual = + + let reduceOp = createReduceOp reduceOp + + let expectedKeys, expectedValues = + 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 (key, value) -> + match value with + | Some value -> Some(key, value) + | _ -> None) + |> Array.unzip + + match actual with + | Some (actualValues, actualKeys) -> + "First keys must be the same" + |> Utils.compareArrays (=) actualKeys expectedKeys + + "Values must the same" + |> Utils.compareArrays isEqual actualValues expectedValues + | None -> Expect.isTrue (expectedValues.Length = 0) "Result should be Some _" + +let testOption<'a> isEqual reduceOp testFun (array: (int * 'a) []) = + if array.Length > 0 then + let array = Array.sortBy fst array + + let offsets = getOffsets array + + let keys, values = Array.unzip array + + let clOffsets = + context.CreateClArrayWithSpecificAllocationMode(HostInterop, offsets) + + let clKeys = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys) + + let clValues = + context.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + testFun processor HostInterop offsets.Length clOffsets clKeys clValues + |> Option.bind + (fun ((clActualValues, clActualKeys): ClArray<_> * ClArray<_>) -> + let actualValues = clActualValues.ToHostAndFree processor + let actualKeys = clActualKeys.ToHostAndFree processor + + Some(actualValues, actualKeys)) + |> checkResultOption isEqual keys 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 createTestOption (isEqual: 'a -> 'a -> bool) (reduceOpQ, reduceOp) = + Reduce.ByKey.Option.segmentSequential reduceOpQ context Utils.defaultWorkGroupSize + |> testOption<'a> isEqual reduceOp + |> testPropertyWithConfig + { config with + arbitrary = [ typeof ] } + $"test on {typeof<'a>}" + +let testsSegmentsSequentialOption = + [ createTestOption (=) ArithmeticOperations.intAdd + + if Utils.isFloat64Available context.ClDevice then + createTestOption Utils.floatIsEqual ArithmeticOperations.floatAdd + + createTestOption Utils.float32IsEqual ArithmeticOperations.float32Add + createTestOption (=) ArithmeticOperations.boolAdd ] + |> testList "option" + + +// segments sequential Option 2D +let checkResult2DOption isEqual firstKeys secondKeys values reduceOp actual = + let reduceOp = createReduceOp reduceOp let expectedFirstKeys, expectedSecondKeys, expectedValues = let keys = Array.zip firstKeys secondKeys @@ -393,16 +470,19 @@ let checkResult2DOption isEqual firstActualKeys secondActualKeys actualValues fi | _ -> None) |> Array.unzip3 - "First keys must be the same" - |> Utils.compareArrays (=) firstActualKeys expectedFirstKeys + match actual with + | Some (actualValues, firstActualKeys, secondActualKeys) -> + "First keys must be the same" + |> Utils.compareArrays (=) firstActualKeys expectedFirstKeys - "Second keys must be the same" - |> Utils.compareArrays (=) secondActualKeys expectedSecondKeys + "Second keys must be the same" + |> Utils.compareArrays (=) secondActualKeys expectedSecondKeys - "Values must the same" - |> Utils.compareArrays isEqual actualValues expectedValues + "Values must the same" + |> Utils.compareArrays isEqual actualValues expectedValues + | None -> Expect.isTrue (expectedValues.Length = 0) "Result should be Some _" -let test2DOption<'a> isEqual reduce reduceOp (array: (int * int * 'a) []) = +let test2DOption<'a> isEqual reduceOp reduce (array: (int * int * 'a) []) = if array.Length > 0 then let array = Array.sortBy (fun (fst, snd, _) -> fst, snd) array @@ -423,27 +503,26 @@ let test2DOption<'a> isEqual reduce reduceOp (array: (int * int * 'a) []) = 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 + reduce processor DeviceOnly offsets.Length clOffsets clFirstKeys clSecondKeys clValues + |> Option.bind + (fun ((clReducedValues, clFirstActualKeys, clSecondActualKeys): ClArray<'a> * ClArray * ClArray) -> + let reducedFirstKeys = + clFirstActualKeys.ToHostAndFree processor - let reducesSecondKeys = - clSecondActualKeys.ToHostAndFree processor + let reducedSecondKeys = + clSecondActualKeys.ToHostAndFree processor - let reducedValues = clReducedValues.ToHostAndFree processor + let reducedValues = clReducedValues.ToHostAndFree processor - checkResult2DOption isEqual reducedFirsKeys reducesSecondKeys reducedValues firstKeys secondKeys values reduceOp + Some(reducedValues, reducedFirstKeys, reducedSecondKeys)) + |> checkResult2DOption isEqual 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 + Reduce.ByKey2D.Option.segmentSequential reduceOpQ context Utils.defaultWorkGroupSize + |> test2DOption<'a> isEqual reduceOp |> testPropertyWithConfig { config with - arbitrary = [ typeof ] } + arbitrary = [ typeof ] } $"test on {typeof<'a>}" let testsSegmentsSequential2DOption = @@ -464,4 +543,5 @@ let allTests = sequentialSegmentTests sequential2DTest sequentialSegment2DTests + testsSegmentsSequentialOption testsSegmentsSequential2DOption ] diff --git a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Sum.fs similarity index 98% rename from tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Sum.fs index e094d572..977b085e 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Reduce/Sum.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Sum.fs @@ -51,7 +51,7 @@ let makeTest plus zero sum (array: 'a []) = |> Expect.equal actualSum expectedSum let testFixtures plus (plusQ: Expr<'a -> 'a -> 'a>) zero name = - Reduce.sum context wgSize plusQ zero + Reduce.sum plusQ zero context wgSize |> makeTest plus zero |> testPropertyWithConfig config (sprintf "Correctness on %s" name) diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/ByKey.fs similarity index 98% rename from tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/ByKey.fs index 1cb81709..a89b5f36 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scan/ByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/ByKey.fs @@ -53,7 +53,7 @@ let createTest (zero: 'a) opAddQ opAdd isEqual deviceScan hostScan = let hostScan = hostScan zero opAdd let deviceScan = - deviceScan context Utils.defaultWorkGroupSize opAddQ zero + deviceScan opAddQ zero context Utils.defaultWorkGroupSize makeTestSequentialSegments isEqual hostScan deviceScan |> testPropertyWithConfig Utils.defaultConfig $"test on {typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/PrefixSum.fs similarity index 98% rename from tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/PrefixSum.fs index 734b96f9..fbf12398 100644 --- a/tests/GraphBLAS-sharp.Tests/Common/Scan/PrefixSum.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/PrefixSum.fs @@ -61,7 +61,7 @@ let makeTest plus zero isEqual scan (array: 'a []) = |> Tests.Utils.compareArrays isEqual actual expected let testFixtures plus plusQ zero isEqual name = - PrefixSum.runIncludeInplace plusQ context wgSize + PrefixSum.runIncludeInPlace plusQ context wgSize |> makeTest plus zero isEqual |> testPropertyWithConfig config $"Correctness on %s{name}" diff --git a/tests/GraphBLAS-sharp.Tests/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scatter.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/Scatter.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Scatter.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Bitonic.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Common/Sort/Bitonic.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Bitonic.fs diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Radix.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Radix.fs new file mode 100644 index 00000000..2f565f3e --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Radix.fs @@ -0,0 +1,83 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.Sort.Radix + +open Expecto +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 + +let config = + { Utils.defaultConfig with + startSize = 1000000 } + +let workGroupSize = Utils.defaultWorkGroupSize + +let processor = Context.defaultContext.Queue + +let context = Context.defaultContext.ClContext + +let checkResultByKeys (inputArray: (int * 'a) []) (actualValues: 'a []) = + 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) []) = + + if array.Length > 0 then + let keys = Array.map fst array + let values = Array.map snd array + + let clKeys = keys.ToDevice context + let clValues = values.ToDevice context + + let clActualValues: ClArray<'a> = + sortFun processor HostInterop clKeys clValues + + let actualValues = clActualValues.ToHostAndFree processor + + checkResultByKeys array actualValues + +let createTestByKeys<'a when 'a: equality and 'a: struct> = + let sort = + Radix.runByKeysStandard context workGroupSize + + makeTestByKeys<'a> sort + |> testPropertyWithConfig config $"test on {typeof<'a>}" + +let testByKeys = + [ createTestByKeys + createTestByKeys + + if Utils.isFloat64Available context.ClDevice then + createTestByKeys + + createTestByKeys + createTestByKeys ] + |> testList "Radix sort by keys" + +let makeTestKeysOnly sort (keys: uint []) = + if keys.Length > 0 then + let keys = Array.map int keys + + let clKeys = keys.ToDevice context + + let actual = + (sort processor clKeys: ClArray) + .ToHostAndFree processor + + let expected = Array.sort keys + + "Keys must be the same" + |> Expect.sequenceEqual expected actual + +let testKeysOnly = + let sort = + Radix.standardRunKeysOnly context workGroupSize + + makeTestKeysOnly sort + |> testPropertyWithConfig config $"keys only" + +let allTests = + testList "Radix" [ testKeysOnly; testByKeys ] diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ByRows.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ByRows.fs new file mode 100644 index 00000000..98270784 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ByRows.fs @@ -0,0 +1,60 @@ +module GraphBLAS.FSharp.Tests.Matrix.ByRows + +open Expecto +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Objects.ClVectorExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = Utils.defaultConfig + +let makeTest<'a when 'a: struct> isEqual zero testFun (array: 'a [,]) = + + let matrix = + Matrix.CSR.FromArray2D(array, isEqual zero) + + if matrix.NNZ > 0 then + + let clMatrix = matrix.ToDevice context + + let rows = testFun processor HostInterop clMatrix + + "Rows count must be the same" + |> Expect.equal (Seq.length rows) (Array2D.length1 array) + + rows + |> Seq.iteri + (fun index -> + function + | Some (actualRow: ClVector.Sparse<_>) -> + let expectedRow = + Vector.Sparse.FromArray(array.[index, *], (isEqual zero)) + + let actualHost = actualRow.ToHost processor + + Utils.compareSparseVectors isEqual actualHost expectedRow + | None -> + "Expected row must be None" + |> Expect.isFalse (Array.exists ((<<) not <| isEqual zero) array.[index, *])) + +let createTest isEqual (zero: 'a) = + CSR.Matrix.byRows 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 Utils.floatIsEqual 0.0 + + createTest Utils.float32IsEqual 0.0f + createTest (=) false ] + |> testList "CSR byRows" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Convert.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Convert.fs new file mode 100644 index 00000000..c27bf511 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Convert.fs @@ -0,0 +1,87 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.Convert + +open Expecto +open Expecto.Logging +open Expecto.Logging.Message +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Context +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Objects.MatrixExtensions +open GraphBLAS.FSharp.Backend.Objects.ClContext + +let logger = Log.create "Convert.Tests" + +let config = Utils.defaultConfig + +let workGroupSize = Utils.defaultWorkGroupSize + +let context = defaultContext.ClContext + +let q = defaultContext.Queue + +q.Error.Add(fun e -> failwithf "%A" e) + +let makeTest context q formatFrom formatTo convertFun isZero (array: 'a [,]) = + let mtx = + Utils.createMatrixFromArray2D formatFrom array isZero + + if mtx.NNZ > 0 then + let actual = + let mBefore = mtx.ToDevice context + let mAfter: ClMatrix<'a> = convertFun q HostInterop mBefore + let res = mAfter.ToHost q + mBefore.Dispose q + mAfter.Dispose q + res + + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" (sprintf "%A" actual) + ) + + let expected = + Utils.createMatrixFromArray2D formatTo array isZero + + "Row count should be the same" + |> Expect.equal actual.RowCount (Array2D.length1 array) + + "Column count should be the same" + |> Expect.equal actual.ColumnCount (Array2D.length2 array) + + "Matrices should be equal" + |> Expect.equal actual expected + +let createTest<'a when 'a: struct and 'a: equality> convertFun formatTo (isZero: 'a -> bool) = + let convertFun = + convertFun context Utils.defaultWorkGroupSize + + Utils.listOfUnionCases + |> List.map + (fun formatFrom -> + makeTest context q formatFrom formatTo convertFun isZero + |> testPropertyWithConfig config $"test on %A{typeof<'a>} from %A{formatFrom}") + +let testFixtures formatTo = + match formatTo with + | COO -> + [ createTest Matrix.toCOO formatTo ((=) 0) + createTest Matrix.toCOO formatTo ((=) false) ] + | CSR -> + [ createTest Matrix.toCSR formatTo ((=) 0) + createTest Matrix.toCSR formatTo ((=) false) ] + | CSC -> + [ createTest Matrix.toCSC formatTo ((=) 0) + createTest Matrix.toCSC formatTo ((=) false) ] + | LIL -> + [ createTest Matrix.toLIL formatTo ((=) 0) + createTest Matrix.toLIL formatTo ((=) false) ] + |> List.concat + |> testList $"%A{formatTo}" + +let tests = + Utils.listOfUnionCases + |> List.map testFixtures + |> testList "Convert" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs similarity index 77% rename from tests/GraphBLAS-sharp.Tests/Matrix/Map.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs index b89042a4..6276019b 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs @@ -59,33 +59,35 @@ let correctnessGenericTest (case: OperationCase) (matrix: 'a [,]) = + match case.Format with + | LIL -> () + | _ -> + let mtx = + Utils.createMatrixFromArray2D case.Format matrix (isEqual zero) - let mtx = - Utils.createMatrixFromArray2D case.Format matrix (isEqual zero) + if mtx.NNZ > 0 then + try + let m = mtx.ToDevice case.TestContext.ClContext - if mtx.NNZ > 0 then - try - let m = mtx.ToDevice case.TestContext.ClContext + let res = addFun q HostInterop m - let res = addFun q HostInterop m + m.Dispose q - m.Dispose q + let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res + let actual = cooRes.ToHost q - let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res - let actual = cooRes.ToHost q + cooRes.Dispose q + res.Dispose q - cooRes.Dispose q - res.Dispose q + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" (sprintf "%A" actual) + ) - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" (sprintf "%A" actual) - ) - - checkResult isEqual op zero matrix actual - with - | ex when ex.Message = "InvalidBufferSize" -> () - | ex -> raise ex + checkResult isEqual op zero matrix actual + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex let createTestMap case (zero: 'a) (constant: 'a) binOp isEqual opQ = let getCorrectnessTestName = getCorrectnessTestName case @@ -96,7 +98,7 @@ let createTestMap case (zero: 'a) (constant: 'a) binOp isEqual opQ = let unaryOp = binOp constant let unaryOpQ = opQ zero constant - let map = Matrix.map context unaryOpQ wgSize + let map = Matrix.map unaryOpQ context wgSize let toCOO = Matrix.toCOO context wgSize @@ -111,7 +113,7 @@ let testFixturesMapNot case = createTestMap case false true (fun _ -> not) (=) (fun _ _ -> ArithmeticOperations.notOption) ] let notTests = - operationGPUTests "Backend.Matrix.map not tests" testFixturesMapNot + operationGPUTests "not" testFixturesMapNot let testFixturesMapAdd case = [ let context = case.TestContext.ClContext @@ -128,7 +130,7 @@ let testFixturesMapAdd case = createTestMap case 0uy 10uy (+) (=) ArithmeticOperations.addLeftConst ] let addTests = - operationGPUTests "Backend.Matrix.map add tests" testFixturesMapAdd + operationGPUTests "add" testFixturesMapAdd let testFixturesMapMul case = [ let context = case.TestContext.ClContext @@ -145,4 +147,7 @@ let testFixturesMapMul case = createTestMap case 0uy 10uy (*) (=) ArithmeticOperations.mulLeftConst ] let mulTests = - operationGPUTests "Backend.Matrix.map mul tests" testFixturesMapMul + operationGPUTests "mul" testFixturesMapMul + +let allTests = + testList "Map" [ addTests; mulTests; notTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs similarity index 71% rename from tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs index ae5e0e22..1a8e2dab 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs @@ -59,39 +59,41 @@ let correctnessGenericTest (case: OperationCase) (leftMatrix: 'a [,], rightMatrix: 'a [,]) = + match case.Format with // TODO(map2 on LIL) + | LIL -> () + | _ -> + let mtx1 = + Utils.createMatrixFromArray2D case.Format leftMatrix (isEqual zero) - let mtx1 = - Utils.createMatrixFromArray2D case.Format leftMatrix (isEqual zero) + let mtx2 = + Utils.createMatrixFromArray2D case.Format rightMatrix (isEqual zero) - let mtx2 = - Utils.createMatrixFromArray2D case.Format rightMatrix (isEqual zero) + if mtx1.NNZ > 0 && mtx2.NNZ > 0 then + try + let m1 = mtx1.ToDevice case.TestContext.ClContext - if mtx1.NNZ > 0 && mtx2.NNZ > 0 then - try - let m1 = mtx1.ToDevice case.TestContext.ClContext + let m2 = mtx2.ToDevice case.TestContext.ClContext - let m2 = mtx2.ToDevice case.TestContext.ClContext + let res = addFun q HostInterop m1 m2 - let res = addFun q HostInterop m1 m2 + m1.Dispose q + m2.Dispose q - m1.Dispose q - m2.Dispose q + let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res + let actual = cooRes.ToHost q - let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res - let actual = cooRes.ToHost q + cooRes.Dispose q + res.Dispose q - cooRes.Dispose q - res.Dispose q + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" (sprintf "%A" actual) + ) - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" (sprintf "%A" actual) - ) - - checkResult isEqual op zero leftMatrix rightMatrix actual - with - | ex when ex.Message = "InvalidBufferSize" -> () - | ex -> raise ex + checkResult isEqual op zero leftMatrix rightMatrix actual + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex let creatTestMap2Add case (zero: 'a) add isEqual addQ map2 = let getCorrectnessTestName = getCorrectnessTestName case @@ -99,7 +101,7 @@ let creatTestMap2Add case (zero: 'a) add isEqual addQ map2 = let context = case.TestContext.ClContext let q = case.TestContext.Queue - let map2 = map2 context addQ wgSize + let map2 = map2 addQ context wgSize let toCOO = Matrix.toCOO context wgSize @@ -112,7 +114,7 @@ let testFixturesMap2Add case = let q = case.TestContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSum Matrix.map2 + creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSumOption Matrix.map2 creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumOption Matrix.map2 if Utils.isFloat64Available context.ClDevice then @@ -149,36 +151,6 @@ let testFixturesMap2AddAtLeastOne case = let addAtLeastOneTests = operationGPUTests "Backend.Matrix.map2AtLeastOne add tests" testFixturesMap2AddAtLeastOne -let testFixturesMap2AddAtLeastOneToCOO case = - [ let context = case.TestContext.ClContext - let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) - - creatTestMap2Add case false (||) (=) ArithmeticOperations.boolSumAtLeastOne Matrix.map2AtLeastOneToCOO - creatTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumAtLeastOne Matrix.map2AtLeastOneToCOO - - if Utils.isFloat64Available context.ClDevice then - creatTestMap2Add - case - 0.0 - (+) - Utils.floatIsEqual - ArithmeticOperations.floatSumAtLeastOne - Matrix.map2AtLeastOneToCOO - - creatTestMap2Add - case - 0.0f - (+) - Utils.float32IsEqual - ArithmeticOperations.float32SumAtLeastOne - Matrix.map2AtLeastOneToCOO - - creatTestMap2Add case 0uy (+) (=) ArithmeticOperations.byteSumAtLeastOne Matrix.map2AtLeastOneToCOO ] - -let addAtLeastOneToCOOTests = - operationGPUTests "Backend.Matrix.map2AtLeastOneToCOO add tests" testFixturesMap2AddAtLeastOneToCOO - let testFixturesMap2MulAtLeastOne case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue @@ -202,3 +174,10 @@ let testFixturesMap2MulAtLeastOne case = let mulAtLeastOneTests = operationGPUTests "Backend.Matrix.map2AtLeastOne multiplication tests" testFixturesMap2MulAtLeastOne + +let allTests = + testList + "Map2" + [ addTests + addAtLeastOneTests + mulAtLeastOneTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Merge.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Merge.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Matrix/Merge.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Matrix/Merge.fs diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/RowsLengths.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/RowsLengths.fs new file mode 100644 index 00000000..6aab0988 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/RowsLengths.fs @@ -0,0 +1,65 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.RowsLengths + +open Expecto +open Microsoft.FSharp.Collections +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Matrix +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 processor = Context.defaultContext.Queue + +let context = Context.defaultContext.ClContext + +let config = Utils.defaultConfig + +let makeTest isZero testFun (array: 'a [,]) = + + let matrix = Matrix.CSR.FromArray2D(array, isZero) + + if matrix.NNZ > 0 then + + let clMatrix = matrix.ToDevice context + let (clActual: ClArray) = testFun processor HostInterop clMatrix + + clMatrix.Dispose processor + let actual = clActual.ToHostAndFree processor + + let expected = + Array.zeroCreate <| Array2D.length1 array + + // count nnz in each row + for i in 0 .. Array2D.length1 array - 1 do + let nnzRowCount = + array.[i, *] + |> Array.fold + (fun count item -> + if not <| isZero item then + count + 1 + else + count) + 0 + + expected.[i] <- nnzRowCount + + "Results must be the same" + |> Utils.compareArrays (=) actual expected + +let createTest<'a when 'a: struct> (isZero: 'a -> bool) = + CSR.Matrix.NNZInRows context Utils.defaultWorkGroupSize + |> makeTest isZero + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest <| (=) 0 + + if Utils.isFloat64Available context.ClDevice then + createTest <| Utils.floatIsEqual 0.0 + + createTest <| Utils.float32IsEqual 0.0f + createTest <| (=) false ] + |> testList "CSR.RowsLengths" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs new file mode 100644 index 00000000..5f7c1b78 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs @@ -0,0 +1,244 @@ +module GraphBLAS.FSharp.Tests.Matrix.SpGeMM.Expand + +open Expecto +open GraphBLAS.FSharp.Backend.Matrix.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 + +processor.Error.Add(fun e -> failwithf "%A" e) + +let config = + { Utils.defaultConfig with + arbitrary = + [ typeof + typeof ] } + +let makeTest isZero testFun (leftArray: 'a [], rightArray: 'a [,]) = + + let leftMatrixRow = + Vector.Sparse.FromArray(leftArray, isZero) + + let rightMatrix = + Matrix.CSR.FromArray2D(rightArray, isZero) + + if leftMatrixRow.NNZ > 0 && rightMatrix.NNZ > 0 then + + // compute expected result + let rightMatrixRowsLength = + rightMatrix.RowPointers + |> Array.pairwise + |> Array.map (fun (fst, snd) -> snd - fst) + + let expectedPointers, expectedLength = + Array.init leftMatrixRow.Indices.Length (fun index -> rightMatrixRowsLength.[leftMatrixRow.Indices.[index]]) + |> HostPrimitives.prefixSumExclude 0 (+) + + let clLeftMatrixRow = leftMatrixRow.ToDevice context + + let clRightMatrixRowsLength = + context.CreateClArray rightMatrixRowsLength + + let actualLength, (clActual: ClArray) = + testFun processor clLeftMatrixRow clRightMatrixRowsLength + + clLeftMatrixRow.Dispose processor + + let actualPointers = clActual.ToHostAndFree processor + + "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) = + Expand.getSegmentPointers context Utils.defaultWorkGroupSize + |> makeTest isZero + |> testPropertyWithConfig config $"test on {typeof<'a>}" + +// Debug tests +let getSegmentsTests = + [ createTest ((=) 0) + + if Utils.isFloat64Available context.ClDevice then + createTest ((=) 0.0) + + createTest ((=) 0f) + createTest ((=) false) + createTest ((=) 0uy) ] + |> testList "get segment pointers" + +let expand (leftMatrixRow: Vector.Sparse<'a>) (rightMatrix: Matrix.CSR<'b>) = + let rightMatrixRowsLengths = + rightMatrix.RowPointers + |> Array.pairwise + |> Array.map (fun (fst, snd) -> snd - fst) + + let segmentsLengths = + Array.map (fun columnIndex -> rightMatrixRowsLengths.[columnIndex]) leftMatrixRow.Indices + + let leftMatrixValues = + Array.map2 Array.create segmentsLengths leftMatrixRow.Values + |> Array.concat + + let rightMatrixRowPointers = + Array.map (fun index -> rightMatrix.RowPointers.[index]) leftMatrixRow.Indices + + let rightMatrixValues = + Array.map2 + (fun rowPointer segmentLength -> Array.take segmentLength rightMatrix.Values.[rowPointer..]) + rightMatrixRowPointers + segmentsLengths + |> Array.concat + + let columns = + Array.map2 + (fun rowPointer segmentLength -> Array.take segmentLength rightMatrix.ColumnIndices.[rowPointer..]) + rightMatrixRowPointers + segmentsLengths + |> Array.concat + + leftMatrixValues, rightMatrixValues, columns + +let makeExpandTest isEqual zero testFun (leftArray: 'a [], rightArray: 'a [,]) = + + let leftMatrixRow = + Vector.Sparse.FromArray(leftArray, (isEqual zero)) + + let rightMatrix = + Matrix.CSR.FromArray2D(rightArray, (isEqual zero)) + + if leftMatrixRow.NNZ > 0 && rightMatrix.NNZ > 0 then + + let clPointers, lenght = + rightMatrix.RowPointers + |> Array.pairwise + |> Array.map (fun (fst, snd) -> snd - fst) + |> fun rightMatrixRowsLengths -> + Array.init + leftMatrixRow.Indices.Length + (fun index -> rightMatrixRowsLengths.[leftMatrixRow.Indices.[index]]) + |> HostPrimitives.prefixSumExclude 0 (+) + |> fun (pointers, length) -> context.CreateClArray(pointers), length + + let clLeftMatrixRow = leftMatrixRow.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + + let result = + testFun processor lenght clPointers clLeftMatrixRow clRightMatrix + + clLeftMatrixRow.Dispose processor + clRightMatrix.Dispose processor + clPointers.Free processor + + let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns = expand leftMatrixRow rightMatrix + + match result with + | Some (clActualLeftValues: ClArray<'a>, clActualRightValues: ClArray<'a>, clActualColumns: ClArray) -> + + let actualLeftValues = + clActualLeftValues.ToHostAndFree processor + + let actualRightValues = + clActualRightValues.ToHostAndFree processor + + let actualColumns = clActualColumns.ToHostAndFree processor + + "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 + | None -> + "Result must be empty" + |> Expect.isTrue (expectedColumns.Length = 0) + +let createExpandTest isEqual (zero: 'a) testFun = + testFun context Utils.defaultWorkGroupSize + |> makeExpandTest isEqual zero + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +// (Debug only) 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 makeGeneralTest<'a when 'a: struct> 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 + + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + + let (clMatrixActual: ClMatrix<_>) = + testFun processor HostInterop clLeftMatrix clRightMatrix + + clLeftMatrix.Dispose processor + clRightMatrix.Dispose processor + + let matrixActual = + clMatrixActual.ToHostAndDispose processor + + match matrixActual with + | Matrix.LIL actual -> + HostPrimitives.array2DMultiplication zero opMul opAdd leftArray rightArray + |> fun array -> Matrix.LIL.FromArray2D(array, (isEqual zero)) + |> Utils.compareLILMatrix isEqual actual + | _ -> failwith "Matrix format are not matching" + +let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = + testFun opAddQ opMulQ context Utils.defaultWorkGroupSize + |> makeGeneralTest<'a> zero isEqual opMul opAdd + |> testPropertyWithConfig { config with endSize = 500 } $"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/SpGeMM/Masked.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Masked.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Masked.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Masked.fs diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Transpose.fs similarity index 85% rename from tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Matrix/Transpose.fs index 4e894609..01e78bf7 100644 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Transpose.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Transpose.fs @@ -77,28 +77,32 @@ let checkResult areEqual zero actual (expected2D: 'a [,]) = "Value arrays should be equal" |> Utils.compareArrays areEqual actual.Values expected.Values + | _ -> () // TODO() let makeTestRegular context q transposeFun hostTranspose isEqual zero case (array: 'a [,]) = - let mtx = - Utils.createMatrixFromArray2D case.Format array (isEqual zero) - - if mtx.NNZ > 0 then - let actual = - let m = mtx.ToDevice context - let (mT: ClMatrix<'a>) = transposeFun q HostInterop m - let res = mT.ToHost q - m.Dispose q - mT.Dispose q - res - - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" $"%A{actual}" - ) - - let expected2D = hostTranspose array - - checkResult isEqual zero actual expected2D + match case.Format with + | LIL -> () + | _ -> + let mtx = + Utils.createMatrixFromArray2D case.Format array (isEqual zero) + + if mtx.NNZ > 0 then + let actual = + let m = mtx.ToDevice context + let (mT: ClMatrix<'a>) = transposeFun q HostInterop m + let res = mT.ToHost q + m.Dispose q + mT.Dispose q + res + + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" $"%A{actual}" + ) + + let expected2D = hostTranspose array + + checkResult isEqual zero actual expected2D let createTest<'a when 'a: equality and 'a: struct> case (zero: 'a) isEqual = let context = case.TestContext.ClContext diff --git a/tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/BFS.fs b/tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/Algorithms/BFS.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/BFS.fs rename to tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/Algorithms/BFS.fs diff --git a/tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/ConnectedComponents.fs b/tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/Algorithms/ConnectedComponents.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/QuickGraph/Algorithms/ConnectedComponents.fs rename to tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/Algorithms/ConnectedComponents.fs diff --git a/tests/GraphBLAS-sharp.Tests/QuickGraph/CreateGraph.fs b/tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/CreateGraph.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/QuickGraph/CreateGraph.fs rename to tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/CreateGraph.fs diff --git a/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/AssignByMask.fs similarity index 98% rename from tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/AssignByMask.fs index c4193eb3..50dab7c2 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/AssignByMask.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/AssignByMask.fs @@ -96,7 +96,7 @@ let createTest case (isZero: 'a -> bool) isComplemented fill = let context = case.TestContext.ClContext let getCorrectnessTestName = getCorrectnessTestName case - let fill = fill context Mask.assign wgSize + let fill = fill Mask.assign context wgSize let toCoo = Vector.toDense context wgSize diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Convert.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Convert.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Vector/Convert.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/Convert.fs diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Copy.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Copy.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Vector/Copy.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/Copy.fs diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs similarity index 92% rename from tests/GraphBLAS-sharp.Tests/Vector/Map2.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs index 0ff08e3f..e5eadaa4 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs @@ -90,7 +90,7 @@ let correctnessGenericTest let createTest case isEqual (zero: 'a) plus plusQ map2 = let context = case.TestContext.ClContext - let map2 = map2 context plusQ wgSize + let map2 = map2 plusQ context wgSize let intToDense = Vector.toDense context wgSize @@ -107,11 +107,10 @@ let addTestFixtures case = createTest case Utils.floatIsEqual 0.0 (+) ArithmeticOperations.floatSumOption Vector.map2 createTest case Utils.float32IsEqual 0.0f (+) ArithmeticOperations.float32SumOption Vector.map2 - createTest case (=) false (||) ArithmeticOperations.boolSum Vector.map2 + createTest case (=) false (||) ArithmeticOperations.boolSumOption Vector.map2 createTest case (=) 0uy (+) ArithmeticOperations.byteSumOption Vector.map2 ] -let addTests = - operationGPUTests "Backend.Vector.Map2 add tests" addTestFixtures +let addTests = operationGPUTests "add" addTestFixtures let mulTestFixtures case = let context = case.TestContext.ClContext @@ -125,8 +124,7 @@ let mulTestFixtures case = createTest case (=) false (&&) ArithmeticOperations.boolMulOption Vector.map2 createTest case (=) 0uy (*) ArithmeticOperations.byteMulOption Vector.map2 ] -let mulTests = - operationGPUTests "Backend.Vector.map2 mul tests" addTestFixtures +let mulTests = operationGPUTests "mul" addTestFixtures let addAtLeastOneTestFixtures case = let context = case.TestContext.ClContext @@ -141,7 +139,7 @@ let addAtLeastOneTestFixtures case = createTest case (=) 0uy (+) ArithmeticOperations.byteSumAtLeastOne Vector.map2AtLeastOne ] let addAtLeastOneTests = - operationGPUTests "Backend.Vector.Map2LeastOne add tests" addTestFixtures + operationGPUTests "addAtLeastOne" addTestFixtures let mulAtLeastOneTestFixtures case = let context = case.TestContext.ClContext @@ -156,7 +154,7 @@ let mulAtLeastOneTestFixtures case = createTest case (=) 0uy (*) ArithmeticOperations.byteMulAtLeastOne Vector.map2AtLeastOne ] let mulAtLeastOneTests = - operationGPUTests "Backend.Vector.Map2AtLeasOne mul tests" mulTestFixtures + operationGPUTests "mulAtLeastOne" mulTestFixtures let fillSubVectorComplementedQ<'a, 'b> value = <@ fun (left: 'a option) (right: 'b option) -> @@ -199,4 +197,13 @@ let complementedGeneralTestFixtures case = let complementedGeneralTests = - operationGPUTests "Backend.Vector.Map2Gen mask tests" complementedGeneralTestFixtures + operationGPUTests "mask" complementedGeneralTestFixtures + +let allTests = + testList + "Map" + [ addTests + mulTests + addAtLeastOneTests + mulAtLeastOneTests + complementedGeneralTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Merge.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Merge.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Vector/Merge.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/Merge.fs diff --git a/tests/GraphBLAS-sharp.Tests/Vector/OfList.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/OfList.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Vector/OfList.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/OfList.fs diff --git a/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Reduce.fs similarity index 79% rename from tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/Reduce.fs index cfbca46b..42f29688 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Reduce.fs @@ -7,7 +7,7 @@ open GraphBLAS.FSharp.Tests open Brahma.FSharp open FSharp.Quotations open TestCases -open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClCell open GraphBLAS.FSharp.Backend.Vector let logger = Log.create "Vector.reduce.Tests" @@ -22,15 +22,7 @@ let checkResult zero op (actual: 'a) (vector: 'a []) = "Results should be the same" |> Expect.equal actual expected -let correctnessGenericTest - isEqual - zero - op - opQ - (reduce: Expr<'a -> 'a -> 'a> -> MailboxProcessor<_> -> ClVector<'a> -> ClCell<'a>) - case - (array: 'a []) - = +let correctnessGenericTest isEqual zero op reduce case (array: 'a []) = let vector = Utils.createVectorFromArray case.Format array (isEqual zero) @@ -41,27 +33,18 @@ let correctnessGenericTest let clVector = vector.ToDevice context - let resultCell = reduce opQ q clVector - - let result = Array.zeroCreate 1 - let result = - let res = - q.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(resultCell, result, ch)) - - q.Post(Msg.CreateFreeMsg<_>(resultCell)) - - res.[0] + (reduce q clVector: ClCell<_>).ToHostAndFree q checkResult zero op result array let createTest<'a when 'a: equality and 'a: struct> case isEqual (zero: 'a) plus plusQ name = let context = case.TestContext.ClContext - let reduce = Vector.reduce context wgSize + let reduce = Vector.reduce plusQ context wgSize case - |> correctnessGenericTest isEqual zero plus plusQ reduce + |> correctnessGenericTest isEqual zero plus reduce |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}, %s{name} %A{case.Format}" diff --git a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMV.fs similarity index 97% rename from tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMV.fs index db42fd9d..e19ade53 100644 --- a/tests/GraphBLAS-sharp.Tests/Vector/SpMV.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMV.fs @@ -92,7 +92,7 @@ let createTest testContext (zero: 'a) isEqual add mul addQ mulQ = let getCorrectnessTestName datatype = $"Correctness on %s{datatype}, %A{testContext.ClContext}" - let spMV = SpMV.run context addQ mulQ wgSize + let spMV = SpMV.run addQ mulQ context wgSize testContext |> correctnessGenericTest zero add mul spMV isEqual q @@ -104,7 +104,7 @@ let testFixturesSpMV (testContext: TestContext) = let q = testContext.Queue q.Error.Add(fun e -> failwithf "%A" e) - createTest testContext false (=) (||) (&&) ArithmeticOperations.boolSum ArithmeticOperations.boolMulOption + createTest testContext false (=) (||) (&&) ArithmeticOperations.boolSumOption ArithmeticOperations.boolMulOption createTest testContext 0 (=) (+) (*) ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption if Utils.isFloat64Available context.ClDevice then diff --git a/tests/GraphBLAS-sharp.Tests/Vector/ZeroCreate.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/ZeroCreate.fs similarity index 100% rename from tests/GraphBLAS-sharp.Tests/Vector/ZeroCreate.fs rename to tests/GraphBLAS-sharp.Tests/Backend/Vector/ZeroCreate.fs diff --git a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs b/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs deleted file mode 100644 index 049568c5..00000000 --- a/tests/GraphBLAS-sharp.Tests/Common/Sort/Radix.fs +++ /dev/null @@ -1,81 +0,0 @@ -namespace GraphBLAS.FSharp.Tests.Backend.Common.Sort - -open Expecto -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 = - { Utils.defaultConfig with - startSize = 1000000 } - - let workGroupSize = Utils.defaultWorkGroupSize - - let processor = Context.defaultContext.Queue - - let context = Context.defaultContext.ClContext - - let checkResultByKeys (inputArray: (int * 'a) []) (actualValues: 'a []) = - 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) []) = - - if array.Length > 0 then - let keys = Array.map fst array - let values = Array.map snd array - - let clKeys = keys.ToDevice context - let clValues = values.ToDevice context - - let clActualValues: ClArray<'a> = - sortFun processor HostInterop clKeys clValues - - let actualValues = clActualValues.ToHostAndFree processor - - checkResultByKeys array actualValues - - let createTestByKeys<'a when 'a: equality and 'a: struct> = - let sort = - Radix.runByKeysStandard context workGroupSize - - makeTestByKeys<'a> sort - |> testPropertyWithConfig config $"test on {typeof<'a>}" - - let testByKeys = - [ createTestByKeys - createTestByKeys - - if Utils.isFloat64Available context.ClDevice then - createTestByKeys - - createTestByKeys - createTestByKeys ] - |> testList "Radix sort by keys" - - let makeTestKeysOnly sort (keys: uint []) = - if keys.Length > 0 then - let keys = Array.map int keys - - let clKeys = keys.ToDevice context - - let actual = - (sort processor clKeys: ClArray) - .ToHostAndFree processor - - let expected = Array.sort keys - - "Keys must be the same" - |> Expect.sequenceEqual expected actual - - let testKeysOnly = - let sort = - Radix.standardRunKeysOnly context workGroupSize - - makeTestKeysOnly sort - |> testPropertyWithConfig config $"keys only" diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 5144f0c7..089602f4 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -6,31 +6,6 @@ open Expecto.Logging open Expecto.Logging.Message open FSharp.Quotations.Evaluator -[] -module Extensions = - type ClosedBinaryOp<'a> with - member this.Invoke = - let (ClosedBinaryOp f) = this - QuotationEvaluator.Evaluate f - -module CustomDatatypes = - // мб заменить рекорд на структуру (не помогает) - [] - type WrappedInt = - { InnerValue: int } - static member (+)(x: WrappedInt, y: WrappedInt) = - { InnerValue = x.InnerValue + y.InnerValue } - - static member (*)(x: WrappedInt, y: WrappedInt) = - { InnerValue = x.InnerValue * y.InnerValue } - - let addMultSemiringOnWrappedInt: Semiring = - { PlusMonoid = - { AssociativeOp = ClosedBinaryOp <@ (+) @> - Identity = { InnerValue = 0 } } - - TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } } - module Generators = let logger = Log.create "Generators" @@ -311,14 +286,65 @@ module Generators = |> genericSparseGenerator false Arb.generate |> Arb.fromGen - static member WrappedInt() = - pairOfMatrixAndVectorOfCompatibleSizeGenerator + type PairOfSparseVectorAndMatrixAndMaskOfCompatibleSize() = + static let pairOfVectorAndMatrixOfCompatibleSizeGenerator (valuesGenerator: Gen<'a>) = + gen { + let! nRows, nColumns = dimension2DGenerator + let! vector = valuesGenerator |> Gen.arrayOfLength nRows + + let! matrix = + valuesGenerator + |> Gen.array2DOfDim (nRows, nColumns) + + let! mask = Arb.generate |> Gen.arrayOfLength nColumns + return (vector, matrix, mask) + } + + static member IntType() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator + |> genericSparseGenerator 0 Arb.generate + |> Arb.fromGen + + static member FloatType() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator |> genericSparseGenerator - CustomDatatypes.addMultSemiringOnWrappedInt.PlusMonoid.Identity - Arb.generate + 0. + (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator + |> genericSparseGenerator 0.0f (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator + |> genericSparseGenerator 0y Arb.generate + |> Arb.fromGen + + static member ByteType() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator + |> genericSparseGenerator 0uy Arb.generate + |> Arb.fromGen + + static member Int16Type() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator + |> genericSparseGenerator 0s Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator + |> genericSparseGenerator 0us Arb.generate + |> Arb.fromGen + + static member BoolType() = + pairOfVectorAndMatrixOfCompatibleSizeGenerator + |> genericSparseGenerator false Arb.generate |> Arb.fromGen - type PairOfSparseVectorAndMatrixOfCompatibleSize() = + type VectorXMatrix() = static let pairOfVectorAndMatrixOfCompatibleSizeGenerator (valuesGenerator: Gen<'a>) = gen { let! nRows, nColumns = dimension2DGenerator @@ -328,8 +354,7 @@ module Generators = valuesGenerator |> Gen.array2DOfDim (nRows, nColumns) - let! mask = Arb.generate |> Gen.arrayOfLength nColumns - return (vector, matrix, mask) + return (vector, matrix) } static member IntType() = @@ -511,6 +536,81 @@ module Generators = |> Arb.fromGen type ArrayOfDistinctKeys() = + static let arrayOfDistinctKeysGenerator (keysGenerator: Gen<'n>) (valuesGenerator: Gen<'a>) = + let tuplesGenerator = + Gen.zip <| keysGenerator <| valuesGenerator + + gen { + let! length = Gen.sized <| fun size -> Gen.choose (1, size) + + let! array = Gen.arrayOfLength <| length <| tuplesGenerator + + return Array.distinctBy fst array + } + + static member IntType() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + static member FloatType() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + static member ByteType() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + static member Int16Type() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + static member Int32Type() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + static member UInt32Type() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + static member BoolType() = + arrayOfDistinctKeysGenerator + <| Arb.generate + <| Arb.generate + |> Arb.fromGen + + type ArrayOfDistinctKeys2D() = static let arrayOfDistinctKeysGenerator (keysGenerator: Gen<'n>) (valuesGenerator: Gen<'a>) = let tuplesGenerator = Gen.zip3 @@ -822,3 +922,240 @@ module Generators = static member BoolType() = pairOfVectorsOfEqualSize <| Arb.generate |> Arb.fromGen + + type Sub() = + static let arrayAndChunkPosition (valuesGenerator: Gen<'a>) = + gen { + let! length = Gen.sized <| fun size -> Gen.choose (2, size + 2) + + let! array = Gen.arrayOfLength length valuesGenerator + + let! startPosition = Gen.choose (0, length - 2) + let! count = Gen.choose (1, length - startPosition - 1) + + return (array, startPosition, count) + } + + static member IntType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member FloatType() = + arrayAndChunkPosition + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + arrayAndChunkPosition + <| (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member ByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member BoolType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + type ChunkBySize() = + static let arrayAndChunkPosition (valuesGenerator: Gen<'a>) = + gen { + let! length = Gen.sized <| fun size -> Gen.choose (2, size + 2) + + let! array = Gen.arrayOfLength length valuesGenerator + + let! chunkSize = Gen.choose (1, length) + + return (array, chunkSize) + } + + static member IntType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member FloatType() = + arrayAndChunkPosition + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + arrayAndChunkPosition + <| (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member ByteType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member Int32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member UInt32Type() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + static member BoolType() = + arrayAndChunkPosition <| Arb.generate + |> Arb.fromGen + + type Blit() = + static let pairOfVectorsOfEqualSize (valuesGenerator: Gen<'a>) = + gen { + let! targetArrayLength = Gen.sized <| fun size -> Gen.choose (0, size) + + let! targetArray = Gen.arrayOfLength targetArrayLength valuesGenerator + + let! sourceArrayLength = Gen.sized <| fun size -> Gen.choose (0, size) + + let! sourceArray = Gen.arrayOfLength sourceArrayLength valuesGenerator + + let! targetIndex = Gen.choose (0, targetArrayLength) + + let! sourceIndex = Gen.choose (0, sourceArrayLength) + + let! count = Gen.choose (0, (min (targetArrayLength - targetIndex) (sourceArrayLength - sourceIndex))) + + return (sourceArray, sourceIndex, targetArray, targetIndex, count) + } + + static member IntType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member FloatType() = + pairOfVectorsOfEqualSize + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + pairOfVectorsOfEqualSize + <| (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member ByteType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member Int16Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member Int32Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member UInt32Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member BoolType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + type Fill() = + static let pairOfVectorsOfEqualSize (valuesGenerator: Gen<'a>) = + gen { + let! value = valuesGenerator + + let! targetArrayLength = Gen.sized <| fun size -> Gen.choose (1, size + 1) + + let! targetArray = Gen.arrayOfLength targetArrayLength valuesGenerator + + let! targetPosition = Gen.choose (0, targetArrayLength) + + let! targetCount = Gen.choose (0, targetArrayLength - targetPosition) + + return (value, targetPosition, targetCount, targetArray) + } + + static member IntType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member FloatType() = + pairOfVectorsOfEqualSize + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + pairOfVectorsOfEqualSize + <| (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member ByteType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member Int16Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member Int32Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member UInt32Type() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen + + static member BoolType() = + pairOfVectorsOfEqualSize <| Arb.generate + |> Arb.fromGen diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 0d280f99..b94a57be 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -13,43 +13,54 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 08c2fc27..f2403ddc 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -25,8 +25,8 @@ module Utils = typeof typeof typeof - typeof - typeof + typeof + typeof typeof typeof typeof @@ -63,6 +63,9 @@ module Utils = | CSC -> Matrix.CSC <| Matrix.CSC.FromArray2D(array, isZero) + | LIL -> + Matrix.LIL + <| Matrix.LIL.FromArray2D(array, isZero) let createVectorFromArray vectorCase array isZero = match vectorCase with @@ -99,6 +102,13 @@ module Utils = Actual value is %A{actual.[i]}, expected %A{expected.[i]}, \n actual: %A{actual} \n expected: %A{expected}" |> failtestf "%s" + let compareChunksArrays areEqual (actual: 'a [] []) (expected: 'a [] []) message = + $"%s{message}. Lengths should be equal. Actual is %A{actual}, expected %A{expected}" + |> Expect.equal actual.Length expected.Length + + for i in 0 .. actual.Length - 1 do + compareArrays areEqual actual.[i] expected.[i] message + let compare2DArrays areEqual (actual: 'a [,]) (expected: 'a [,]) message = $"%s{message}. Lengths should be equal. Actual is %A{actual}, expected %A{expected}" |> Expect.equal actual.Length expected.Length @@ -110,6 +120,48 @@ module Utils = Actual value is %A{actual.[i, j]}, expected %A{expected.[i, j]}" |> failtestf "%s" + let compareSparseVectors isEqual (actual: Vector.Sparse<'a>) (expected: Vector.Sparse<'a>) = + "Sparse vector size must be the same" + |> Expect.equal actual.Size expected.Size + + "Value must be the same" + |> compareArrays isEqual actual.Values expected.Values + + "Indices must be the same" + |> compareArrays (=) actual.Indices expected.Indices + + let compareLILMatrix isEqual (actual: Matrix.LIL<'a>) (expected: Matrix.LIL<'a>) = + "Column count must be the same" + |> Expect.equal actual.ColumnCount expected.ColumnCount + + "Rows count must be the same" + |> Expect.equal actual.RowCount expected.RowCount + + List.iter2 + (fun actualRow expected -> + match actualRow, expected with + | Some actualVector, Some expectedVector -> compareSparseVectors isEqual actualVector expectedVector + | None, None -> () + | _ -> failwith "Rows are not matching") + <| actual.Rows + <| expected.Rows + + let compareCSRMatrix isEqual (actual: Matrix.CSR<'a>) (expected: Matrix.CSR<'a>) = + "Column count must be the same" + |> Expect.equal actual.ColumnCount expected.ColumnCount + + "Rows count must be the same" + |> Expect.equal actual.RowCount expected.RowCount + + "Values must be the same" + |> compareArrays isEqual actual.Values expected.Values + + "Column indices must be the same" + |> compareArrays (=) actual.ColumnIndices expected.ColumnIndices + + "Row pointers" + |> compareArrays (=) actual.RowPointers expected.RowPointers + let listOfUnionCases<'a> = FSharpType.GetUnionCases typeof<'a> |> Array.map (fun caseInfo -> FSharpValue.MakeUnion(caseInfo, [||]) :?> 'a) @@ -140,11 +192,6 @@ module Utils = result - let castMatrixToCSR = - function - | Matrix.CSR matrix -> matrix - | _ -> failwith "matrix format must be CSR" - module HostPrimitives = let prefixSumInclude zero add array = Array.scan add zero array diff --git a/tests/GraphBLAS-sharp.Tests/Host/IO/Dataset/testMatrix.mtx b/tests/GraphBLAS-sharp.Tests/Host/IO/Dataset/testMatrix.mtx new file mode 100644 index 00000000..2af703b9 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Host/IO/Dataset/testMatrix.mtx @@ -0,0 +1,5 @@ +%%MatrixMarket matrix coordinate integer general +2 3 3 +1 2 3 +2 2 2 +2 3 1 diff --git a/tests/GraphBLAS-sharp.Tests/Host/IO/MtxReader.fs b/tests/GraphBLAS-sharp.Tests/Host/IO/MtxReader.fs new file mode 100644 index 00000000..54b91ed6 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Host/IO/MtxReader.fs @@ -0,0 +1,45 @@ +module GraphBLAS.FSharp.Tests.Host.IO.MtxReader + +open System.IO +open Expecto +open GraphBLAS.FSharp.IO + +let matrixName = "testMatrix.mtx" + +let path = + Path.Combine [| __SOURCE_DIRECTORY__ + "Dataset" + matrixName |] + +let test = + test "mtxReader test" { + let matrixReader = MtxReader(path) + + let shape = matrixReader.ReadMatrixShape() + + "Rows count must be the same" + |> Expect.equal shape.RowCount 2 + + "Columns count must be the same" + |> Expect.equal shape.ColumnCount 3 + + "NNZ count must be the same" + |> Expect.equal shape.NNZ 3 + + let matrix = matrixReader.ReadMatrix(int) + + "Matrix row count must be the same" + |> Expect.equal matrix.RowCount 2 + + "Matrix column count must be the same" + |> Expect.equal matrix.ColumnCount 3 + + "Matrix values must be the same" + |> Expect.sequenceEqual matrix.Values [| 3; 2; 1 |] + + "Matrix columns must be the same" + |> Expect.sequenceEqual matrix.Columns [| 1; 1; 2 |] + + "Matrix rows must be the same" + |> Expect.sequenceEqual matrix.Rows [| 0; 1; 1 |] + } diff --git a/tests/GraphBLAS-sharp.Tests/Host/Matrix/Convert.fs b/tests/GraphBLAS-sharp.Tests/Host/Matrix/Convert.fs new file mode 100644 index 00000000..358286a2 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Host/Matrix/Convert.fs @@ -0,0 +1,25 @@ +module GraphBLAS.FSharp.Tests.Host.Matrix.Convert + +open Expecto +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Tests + +let makeTest isEqual zero (array: 'a [,]) = + let cooMatrix = + Matrix.COO.FromArray2D(array, isEqual zero) + + let actual = cooMatrix.ToCSR + + let expected = + Matrix.CSR.FromArray2D(array, isEqual zero) + + Utils.compareCSRMatrix isEqual actual expected + +let createTest<'a when 'a: struct> isEqual (zero: 'a) = + makeTest isEqual zero + |> testPropertyWithConfig Utils.defaultConfig $"%A{typeof<'a>}" + +let tests = + [ createTest (=) 0 + createTest (=) false ] + |> testList "Convert" diff --git a/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs b/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs new file mode 100644 index 00000000..7d2a3bdd --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Host/Matrix/FromaArray2D.fs @@ -0,0 +1,169 @@ +module GraphBLAS.FSharp.Tests.Host.Matrix.FromArray2D + +open Expecto +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Tests + +let config = Utils.defaultConfig + +let checkPointers isEqual zero array slice counter pointers (matrixValues: 'a []) (matrixIndices: int []) = + for i in 0 .. counter - 1 do + let expectedIndices, expectedValues = + slice array i + |> Array.mapi (fun index value -> (index, value)) + |> Array.filter (fun (_, value) -> ((<<) not <| isEqual zero) value) + |> Array.unzip + + let startRowPosition = Array.item i pointers + let endRowPosition = pointers.[i + 1] - 1 + + let actualValues = + matrixValues.[startRowPosition..endRowPosition] + + let actualIndices = + matrixIndices.[startRowPosition..endRowPosition] + + "Values must be the same" + |> Utils.compareArrays isEqual actualValues expectedValues + + "Indices must be the same" + |> Utils.compareArrays (=) actualIndices expectedIndices + +let makeTest isEqual zero createMatrix (array: 'a [,]) = + let matrix: Matrix<_> = createMatrix (isEqual zero) array + + let arrayRowCount = Array2D.length1 array + let arrayColumnCount = Array2D.length2 array + + "Row count must be the same" + |> Expect.equal matrix.RowCount arrayRowCount + + "Column count must be the same" + |> Expect.equal matrix.ColumnCount arrayColumnCount + + let nonZeroValues = + array + |> Seq.cast<'a> + |> Seq.filter ((<<) not <| isEqual zero) + |> Seq.toArray + + let checkPointers = checkPointers isEqual zero array + + match matrix with + | Matrix.CSR matrix -> + "Values must be the same" + |> Utils.compareArrays isEqual matrix.Values nonZeroValues + + "Row count invariant" + |> Expect.isTrue (matrix.RowPointers.Length = matrix.RowCount + 1) + + checkPointers + (fun (array: 'a [,]) i -> array.[i, *]) + arrayRowCount + matrix.RowPointers + matrix.Values + matrix.ColumnIndices + | Matrix.COO matrix -> + "Values must be the same" + |> Utils.compareArrays isEqual matrix.Values nonZeroValues + + let expectedColumns, expectedRows, expectedValues = + array + |> Seq.cast<'a> + |> Seq.mapi + (fun index value -> + let columnIndex = index % arrayColumnCount + let rowIndex = index / arrayColumnCount + + (columnIndex, rowIndex, value)) + |> Seq.filter (fun (_, _, value) -> ((<<) not <| isEqual zero) value) + |> Seq.toArray + |> Array.unzip3 + + "Values must be the same" + |> Utils.compareArrays isEqual matrix.Values expectedValues + + "Column indices must be the same" + |> Utils.compareArrays (=) matrix.Columns expectedColumns + + "Rows indices must be the same" + |> Utils.compareArrays (=) matrix.Rows expectedRows + | Matrix.CSC matrix -> + let expectedValues = + seq { + for i in 0 .. arrayColumnCount - 1 do + yield! array.[*, i] + } + |> Seq.filter ((<<) not <| isEqual zero) + |> Seq.toArray + + "Values must be the same" + |> Utils.compareArrays isEqual matrix.Values expectedValues + + "Row count invariant" + |> Expect.isTrue (matrix.ColumnPointers.Length = matrix.ColumnCount + 1) + + checkPointers + (fun array i -> array.[*, i]) + arrayColumnCount + matrix.ColumnPointers + matrix.Values + matrix.RowIndices + | Matrix.LIL matrix -> + "Rows count must be the same" + |> Expect.equal matrix.Rows.Length (Array2D.length1 array) + + matrix.Rows + |> Seq.iteri + (fun index -> + function + | Some actualRow -> + let expectedIndices, expectedValues = + array.[index, *] + |> Array.mapi (fun index value -> (index, value)) + |> Array.filter (fun (_, value) -> ((<<) not <| isEqual zero) value) + |> Array.unzip + + "Values must be the same" + |> Utils.compareArrays isEqual actualRow.Values expectedValues + + "Indices must be the same" + |> Utils.compareArrays (=) actualRow.Indices expectedIndices + | None -> + "No non zero items in row" + |> Expect.isFalse (Array.exists ((<<) not <| isEqual zero) array.[index, *])) + +let createTest name isEqual zero convert = + makeTest isEqual zero convert + |> testPropertyWithConfig config name + +let tests = + [ createTest + "CSR" + (=) + 0 + (fun isZero array -> + Matrix.CSR + <| Matrix.CSR.FromArray2D(array, isZero)) + createTest + "COO" + (=) + 0 + (fun isZero array -> + Matrix.COO + <| Matrix.COO.FromArray2D(array, isZero)) + createTest + "CSC" + (=) + 0 + (fun isZero array -> + Matrix.CSC + <| Matrix.CSC.FromArray2D(array, isZero)) + createTest + "LIL" + (=) + 0 + (fun isZero array -> + Matrix.LIL + <| Matrix.LIL.FromArray2D(array, isZero)) ] + |> testList "FromArray2D" diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs deleted file mode 100644 index 150ec153..00000000 --- a/tests/GraphBLAS-sharp.Tests/Matrix/Convert.fs +++ /dev/null @@ -1,109 +0,0 @@ -module GraphBLAS.FSharp.Tests.Backend.Matrix.Convert - -open Expecto -open Expecto.Logging -open Expecto.Logging.Message -open GraphBLAS.FSharp.Tests -open GraphBLAS.FSharp.Tests.Context -open GraphBLAS.FSharp.Backend -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Backend.Matrix -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Objects.MatrixExtensions -open GraphBLAS.FSharp.Backend.Objects.ClContext - -let logger = Log.create "Convert.Tests" - -let config = Utils.defaultConfig - -let workGroupSize = Utils.defaultWorkGroupSize - -let makeTest context q formatFrom formatTo convertFun isZero (array: 'a [,]) = - let mtx = - Utils.createMatrixFromArray2D formatFrom array isZero - - if mtx.NNZ > 0 then - let actual = - let mBefore = mtx.ToDevice context - let mAfter: ClMatrix<'a> = convertFun q HostInterop mBefore - let res = mAfter.ToHost q - mBefore.Dispose q - mAfter.Dispose q - res - - logger.debug ( - eventX "Actual is {actual}" - >> setField "actual" (sprintf "%A" actual) - ) - - let expected = - Utils.createMatrixFromArray2D formatTo array isZero - - "Matrices should be equal" - |> Expect.equal actual expected - -let testFixtures formatTo = - let getCorrectnessTestName datatype formatFrom = - $"Correctness on %s{datatype}, %A{formatFrom} to %A{formatTo}" - - let context = defaultContext.ClContext - let q = defaultContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) - - match formatTo with - | COO -> - [ let convertFun = Matrix.toCOO context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) 0) - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) - - let convertFun = Matrix.toCOO context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) false) - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat - | CSR -> - [ let convertFun = Matrix.toCSR context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) 0) - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) - - let convertFun = Matrix.toCSR context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) false) - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat - | CSC -> - [ let convertFun = Matrix.toCSC context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) 0) - |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) - - let convertFun = Matrix.toCSC context workGroupSize - - Utils.listOfUnionCases - |> List.map - (fun formatFrom -> - makeTest context q formatFrom formatTo convertFun ((=) false) - |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] - |> List.concat - -let tests = - Utils.listOfUnionCases - |> List.collect testFixtures - |> testList "Convert tests" 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 00ce048d..00000000 --- a/tests/GraphBLAS-sharp.Tests/Matrix/SpGeMM/Expand.fs +++ /dev/null @@ -1,266 +0,0 @@ -module GraphBLAS.FSharp.Tests.Matrix.SpGeMM.Expand - -open Expecto -open GraphBLAS.FSharp.Backend.Matrix.CSR.SpGeMM -open GraphBLAS.FSharp.Backend.Quotes -open GraphBLAS.FSharp.Test -open Microsoft.FSharp.Collections -open GraphBLAS.FSharp.Backend -open GraphBLAS.FSharp.Backend.Matrix -open GraphBLAS.FSharp.Backend.Objects -open GraphBLAS.FSharp.Tests -open GraphBLAS.FSharp.Tests.Backend -open GraphBLAS.FSharp.Objects -open GraphBLAS.FSharp.Backend.Objects.ArraysExtensions -open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Objects.ClContext -open GraphBLAS.FSharp.Objects.MatrixExtensions - -let context = Context.defaultContext.ClContext - -let processor = Context.defaultContext.Queue - -let config = - { Utils.defaultConfig with - arbitrary = [ typeof ] - endSize = 100 - maxTest = 100 } - -let createCSRMatrix array isZero = - Utils.createMatrixFromArray2D CSR array isZero - |> Utils.castMatrixToCSR - -let getSegmentsPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = - Array.map - (fun item -> - rightMatrix.RowPointers.[item + 1] - - rightMatrix.RowPointers.[item]) - leftMatrix.ColumnIndices - |> HostPrimitives.prefixSumExclude 0 (+) - -let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = - - let leftMatrix = createCSRMatrix leftArray isZero - - let rightMatrix = createCSRMatrix rightArray isZero - - if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then - - let clLeftMatrix = leftMatrix.ToDevice context - - let clRightMatrix = rightMatrix.ToDevice context - - let actualLength, (clActual: ClArray) = - testFun processor clLeftMatrix clRightMatrix - - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor - - let actualPointers = clActual.ToHostAndFree processor - - let expectedPointers, expectedLength = - getSegmentsPointers leftMatrix rightMatrix - - "Results lengths must be the same" - |> Expect.equal actualLength expectedLength - - "Result pointers must be the same" - |> Expect.sequenceEqual actualPointers expectedPointers - -let createTest<'a when 'a: struct> (isZero: 'a -> bool) = - - let testFun = - Expand.getSegmentPointers context Utils.defaultWorkGroupSize - - makeTest isZero testFun - |> testPropertyWithConfig config $"test on {typeof<'a>}" - -let getSegmentsTests = - [ createTest ((=) 0) - - if Utils.isFloat64Available context.ClDevice then - createTest ((=) 0.0) - - createTest ((=) 0f) - createTest ((=) false) - createTest ((=) 0uy) ] - |> testList "get segment pointers" - -let expand length segmentPointers (leftMatrix: Matrix.CSR<'a>) (rightMatrix: Matrix.CSR<'b>) = - let extendPointers pointers = - Array.pairwise pointers - |> Array.map (fun (fst, snd) -> snd - fst) - |> Array.mapi (fun index length -> Array.create length index) - |> Array.concat - - let segmentsLengths = - Array.append segmentPointers [| length |] - |> Array.pairwise - |> Array.map (fun (fst, snd) -> snd - fst) - - let leftMatrixValues, expectedRows = - let tripleFst (fst, _, _) = fst - - Array.zip3 segmentsLengths leftMatrix.Values - <| extendPointers leftMatrix.RowPointers - // select items each segment length not zero - |> Array.filter (tripleFst >> ((=) 0) >> not) - |> Array.collect (fun (length, value, rowIndex) -> Array.create length (value, rowIndex)) - |> Array.unzip - - let rightMatrixValues, expectedColumns = - let valuesAndColumns = - Array.zip rightMatrix.Values rightMatrix.ColumnIndices - - Array.map2 - (fun column length -> - let rowStart = rightMatrix.RowPointers.[column] - Array.take length valuesAndColumns.[rowStart..]) - leftMatrix.ColumnIndices - segmentsLengths - |> Array.concat - |> Array.unzip - - leftMatrixValues, rightMatrixValues, expectedColumns, expectedRows - -let makeExpandTest isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = - - let leftMatrix = - createCSRMatrix leftArray <| isEqual zero - - let rightMatrix = - createCSRMatrix rightArray <| isEqual zero - - if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then - - let segmentPointers, length = - getSegmentsPointers leftMatrix rightMatrix - - let clLeftMatrix = leftMatrix.ToDevice context - let clRightMatrix = rightMatrix.ToDevice context - let clSegmentPointers = context.CreateClArray segmentPointers - - let ((clActualLeftValues: ClArray<'a>), - (clActualRightValues: ClArray<'a>), - (clActualColumns: ClArray), - (clActualRows: ClArray)) = - testFun processor length clSegmentPointers clLeftMatrix clRightMatrix - - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor - clSegmentPointers.Free processor - - let actualLeftValues = - clActualLeftValues.ToHostAndFree processor - - let actualRightValues = - clActualRightValues.ToHostAndFree processor - - let actualColumns = clActualColumns.ToHostAndFree processor - let actualRows = clActualRows.ToHostAndFree processor - - let expectedLeftMatrixValues, expectedRightMatrixValues, expectedColumns, expectedRows = - expand length segmentPointers leftMatrix rightMatrix - - "Left values must be the same" - |> Utils.compareArrays isEqual actualLeftValues expectedLeftMatrixValues - - "Right values must be the same" - |> Utils.compareArrays isEqual actualRightValues expectedRightMatrixValues - - "Columns must be the same" - |> Utils.compareArrays (=) actualColumns expectedColumns - - "Rows must be the same" - |> Utils.compareArrays (=) actualRows expectedRows - -let createExpandTest isEqual (zero: 'a) testFun = - - let testFun = - testFun context Utils.defaultWorkGroupSize - - makeExpandTest isEqual zero testFun - |> testPropertyWithConfig config $"test on %A{typeof<'a>}" - -// expand phase tests -let expandTests = - [ createExpandTest (=) 0 Expand.expand - - if Utils.isFloat64Available context.ClDevice then - createExpandTest Utils.floatIsEqual 0.0 Expand.expand - - createExpandTest Utils.float32IsEqual 0f Expand.expand - createExpandTest (=) false Expand.expand - createExpandTest (=) 0uy Expand.expand ] - |> testList "Expand.expand" - -let checkGeneralResult zero isEqual (actualMatrix: Matrix<'a>) mul add (leftArray: 'a [,]) (rightArray: 'a [,]) = - - let expected = - HostPrimitives.array2DMultiplication zero mul add leftArray rightArray - |> fun array -> Utils.createMatrixFromArray2D COO array (isEqual zero) - - match actualMatrix, expected with - | Matrix.COO actualMatrix, Matrix.COO expected -> - - "Values must be the same" - |> Utils.compareArrays isEqual actualMatrix.Values expected.Values - - "Columns must be the same" - |> Utils.compareArrays (=) actualMatrix.Columns expected.Columns - - "Rows must be the same" - |> Utils.compareArrays (=) actualMatrix.Rows expected.Rows - | _ -> failwith "Matrix format are not matching" - -let makeGeneralTest zero isEqual opMul opAdd testFun (leftArray: 'a [,], rightArray: 'a [,]) = - - let leftMatrix = - Utils.createMatrixFromArray2D CSR leftArray (isEqual zero) - - let rightMatrix = - Utils.createMatrixFromArray2D CSR rightArray (isEqual zero) - - if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then - try - let clLeftMatrix = leftMatrix.ToDevice context - let clRightMatrix = rightMatrix.ToDevice context - - let (clMatrixActual: ClMatrix<_>) = - testFun processor HostInterop clLeftMatrix clRightMatrix - - let matrixActual = clMatrixActual.ToHost processor - clMatrixActual.Dispose processor - - checkGeneralResult zero isEqual matrixActual opMul opAdd leftArray rightArray - with - | ex when ex.Message = "InvalidBufferSize" -> () - | _ -> reraise () - -let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = - - let testFun = - testFun context Utils.defaultWorkGroupSize opAddQ opMulQ - - makeGeneralTest zero isEqual opMul opAdd testFun - |> testPropertyWithConfig config $"test on %A{typeof<'a>}" - -let generalTests = - [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Matrix.SpGeMM.expand - - if Utils.isFloat64Available context.ClDevice then - createGeneralTest - 0.0 - Utils.floatIsEqual - ArithmeticOperations.floatAdd - ArithmeticOperations.floatMul - Matrix.SpGeMM.expand - - createGeneralTest - 0.0f - Utils.float32IsEqual - ArithmeticOperations.float32Add - ArithmeticOperations.float32Mul - Matrix.SpGeMM.expand - createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Matrix.SpGeMM.expand ] - |> testList "general" diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 70fb4dcc..f3dada66 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -4,19 +4,17 @@ open GraphBLAS.FSharp.Tests let matrixTests = testList - "Matrix tests" + "Matrix" [ 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.Map2.allTests + Matrix.Map.allTests Matrix.Merge.allTests - Matrix.SpGeMM.Masked.tests - Matrix.SpGeMM.Expand.generalTests ] + Matrix.Transpose.tests + Matrix.RowsLengths.tests + Matrix.ByRows.tests + + Matrix.SpGeMM.Expand.generalTests + Matrix.SpGeMM.Masked.tests ] |> testSequenced let commonTests = @@ -43,17 +41,21 @@ let commonTests = Common.ClArray.Map.tests Common.ClArray.Map2.addTests Common.ClArray.Map2.mulTests - Common.ClArray.Choose.allTests ] + Common.ClArray.Choose.allTests + Common.ClArray.ChunkBySize.allTests + Common.ClArray.Blit.tests + Common.ClArray.Concat.tests + Common.ClArray.Fill.tests + Common.ClArray.Pairwise.tests ] let sortTests = testList "Sort" [ Common.Sort.Bitonic.tests - Common.Sort.Radix.testByKeys - Common.Sort.Radix.testKeysOnly ] + Common.Sort.Radix.allTests ] testList - "Common tests" + "Common" [ Common.Scatter.allTests Common.Gather.allTests Common.Merge.tests @@ -65,17 +67,13 @@ let commonTests = let vectorTests = testList - "Vector tests" + "Vector" [ 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.Map2.allTests Vector.AssignByMask.tests Vector.AssignByMask.complementedTests Vector.Reduce.tests @@ -86,15 +84,27 @@ let algorithmsTests = testList "Algorithms tests" [ Algorithms.BFS.tests ] |> testSequenced -[] -let allTests = +let deviceTests = testList - "All tests" + "Device" [ matrixTests - vectorTests commonTests + vectorTests algorithmsTests ] |> testSequenced +let hostTests = + testList + "Host" + [ Host.Matrix.FromArray2D.tests + Host.Matrix.Convert.tests + Host.IO.MtxReader.test ] + |> testSequenced + +[] +let allTests = + testList "All" [ deviceTests; hostTests ] + |> testSequenced + [] let main argv = allTests |> runTestsWithCLIArgs [] argv