diff --git a/.github/workflows/build-and-benchmark.yml b/.github/workflows/build-and-benchmark.yml index 2bde3398..d7225206 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.BFSWithoutTransferBenchmarkInt32-report-brief.json + output-file-path: BenchmarkDotNet.Artifacts/results/GraphBLAS.FSharp.Benchmarks.Algorithms.BFS.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/.github/workflows/build-docs.yml b/.github/workflows/build-docs.yml index 2e06ec69..2201457a 100644 --- a/.github/workflows/build-docs.yml +++ b/.github/workflows/build-docs.yml @@ -6,27 +6,6 @@ on: workflow_dispatch: jobs: - win-build: - name: Windows Build Docs - runs-on: windows-latest - defaults: - run: - shell: cmd - steps: - - name: System Info - run: systeminfo - - - uses: actions/checkout@v3 - - name: Setup .NET - uses: actions/setup-dotnet@v3 - with: - global-json-file: global.json - - - name: Build - run: ./build.cmd BuildDocs - env: - CI: true - linux-build: name: Linux Build Docs runs-on: ubuntu-latest diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs index 7a3c1cf6..9aa375d6 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/BFS.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Benchmarks.Algorithms.BFS +namespace GraphBLAS.FSharp.Benchmarks.Algorithms.BFS open System.IO open BenchmarkDotNet.Attributes @@ -12,8 +12,8 @@ open GraphBLAS.FSharp.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend.Quotes [] -[] -[] +[] +[] [)>] type Benchmarks<'elem when 'elem : struct>( buildFunToBenchmark, @@ -27,7 +27,7 @@ type Benchmarks<'elem when 'elem : struct>( let mutable matrix = Unchecked.defaultof> let mutable matrixHost = Unchecked.defaultof<_> - member val ResultLevels = Unchecked.defaultof> with get,set + member val ResultLevels = Unchecked.defaultof> with get,set [] member val OclContextInfo = Unchecked.defaultof with get, set @@ -40,7 +40,7 @@ type Benchmarks<'elem when 'elem : struct>( member this.Processor = let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) + //p.Error.Add(fun e -> failwithf "%A" e) p static member AvailableContexts = Utils.availableContexts @@ -69,9 +69,12 @@ type Benchmarks<'elem when 'elem : struct>( this.ResultLevels <- this.FunToBenchmark this.Processor matrix vertex member this.ClearInputMatrix() = - matrix.Dispose this.Processor + matrix.Dispose() - member this.ClearResult() = this.ResultLevels.FreeAndWait this.Processor + member this.ClearResult() = + match this.ResultLevels with + | ClVector.Dense result -> result.FreeAndWait this.Processor + | _ -> failwith "Impossible" member this.ReadMatrix() = let converter = @@ -110,10 +113,12 @@ type WithoutTransferBenchmark<'elem when 'elem : struct>( override this.GlobalSetup() = this.ReadMatrix() this.LoadMatrixToGPU() + this.Processor.Synchronize() [] override this.IterationCleanup() = this.ClearResult() + this.Processor.Synchronize() [] override this.GlobalCleanup() = @@ -122,12 +127,36 @@ type WithoutTransferBenchmark<'elem when 'elem : struct>( [] override this.Benchmark() = this.BFS() - this.Processor.PostAndReply Msg.MsgNotifyMe + this.Processor.Synchronize() -type BFSWithoutTransferBenchmarkInt32() = +type BFSWithoutTransferBenchmarkBool() = + + inherit WithoutTransferBenchmark( + (Algorithms.BFS.singleSource ArithmeticOperations.boolSumOption ArithmeticOperations.boolMulOption), + (fun _ -> true), + (fun _ -> true), + 0, + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context)) + + static member InputMatrixProvider = + Benchmarks<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" + +type BFSPushPullWithoutTransferBenchmarkBool() = + + inherit WithoutTransferBenchmark( + (Algorithms.BFS.singleSourcePushPull ArithmeticOperations.boolSumOption ArithmeticOperations.boolMulOption), + (fun _ -> true), + (fun _ -> true), + 0, + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context)) + + static member InputMatrixProvider = + Benchmarks<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" + +type SSSPWithoutTransferBenchmarkInt32() = inherit WithoutTransferBenchmark( - (Algorithms.BFS.singleSource ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), + Algorithms.SSSP.run, int32, (fun _ -> Utils.nextInt (System.Random())), 0, @@ -153,6 +182,7 @@ type WithTransferBenchmark<'elem when 'elem : struct>( [] override this.GlobalSetup() = this.ReadMatrix() + this.Processor.Synchronize() [] override this.GlobalCleanup() = @@ -162,23 +192,26 @@ type WithTransferBenchmark<'elem when 'elem : struct>( override this.IterationCleanup() = this.ClearInputMatrix() this.ClearResult() + this.Processor.Synchronize() [] override this.Benchmark() = this.LoadMatrixToGPU() this.BFS() - this.ResultLevels.ToHost this.Processor |> ignore - this.Processor.PostAndReply Msg.MsgNotifyMe - -type BFSWithTransferBenchmarkInt32() = - - inherit WithTransferBenchmark( - (Algorithms.BFS.singleSource ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption), - int32, - (fun _ -> Utils.nextInt (System.Random())), + match this.ResultLevels with + | ClVector.Dense result -> + result.ToHost this.Processor |> ignore + this.Processor.Synchronize() + | _ -> failwith "Impossible" + +type BFSWithTransferBenchmarkBool() = + + inherit WithTransferBenchmark( + (Algorithms.BFS.singleSource ArithmeticOperations.boolSumOption ArithmeticOperations.boolMulOption), + (fun _ -> true), + (fun _ -> true), 0, (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context)) static member InputMatrixProvider = Benchmarks<_>.InputMatrixProviderBuilder "BFSBenchmarks.txt" - diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/PageRank.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/PageRank.fs new file mode 100644 index 00000000..dfd98a89 --- /dev/null +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Algorithms/PageRank.fs @@ -0,0 +1,132 @@ +namespace GraphBLAS.FSharp.Benchmarks.Algorithms.PageRank + +open System.IO +open BenchmarkDotNet.Attributes +open GraphBLAS.FSharp +open GraphBLAS.FSharp.IO +open Brahma.FSharp +open Microsoft.FSharp.Core +open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Benchmarks +open GraphBLAS.FSharp.Objects + +[] +[] +[] +[)>] +type Benchmarks( + buildFunToBenchmark, + converter: string -> float32, + binaryConverter, + buildMatrix) + = + + let mutable funToBenchmark = None + let mutable matrix = Unchecked.defaultof> + let mutable matrixPrepared = Unchecked.defaultof + let mutable matrixHost = Unchecked.defaultof<_> + + member val Result = 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 = "" + 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.PageRank() = + this.Result <- this.FunToBenchmark this.Processor matrixPrepared Constants.PageRank.accuracy + + member this.ClearInputMatrix() = + matrix.Dispose() + + member this.ClearPreparedMatrix() = + matrixPrepared.Dispose() + + member this.ClearResult() = this.Result.Dispose() + + member this.ReadMatrix() = + let converter = + match this.InputMatrixReader.Field with + | Pattern -> binaryConverter + | _ -> converter + + matrixHost <- this.InputMatrixReader.ReadMatrix converter + + member this.LoadMatrixToGPU() = + matrix <- buildMatrix this.OclContext matrixHost + + member this.PrepareMatrix() = + matrixPrepared <- Algorithms.PageRank.prepareMatrix this.OclContext this.WorkGroupSize this.Processor matrix + + abstract member GlobalSetup : unit -> unit + + abstract member IterationCleanup : unit -> unit + + abstract member GlobalCleanup : unit -> unit + + abstract member Benchmark : unit -> unit + +type PageRankWithoutTransferBenchmarkFloat32() = + + inherit Benchmarks( + Algorithms.PageRank.run, + float32, + (fun _ -> float32 <| Utils.nextInt (System.Random())), + (fun context matrix -> ClMatrix.CSR <| matrix.ToCSR.ToDevice context)) + + static member InputMatrixProvider = + Benchmarks.InputMatrixProviderBuilder "BFSBenchmarks.txt" + + [] + override this.GlobalSetup() = + this.ReadMatrix() + this.LoadMatrixToGPU() + this.Processor.Synchronize() + this.PrepareMatrix() + this.ClearInputMatrix() + this.Processor.Synchronize() + + [] + override this.IterationCleanup() = + this.ClearResult() + this.Processor.Synchronize() + + [] + override this.GlobalCleanup() = + this.ClearPreparedMatrix() + + [] + override this.Benchmark() = + this.PageRank() + this.Processor.Synchronize() diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/BFSBenchmarks.txt b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/BFSBenchmarks.txt index ff803830..b282136e 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/BFSBenchmarks.txt +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/BFSBenchmarks.txt @@ -1,4 +1,7 @@ wing.mtx coAuthorsCiteseer.mtx -hollywood-2009.mtx -roadNet-CA.mtx \ No newline at end of file +!hollywood-2009.mtx +roadNet-CA.mtx +belgium_osm.mtx +road_central.mtx +coPapersDBLP.mtx \ No newline at end of file diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/Context.txt b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/Context.txt index 04f1c08e..dc8e8842 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/Context.txt +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/Context.txt @@ -1,3 +1,3 @@ -NVIDIA* +AMD* Gpu -32 +64 diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/WorkflowTargets.txt b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/WorkflowTargets.txt index d71735c7..708032bc 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/WorkflowTargets.txt +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Configs/WorkflowTargets.txt @@ -1 +1 @@ -BFSWithoutTransferBenchmark +BFSWithoutTransfer diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj index 6e8486b0..0ccc2f46 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/GraphBLAS-sharp.Benchmarks.fsproj @@ -25,6 +25,7 @@ + diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs index 0867e214..f23a8c08 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Helpers.fs @@ -15,7 +15,7 @@ open Expecto module Utils = type BenchmarkContext = { ClContext: Brahma.FSharp.ClContext - Queue: MailboxProcessor } + Queue: RawCommandQueue } let getMatricesFilenames configFilename = let getFullPathToConfig filename = @@ -103,9 +103,11 @@ module Utils = let context = Brahma.FSharp.ClContext(device, translator) - let queue = context.QueueProvider.CreateQueue() + let queue = + RawCommandQueue(context.ClDevice.Device, context.Context, context.Translator) { ClContext = context; Queue = queue }) + seq { for wgSize in workGroupSizes do for context in contexts do @@ -119,13 +121,14 @@ module Utils = let normalFloatGenerator = (Arb.Default.NormalFloat() - |> Arb.toGen - |> Gen.map float) + |> Arb.toGen + |> Gen.map float) - let fIsEqual x y = abs (x - y) < Accuracy.medium.absolute || x.Equals y + let fIsEqual x y = + abs (x - y) < Accuracy.medium.absolute + || x.Equals y - let nextInt (random: System.Random) = - random.Next() + let nextInt (random: System.Random) = random.Next() module VectorGenerator = let private pairOfVectorsOfEqualSize (valuesGenerator: Gen<'a>) createVector = @@ -144,8 +147,10 @@ module VectorGenerator = |> pairOfVectorsOfEqualSize Arb.generate let floatPair format = - let fIsEqual x y = abs (x - y) < Accuracy.medium.absolute || x = y + let fIsEqual x y = + abs (x - y) < Accuracy.medium.absolute || x = y - let createVector array = Utils.createVectorFromArray format array (fIsEqual 0.0) + let createVector array = + Utils.createVectorFromArray format array (fIsEqual 0.0) pairOfVectorsOfEqualSize Utils.normalFloatGenerator createVector diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs index 975e8a72..34446811 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/Map2/Map2.fs @@ -40,13 +40,13 @@ type Benchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : st member this.Processor = let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) + //p.Error.Add(fun e -> failwithf "%A" e) p static member AvailableContexts = Utils.availableContexts static member InputMatricesProviderBuilder pathToConfig = - let datasetFolder = "EWiseAdd" + let datasetFolder = "" pathToConfig |> Utils.getMatricesFilenames |> Seq.map @@ -79,11 +79,11 @@ type Benchmarks<'matrixT, 'elem when 'matrixT :> IDeviceMemObject and 'elem : st this.ResultMatrix <- this.FunToBenchmark this.Processor HostInterop firstMatrix secondMatrix member this.ClearInputMatrices() = - firstMatrix.Dispose this.Processor - secondMatrix.Dispose this.Processor + firstMatrix.Dispose() + secondMatrix.Dispose() member this.ClearResult() = - this.ResultMatrix.Dispose this.Processor + this.ResultMatrix.Dispose() member this.ReadMatrices() = firstMatrixHost <- this.ReadMatrix <| fst this.InputMatrixReader @@ -118,12 +118,12 @@ module WithoutTransfer = override this.GlobalSetup() = this.ReadMatrices () this.LoadMatricesToGPU () - this.Processor.PostAndReply(Msg.MsgNotifyMe) + this.Processor.Synchronize() [] override this.Benchmark () = this.EWiseAddition() - this.Processor.PostAndReply(Msg.MsgNotifyMe) + this.Processor.Synchronize() [] override this.IterationCleanup () = @@ -251,6 +251,7 @@ module WithTransfer = [] override this.GlobalSetup() = this.ReadMatrices() + this.Processor.Synchronize() [] override this.GlobalCleanup() = () @@ -259,15 +260,15 @@ module WithTransfer = override this.IterationCleanup() = this.ClearInputMatrices() this.ClearResult() + this.Processor.Synchronize() [] override this.Benchmark() = this.LoadMatricesToGPU() this.EWiseAddition() - this.Processor.PostAndReply Msg.MsgNotifyMe + this.Processor.Synchronize() resultToHost this.ResultMatrix this.Processor |> ignore - this.Processor.PostAndReply Msg.MsgNotifyMe - + this.Processor.Synchronize() module COO = type Float32() = diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs index 0eb398cd..db0125e3 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Expand.fs @@ -13,7 +13,7 @@ open GraphBLAS.FSharp.Benchmarks [] [] [] -[)>] +[)>] type Benchmarks<'elem when 'elem : struct>( buildFunToBenchmark, converter: string -> 'elem, @@ -22,11 +22,9 @@ type Benchmarks<'elem when 'elem : struct>( let mutable funToBenchmark = None - let mutable firstMatrix = Unchecked.defaultof> - let mutable secondMatrix = Unchecked.defaultof> + let mutable matrix = Unchecked.defaultof> - let mutable firstMatrixHost = Unchecked.defaultof<_> - let mutable secondMatrixHost = Unchecked.defaultof<_> + let mutable matrixHost = Unchecked.defaultof<_> member val ResultMatrix = Unchecked.defaultof option> with get, set @@ -36,12 +34,12 @@ type Benchmarks<'elem when 'elem : struct>( [] member val InputMatrixReader = Unchecked.defaultof with get, set - member this.OclContext:ClContext = (fst this.OclContextInfo).ClContext + 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.Error.Add(fun e -> failwithf "%A" e) p static member AvailableContexts = Utils.availableContexts @@ -76,24 +74,21 @@ type Benchmarks<'elem when 'elem : struct>( reader.ReadMatrix converter member this.Mxm() = - this.ResultMatrix <- this.FunToBenchmark this.Processor DeviceOnly firstMatrix secondMatrix + this.ResultMatrix <- this.FunToBenchmark this.Processor DeviceOnly matrix matrix member this.ClearInputMatrices() = - firstMatrix.Dispose this.Processor - secondMatrix.Dispose this.Processor + matrix.Dispose() member this.ClearResult() = match this.ResultMatrix with - | Some matrix -> matrix.Dispose this.Processor + | Some matrix -> matrix.Dispose() | None -> () member this.ReadMatrices() = - firstMatrixHost <- this.ReadMatrix this.InputMatrixReader - secondMatrixHost <- this.ReadMatrix this.InputMatrixReader + matrixHost <- this.ReadMatrix this.InputMatrixReader member this.LoadMatricesToGPU () = - firstMatrix <- buildMatrix this.OclContext firstMatrixHost - secondMatrix <- buildMatrix this.OclContext secondMatrixHost + matrix <- buildMatrix this.OclContext matrixHost abstract member GlobalSetup : unit -> unit @@ -120,15 +115,17 @@ module WithoutTransfer = override this.GlobalSetup() = this.ReadMatrices() this.LoadMatricesToGPU() + this.Processor.Synchronize() [] override this.Benchmark() = this.Mxm() - this.Processor.PostAndReply(Msg.MsgNotifyMe) + this.Processor.Synchronize() [] override this.IterationCleanup () = this.ClearResult() + this.Processor.Synchronize() [] override this.GlobalCleanup () = diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs index 69f0c399..3cfd844e 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Matrix/SpGeMM/Masked.fs @@ -45,13 +45,13 @@ type Masked<'elem when 'elem : struct>( member this.Processor = let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf "%A" e) + //p.Error.Add(fun e -> failwithf "%A" e) p static member AvaliableContexts = Utils.availableContexts static member InputMatrixProviderBuilder pathToConfig = - let datasetFolder = "Mxm" + let datasetFolder = "" pathToConfig |> Utils.getMatricesFilenames |> Seq.map @@ -100,12 +100,12 @@ type Masked<'elem when 'elem : struct>( this.ResultMatrix <- this.FunToBenchmark this.Processor firstMatrix secondMatrix mask member this.ClearInputMatrices() = - firstMatrix.Dispose this.Processor - secondMatrix.Dispose this.Processor - mask.Dispose this.Processor + firstMatrix.Dispose() + secondMatrix.Dispose() + mask.Dispose() member this.ClearResult() = - this.ResultMatrix.Dispose this.Processor + this.ResultMatrix.Dispose() member this.ReadMask(maskReader) = maskHost <- Matrix.COO <| this.ReadMatrix maskReader @@ -152,15 +152,17 @@ type MxmBenchmarksMultiplicationOnly<'elem when 'elem : struct>( this.ReadMatrices () this.LoadMatricesToGPU () this.ConvertSecondMatrixToCSC() + this.Processor.Synchronize() [] override this.Benchmark () = this.Mxm() - this.Processor.PostAndReply(Msg.MsgNotifyMe) + this.Processor.Synchronize() [] override this.IterationCleanup () = this.ClearResult() + this.Processor.Synchronize() [] override this.GlobalCleanup () = @@ -182,18 +184,20 @@ type MxmBenchmarksWithTransposing<'elem when 'elem : struct>( override this.GlobalSetup() = this.ReadMatrices() this.LoadMatricesToGPU () + this.Processor.Synchronize() [] override this.Benchmark() = this.ConvertSecondMatrixToCSC() this.Mxm() - this.Processor.PostAndReply(Msg.MsgNotifyMe) + this.Processor.Synchronize() [] override this.IterationCleanup() = this.ClearResult() this.ConvertSecondMatrixToCSR() + this.Processor.Synchronize() [] override this.GlobalCleanup() = diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Program.fs index 5a3ccf37..40bbb73a 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/Scripts/Benchmark.py b/benchmarks/GraphBLAS-sharp.Benchmarks/Scripts/Benchmark.py index d3bf7559..a67cdbe6 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Scripts/Benchmark.py +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Scripts/Benchmark.py @@ -7,8 +7,8 @@ from dataclasses import dataclass -ROOT = pathlib.Path(__file__).parent.parent.parent.parent -BENCHMARKS = pathlib.Path(__file__).parent.parent +ROOT = pathlib.Path(__file__).resolve().parent.parent.parent.parent +BENCHMARKS = pathlib.Path(__file__).resolve().parent.parent CONFIGS = BENCHMARKS / "Configs" BINARIES = BENCHMARKS / "bin" / "Release" / "net7.0" RESULTS = ROOT / "BenchmarkDotNet.Artifacts" / "results" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs index d4e0078c..92daae68 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Vector/Map2.fs @@ -27,7 +27,7 @@ type Benchmarks<'elem when 'elem : struct>( member val HostVectorPair = Unchecked.defaultof * Vector<'elem>> with get, set - member val ResultVector = Unchecked.defaultof> with get,set + member val ResultVector = Unchecked.defaultof option> with get,set [] member val OclContextInfo = Unchecked.defaultof with get, set @@ -40,7 +40,7 @@ type Benchmarks<'elem when 'elem : struct>( member this.Processor = let p = (fst this.OclContextInfo).Queue - p.Error.Add(fun e -> failwithf $"%A{e}") + //p.Error.Add(fun e -> failwithf $"%A{e}") p static member AvailableContexts = Utils.availableContexts @@ -63,11 +63,13 @@ type Benchmarks<'elem when 'elem : struct>( | ex -> raise ex member this.ClearInputVectors()= - firstVector.Dispose this.Processor - secondVector.Dispose this.Processor + firstVector.Dispose() + secondVector.Dispose() member this.ClearResult() = - this.ResultVector.Dispose this.Processor + match this.ResultVector with + | Some v -> v.Dispose() + | None -> () member this.CreateVectors() = this.HostVectorPair <- List.last (Gen.sample this.Size 1 generator) @@ -102,17 +104,18 @@ module WithoutTransfer = override this.IterationSetup() = this.CreateVectors() this.LoadVectorsToGPU() - this.Processor.PostAndReply Msg.MsgNotifyMe + this.Processor.Synchronize() [] override this.Benchmark() = this.Map2() - this.Processor.PostAndReply Msg.MsgNotifyMe + this.Processor.Synchronize() [] override this.IterationCleanup() = this.ClearResult() this.ClearInputVectors() + this.Processor.Synchronize() [] override this.GlobalCleanup() = () @@ -157,18 +160,24 @@ module WithTransfer = [] override this.IterationSetup() = this.CreateVectors() + this.Processor.Synchronize() [] override this.Benchmark () = this.LoadVectorsToGPU() this.Map2() - this.ResultVector.ToHost this.Processor |> ignore - this.Processor.PostAndReply Msg.MsgNotifyMe + match this.ResultVector with + | Some v -> + v.ToHost this.Processor |> ignore + this.Processor.Synchronize() + | None -> () + [] override this.IterationCleanup () = this.ClearInputVectors() this.ClearResult() + this.Processor.Synchronize() [] override this.GlobalCleanup() = () diff --git a/paket.dependencies b/paket.dependencies index a434e23e..41db4390 100644 --- a/paket.dependencies +++ b/paket.dependencies @@ -16,7 +16,7 @@ nuget System.CodeDom >= 7.0 nuget FSharp.Quotations.Evaluator 2.1.0 nuget FSharpx.Collections >= 3.1 nuget FSharpx.Text.StructuredFormat >= 3.1 -nuget Brahma.FSharp 2.0.5 +nuget Brahma.FSharp 3.0.0-alpha1.5 nuget BenchmarkDotNet nuget MathNet.Numerics.FSharp 4.0.0 nuget MathNet.Numerics.MKL.Win-x64 2.5.0 @@ -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 \ No newline at end of file + nuget BinaryDefense.FSharp.Analyzers.Hashing 0.2.2 diff --git a/paket.lock b/paket.lock index f2bbb161..9f567142 100644 --- a/paket.lock +++ b/paket.lock @@ -2,8 +2,8 @@ STORAGE: NONE NUGET remote: https://www.nuget.org/api/v2 altcover (7.6.812) - BenchmarkDotNet (0.13.6) - BenchmarkDotNet.Annotations (>= 0.13.6) - restriction: >= netstandard2.0 + BenchmarkDotNet (0.13.9) + BenchmarkDotNet.Annotations (>= 0.13.9) - restriction: >= netstandard2.0 CommandLineParser (>= 2.9.1) - restriction: >= netstandard2.0 Gee.External.Capstone (>= 2.3) - restriction: >= netstandard2.0 Iced (>= 1.17) - restriction: >= netstandard2.0 @@ -18,27 +18,27 @@ NUGET System.Reflection.Emit (>= 4.7) - restriction: && (< net6.0) (>= netstandard2.0) System.Reflection.Emit.Lightweight (>= 4.7) - restriction: && (< net6.0) (>= netstandard2.0) System.Threading.Tasks.Extensions (>= 4.5.4) - restriction: && (< net6.0) (>= netstandard2.0) - BenchmarkDotNet.Annotations (0.13.6) - restriction: >= netstandard2.0 - Brahma.FSharp (2.0.5) - Brahma.FSharp.OpenCL.Printer (>= 2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.Shared (>= 2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.Translator (>= 2.0.5) - restriction: >= net7.0 + BenchmarkDotNet.Annotations (0.13.9) - restriction: >= netstandard2.0 + Brahma.FSharp (3.0.0-alpha1.5) + Brahma.FSharp.OpenCL.Printer (>= 3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.Shared (>= 3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.Translator (>= 3.0.0-alpha1.5) - restriction: >= net7.0 FSharp.Core (7.0) - restriction: >= net7.0 FSharp.Quotations.Evaluator (>= 2.1) - restriction: >= net7.0 - YC.OpenCL.NET (>= 2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.AST (2.0.5) - restriction: >= net7.0 + YC.OpenCL.NET (>= 3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.AST (3.0.0-alpha1.5) - restriction: >= net7.0 FSharp.Core (7.0) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.Printer (2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.AST (>= 2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.Translator (>= 2.0.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.Printer (3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.AST (>= 3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.Translator (>= 3.0.0-alpha1.5) - restriction: >= net7.0 FSharp.Core (7.0) - restriction: >= net7.0 FSharpx.Collections (>= 3.1) - restriction: >= net7.0 FSharpx.Text.StructuredFormat (>= 3.1) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.Shared (2.0.5) - restriction: >= net7.0 - YC.OpenCL.NET (>= 2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.Translator (2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.AST (>= 2.0.5) - restriction: >= net7.0 - Brahma.FSharp.OpenCL.Shared (>= 2.0.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.Shared (3.0.0-alpha1.5) - restriction: >= net7.0 + YC.OpenCL.NET (>= 3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.Translator (3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.AST (>= 3.0.0-alpha1.5) - restriction: >= net7.0 + Brahma.FSharp.OpenCL.Shared (>= 3.0.0-alpha1.5) - restriction: >= net7.0 FSharp.Core (7.0) - restriction: >= net7.0 FSharp.Quotations.Evaluator (>= 2.1) - restriction: >= net7.0 FSharpx.Collections (>= 3.1) - restriction: >= net7.0 @@ -83,27 +83,27 @@ NUGET System.Security.Permissions (>= 4.7) - restriction: && (< net472) (>= netstandard2.0) Microsoft.Build.Tasks.Git (1.1.1) - copy_local: true Microsoft.CodeAnalysis.Analyzers (3.3.4) - restriction: >= netstandard2.0 - Microsoft.CodeAnalysis.Common (4.6) - restriction: >= netstandard2.0 + Microsoft.CodeAnalysis.Common (4.7) - restriction: >= netstandard2.0 Microsoft.CodeAnalysis.Analyzers (>= 3.3.4) - restriction: >= netstandard2.0 System.Collections.Immutable (>= 7.0) - restriction: >= netstandard2.0 System.Memory (>= 4.5.5) - restriction: && (< net6.0) (>= netstandard2.0) System.Reflection.Metadata (>= 7.0) - restriction: >= netstandard2.0 System.Runtime.CompilerServices.Unsafe (>= 6.0) - restriction: >= netstandard2.0 - System.Text.Encoding.CodePages (>= 7.0) - restriction: >= netstandard2.0 + System.Text.Encoding.CodePages (>= 7.0) - restriction: && (< net6.0) (>= netstandard2.0) System.Threading.Tasks.Extensions (>= 4.5.4) - restriction: && (< net6.0) (>= netstandard2.0) - Microsoft.CodeAnalysis.CSharp (4.6) - restriction: >= netstandard2.0 - Microsoft.CodeAnalysis.Common (4.6) - restriction: >= netstandard2.0 - Microsoft.CodeCoverage (17.6.3) - restriction: || (>= net45) (>= netcoreapp2.1) + Microsoft.CodeAnalysis.CSharp (4.7) - restriction: >= netstandard2.0 + Microsoft.CodeAnalysis.Common (4.7) - restriction: >= netstandard2.0 + Microsoft.CodeCoverage (17.7.2) - restriction: || (>= net45) (>= netcoreapp2.1) Microsoft.CSharp (4.7) - restriction: || (&& (< netstandard1.3) (>= uap10.0)) (&& (< netstandard2.0) (>= uap10.0)) - Microsoft.Diagnostics.NETCore.Client (0.2.430602) - restriction: >= netstandard2.0 + Microsoft.Diagnostics.NETCore.Client (0.2.447801) - restriction: >= netstandard2.0 Microsoft.Bcl.AsyncInterfaces (>= 6.0) - restriction: && (< net6.0) (>= netstandard2.0) Microsoft.Extensions.Logging (>= 6.0) - restriction: >= netstandard2.0 System.Buffers (>= 4.5.1) - restriction: && (< net6.0) (>= netstandard2.0) - Microsoft.Diagnostics.Runtime (2.4.416101) - restriction: >= netstandard2.0 - Microsoft.Diagnostics.NETCore.Client (>= 0.2.251802) - restriction: >= netstandard2.0 - System.Collections.Immutable (>= 5.0) - restriction: >= netstandard2.0 - System.Runtime.CompilerServices.Unsafe (>= 5.0) - restriction: >= netstandard2.0 - Microsoft.Diagnostics.Tracing.TraceEvent (3.1.3) - restriction: >= netstandard2.0 + Microsoft.Diagnostics.Runtime (3.0.442202) - restriction: >= netstandard2.0 + Microsoft.Diagnostics.NETCore.Client (>= 0.2.410101) - restriction: >= netstandard2.0 + System.Collections.Immutable (>= 6.0) - restriction: >= netstandard2.0 + System.Runtime.CompilerServices.Unsafe (>= 6.0) - restriction: >= netstandard2.0 + Microsoft.Diagnostics.Tracing.TraceEvent (3.1.5) - restriction: >= netstandard2.0 System.Runtime.CompilerServices.Unsafe (>= 5.0) - restriction: >= netstandard2.0 Microsoft.DotNet.PlatformAbstractions (3.1.6) - restriction: >= netstandard2.0 System.Runtime.InteropServices.RuntimeInformation (>= 4.0) - restriction: || (>= net45) (&& (>= netstandard1.3) (< netstandard2.0)) @@ -145,11 +145,11 @@ NUGET Microsoft.SourceLink.GitHub (1.0) - copy_local: true Microsoft.Build.Tasks.Git (>= 1.0) Microsoft.SourceLink.Common (>= 1.0) - Microsoft.TestPlatform.ObjectModel (17.6.3) - restriction: >= netcoreapp3.1 + Microsoft.TestPlatform.ObjectModel (17.7.2) - restriction: >= netcoreapp3.1 NuGet.Frameworks (>= 6.5) - restriction: || (>= net462) (>= netstandard2.0) System.Reflection.Metadata (>= 1.6) - restriction: || (>= net462) (>= netstandard2.0) - Microsoft.TestPlatform.TestHost (17.6.3) - restriction: >= netcoreapp2.1 - Microsoft.TestPlatform.ObjectModel (>= 17.6.3) - restriction: >= netcoreapp3.1 + Microsoft.TestPlatform.TestHost (17.7.2) - restriction: >= netcoreapp2.1 + Microsoft.TestPlatform.ObjectModel (>= 17.7.2) - restriction: >= netcoreapp3.1 Newtonsoft.Json (>= 13.0.1) - restriction: >= netcoreapp3.1 Microsoft.Win32.Primitives (4.3) - restriction: || (&& (< net45) (>= net46) (< netstandard1.4) (>= netstandard1.6)) (&& (< net45) (< netstandard1.4) (>= netstandard1.6) (< win8) (< wpa81)) (&& (< net45) (< netstandard1.5) (>= netstandard1.6) (< win8) (< wpa81)) (&& (< net45) (>= netstandard1.6) (< netstandard2.0) (< win8) (< wpa81)) (&& (< netstandard1.5) (>= netstandard1.6) (>= uap10.0)) Microsoft.NETCore.Platforms (>= 1.1) - restriction: && (< monoandroid) (< monotouch) (< net46) (>= netstandard1.3) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) @@ -214,7 +214,7 @@ NUGET System.Runtime.Serialization.Formatters (>= 4.3) - restriction: && (< net20) (>= netstandard1.3) (< netstandard2.0) System.Runtime.Serialization.Primitives (>= 4.3) - restriction: || (&& (< net20) (>= netstandard1.0) (< netstandard1.3)) (&& (< net20) (>= netstandard1.3) (< netstandard2.0)) System.Xml.XmlDocument (>= 4.3) - restriction: && (< net20) (>= netstandard1.3) (< netstandard2.0) - NuGet.Frameworks (6.6.1) - restriction: >= netcoreapp3.1 + NuGet.Frameworks (6.7) - restriction: >= netcoreapp3.1 Perfolizer (0.2.1) - restriction: >= netstandard2.0 System.Memory (>= 4.5.3) - restriction: >= netstandard2.0 QuikGraph (2.5) @@ -656,7 +656,7 @@ NUGET Microsoft.NETCore.Platforms (>= 1.1) - restriction: || (&& (< monoandroid) (< monotouch) (< net45) (>= netstandard1.3) (< win8) (< wpa81) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (< monoandroid) (< net45) (>= netstandard1.0) (< netstandard1.3) (< win8) (< wp8) (< wpa81)) Microsoft.NETCore.Targets (>= 1.1) - restriction: || (&& (< monoandroid) (< monotouch) (< net45) (>= netstandard1.3) (< win8) (< wpa81) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (< monoandroid) (< net45) (>= netstandard1.0) (< netstandard1.3) (< win8) (< wp8) (< wpa81)) System.Runtime (>= 4.3) - restriction: || (&& (< monoandroid) (< monotouch) (< net45) (>= netstandard1.3) (< win8) (< wpa81) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (< monoandroid) (< net45) (>= netstandard1.0) (< netstandard1.3) (< win8) (< wp8) (< wpa81)) - System.Text.Encoding.CodePages (7.0) - restriction: >= netstandard2.0 + System.Text.Encoding.CodePages (7.0) - restriction: && (< net6.0) (>= netstandard2.0) System.Memory (>= 4.5.5) - restriction: || (>= net462) (&& (< net6.0) (>= netstandard2.0)) System.Runtime.CompilerServices.Unsafe (>= 6.0) - restriction: || (>= net462) (&& (>= net6.0) (< net7.0)) (&& (< net6.0) (>= netstandard2.0)) System.Text.Encoding.Extensions (4.3) - restriction: || (&& (< net45) (>= net46) (< netstandard1.4) (>= netstandard1.6)) (&& (< net45) (< netstandard1.2) (>= netstandard1.6) (< win8)) (&& (< net45) (< netstandard1.3) (>= netstandard1.6) (< win8) (< wpa81)) (&& (< net45) (< netstandard1.4) (>= netstandard1.6) (< win8) (< wpa81)) (&& (< net45) (< netstandard1.5) (>= netstandard1.6) (< win8) (< wpa81)) (&& (< net45) (>= netstandard1.6) (< netstandard2.0) (< win8) (< wpa81)) (&& (< netstandard1.5) (>= netstandard1.6) (>= uap10.0)) (&& (>= netstandard1.6) (< portable-net45+win8+wpa81)) @@ -762,20 +762,20 @@ NUGET BinaryDefense.FSharp.Analyzers.Hashing (0.2.2) FSharp.Analyzers.SDK (>= 0.8) - restriction: >= net5.0 FSharp.Core (>= 5.0.1) - restriction: >= net5.0 - FSharp.Analyzers.SDK (0.12) - restriction: >= net5.0 - FSharp.Compiler.Service (>= 43.7.200) - restriction: >= net6.0 - FSharp.Core (>= 7.0.200) - restriction: >= net6.0 + FSharp.Analyzers.SDK (0.14.1) - restriction: >= net5.0 + FSharp.Compiler.Service (>= 43.7.400) - restriction: >= net6.0 + FSharp.Core (>= 7.0.400) - restriction: >= net6.0 McMaster.NETCore.Plugins (>= 1.4) - restriction: >= net6.0 - FSharp.Compiler.Service (43.7.300) - restriction: >= net6.0 - FSharp.Core (7.0.300) - restriction: >= netstandard2.0 + FSharp.Compiler.Service (43.7.400) - restriction: >= net6.0 + FSharp.Core (7.0.400) - restriction: >= netstandard2.0 System.Buffers (>= 4.5.1) - restriction: >= netstandard2.0 - System.Collections.Immutable (>= 6.0) - restriction: >= netstandard2.0 - System.Diagnostics.DiagnosticSource (>= 6.0) - restriction: >= netstandard2.0 + System.Collections.Immutable (>= 7.0) - restriction: >= netstandard2.0 + System.Diagnostics.DiagnosticSource (>= 7.0.2) - restriction: >= netstandard2.0 System.Memory (>= 4.5.5) - restriction: >= netstandard2.0 System.Reflection.Emit (>= 4.7) - restriction: >= netstandard2.0 - System.Reflection.Metadata (>= 6.0.1) - restriction: >= netstandard2.0 + System.Reflection.Metadata (>= 7.0) - restriction: >= netstandard2.0 System.Runtime.CompilerServices.Unsafe (>= 6.0) - restriction: >= netstandard2.0 - FSharp.Core (7.0.300) - restriction: >= net5.0 + FSharp.Core (7.0.400) - restriction: >= net5.0 McMaster.NETCore.Plugins (1.4) - restriction: >= net6.0 Microsoft.DotNet.PlatformAbstractions (>= 3.1.6) - restriction: >= netcoreapp2.1 Microsoft.Extensions.DependencyModel (>= 5.0) - restriction: >= netcoreapp2.1 @@ -932,17 +932,18 @@ NUGET FSharp.Control.Reactive (5.0.5) - restriction: >= netstandard2.0 FSharp.Core (>= 4.7.2) - restriction: >= netstandard2.0 System.Reactive (>= 5.0 < 6.0) - restriction: >= netstandard2.0 - FSharp.Core (7.0.300) - restriction: >= netstandard2.0 - Microsoft.Build.Framework (17.6.3) - restriction: >= netstandard2.0 + FSharp.Core (7.0.400) - restriction: >= netstandard2.0 + Microsoft.Build.Framework (17.7.2) - restriction: >= netstandard2.0 Microsoft.VisualStudio.Setup.Configuration.Interop (>= 3.2.2146) - restriction: >= net472 Microsoft.Win32.Registry (>= 5.0) - restriction: && (< net472) (< net7.0) (>= netstandard2.0) - System.Runtime.CompilerServices.Unsafe (>= 6.0) - restriction: >= net472 + System.Memory (>= 4.5.5) - restriction: && (< net472) (< net7.0) (>= netstandard2.0) + System.Runtime.CompilerServices.Unsafe (>= 6.0) - restriction: || (>= net472) (&& (< net7.0) (>= netstandard2.0)) System.Security.Permissions (>= 7.0) - restriction: || (&& (< net472) (>= netstandard2.0)) (>= net7.0) System.Security.Principal.Windows (>= 5.0) - restriction: && (< net472) (< net7.0) (>= netstandard2.0) - Microsoft.Build.Utilities.Core (17.6.3) - restriction: >= netstandard2.0 - Microsoft.Build.Framework (>= 17.6.3) - restriction: >= netstandard2.0 + Microsoft.Build.Utilities.Core (17.7.2) - restriction: >= netstandard2.0 + Microsoft.Build.Framework (>= 17.7.2) - restriction: >= netstandard2.0 Microsoft.IO.Redist (>= 6.0) - restriction: >= net472 - Microsoft.NET.StringTools (>= 17.6.3) - restriction: >= netstandard2.0 + Microsoft.NET.StringTools (>= 17.7.2) - restriction: >= netstandard2.0 Microsoft.VisualStudio.Setup.Configuration.Interop (>= 3.2.2146) - restriction: || (>= net472) (>= net7.0) Microsoft.Win32.Registry (>= 5.0) - restriction: && (< net472) (< net7.0) (>= netstandard2.0) System.Collections.Immutable (>= 7.0) - restriction: >= netstandard2.0 @@ -955,12 +956,12 @@ NUGET Microsoft.IO.Redist (6.0) - restriction: >= net472 System.Buffers (>= 4.5.1) - restriction: >= net472 System.Memory (>= 4.5.4) - restriction: >= net472 - Microsoft.NET.StringTools (17.6.3) - restriction: >= netstandard2.0 + Microsoft.NET.StringTools (17.7.2) - restriction: >= netstandard2.0 System.Memory (>= 4.5.5) - restriction: || (>= net472) (&& (< net7.0) (>= netstandard2.0)) System.Runtime.CompilerServices.Unsafe (>= 6.0) - restriction: || (>= net472) (&& (< net7.0) (>= netstandard2.0)) Microsoft.NETCore.Platforms (7.0.4) - restriction: || (&& (< monoandroid) (< net45) (< netcoreapp3.1) (>= netstandard2.0) (< win8) (< wpa81) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (< monoandroid) (< net45) (< netstandard1.2) (>= netstandard2.0) (< win8)) (&& (< monoandroid) (< net45) (< netstandard1.3) (>= netstandard2.0) (< win8) (< wpa81)) (&& (< monoandroid) (< net45) (< netstandard1.5) (>= netstandard2.0) (< win8) (< wpa81)) (&& (< monoandroid) (>= net5.0) (< netcoreapp2.1) (< netstandard2.1) (< xamarintvos) (< xamarinwatchos)) (&& (>= netcoreapp2.0) (< netcoreapp2.1)) (&& (>= netcoreapp2.1) (< netcoreapp3.0)) Microsoft.NETCore.Targets (5.0) - restriction: || (&& (< monoandroid) (< net45) (< netcoreapp3.1) (>= netstandard2.0) (< win8) (< wpa81) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (< monoandroid) (< net45) (< netstandard1.2) (>= netstandard2.0) (< win8)) (&& (< monoandroid) (< net45) (< netstandard1.3) (>= netstandard2.0) (< win8) (< wpa81)) (&& (< monoandroid) (< net45) (< netstandard1.5) (>= netstandard2.0) (< win8) (< wpa81)) - Microsoft.VisualStudio.Setup.Configuration.Interop (3.6.2115) - restriction: || (>= net472) (>= net7.0) + Microsoft.VisualStudio.Setup.Configuration.Interop (3.7.2175) - restriction: || (>= net472) (>= net7.0) Microsoft.Win32.Registry (5.0) - restriction: || (&& (< net45) (>= netstandard2.0)) (&& (< net472) (< net7.0) (>= netstandard2.0)) System.Buffers (>= 4.5.1) - restriction: || (&& (>= monoandroid) (< netstandard1.3)) (>= monotouch) (&& (< net46) (< netcoreapp2.0) (>= netstandard2.0)) (>= xamarinios) (>= xamarinmac) (>= xamarintvos) (>= xamarinwatchos) System.Memory (>= 4.5.4) - restriction: || (&& (< monoandroid) (>= netcoreapp2.0) (< netcoreapp2.1) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (< net46) (< netcoreapp2.0) (>= netstandard2.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (>= uap10.1) @@ -968,25 +969,24 @@ NUGET System.Security.Principal.Windows (>= 5.0) - restriction: || (&& (>= monoandroid) (< netstandard1.3)) (&& (< monoandroid) (>= netcoreapp2.0)) (>= monotouch) (&& (< net46) (< netcoreapp2.0) (>= netstandard2.0)) (>= net461) (>= netcoreapp2.1) (>= uap10.1) (>= xamarinios) (>= xamarinmac) (>= xamarintvos) (>= xamarinwatchos) Microsoft.Win32.SystemEvents (7.0) - restriction: >= net6.0 Mono.Posix.NETStandard (1.0) - restriction: >= netstandard2.0 - MSBuild.StructuredLogger (2.1.844) - restriction: >= netstandard2.0 + MSBuild.StructuredLogger (2.1.858) - restriction: >= netstandard2.0 Microsoft.Build.Framework (>= 17.5) - restriction: >= netstandard2.0 Microsoft.Build.Utilities.Core (>= 17.5) - restriction: >= netstandard2.0 Newtonsoft.Json (13.0.3) - restriction: >= netstandard2.0 - NuGet.Common (6.6.1) - restriction: >= netstandard2.0 - NuGet.Frameworks (>= 6.6.1) - restriction: >= netstandard2.0 - NuGet.Configuration (6.6.1) - restriction: >= netstandard2.0 - NuGet.Common (>= 6.6.1) - restriction: >= netstandard2.0 + NuGet.Common (6.7) - restriction: >= netstandard2.0 + NuGet.Frameworks (>= 6.7) - restriction: >= netstandard2.0 + NuGet.Configuration (6.7) - restriction: >= netstandard2.0 + NuGet.Common (>= 6.7) - restriction: >= netstandard2.0 System.Security.Cryptography.ProtectedData (>= 4.4) - restriction: && (< net472) (>= netstandard2.0) - NuGet.Frameworks (6.6.1) - restriction: >= netstandard2.0 - NuGet.Packaging (6.6.1) - restriction: >= netstandard2.0 + NuGet.Frameworks (6.7) - restriction: >= netstandard2.0 + NuGet.Packaging (6.7) - restriction: >= netstandard2.0 Newtonsoft.Json (>= 13.0.1) - restriction: >= netstandard2.0 - NuGet.Configuration (>= 6.6.1) - restriction: >= netstandard2.0 - NuGet.Versioning (>= 6.6.1) - restriction: >= netstandard2.0 - System.Security.Cryptography.Cng (>= 5.0) - restriction: || (&& (< net472) (>= netstandard2.0)) (>= net5.0) - System.Security.Cryptography.Pkcs (>= 5.0) - restriction: || (&& (< net472) (>= netstandard2.0)) (>= net5.0) - NuGet.Protocol (6.6.1) - restriction: >= netstandard2.0 - NuGet.Packaging (>= 6.6.1) - restriction: >= netstandard2.0 - NuGet.Versioning (6.6.1) - restriction: >= netstandard2.0 + NuGet.Configuration (>= 6.7) - restriction: >= netstandard2.0 + NuGet.Versioning (>= 6.7) - restriction: >= netstandard2.0 + System.Security.Cryptography.Pkcs (>= 6.0.4) - restriction: || (&& (< net472) (>= netstandard2.0)) (>= net5.0) + NuGet.Protocol (6.7) - restriction: >= netstandard2.0 + NuGet.Packaging (>= 6.7) - restriction: >= netstandard2.0 + NuGet.Versioning (6.7) - restriction: >= netstandard2.0 Octokit (0.48) System.Buffers (4.5.1) - restriction: || (&& (>= monoandroid) (< netstandard1.1) (>= netstandard2.0)) (&& (>= monoandroid) (< netstandard1.3) (>= netstandard2.0)) (&& (< monoandroid) (< netstandard1.1) (>= netstandard2.0) (< win8)) (&& (>= monotouch) (>= netstandard2.0)) (&& (< net45) (< netcoreapp2.0) (>= netstandard2.0)) (&& (>= net461) (>= netstandard2.0)) (&& (>= net462) (>= netstandard2.0)) (&& (>= net462) (>= netstandard2.1)) (&& (< net462) (< net6.0) (>= netstandard2.0)) (&& (< net462) (>= netstandard2.0) (< netstandard2.1)) (>= net472) (&& (>= net5.0) (< netstandard2.1)) (&& (< net6.0) (>= netstandard2.1)) (&& (< netstandard1.1) (>= netstandard2.0) (>= win8)) (&& (>= netstandard2.0) (>= xamarintvos)) (&& (>= netstandard2.0) (>= xamarinwatchos)) (>= xamarinios) (>= xamarinmac) System.Collections.Immutable (7.0) - restriction: >= netstandard2.0 @@ -999,10 +999,9 @@ NUGET System.Diagnostics.EventLog (7.0) - restriction: >= net7.0 System.Drawing.Common (7.0) - restriction: >= net6.0 Microsoft.Win32.SystemEvents (>= 7.0) - restriction: >= net6.0 - System.Formats.Asn1 (7.0) - restriction: || (&& (< net462) (>= netstandard2.0)) (&& (>= net5.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (>= netcoreapp3.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (>= netstandard2.1) + System.Formats.Asn1 (7.0) - restriction: || (&& (< net462) (>= netstandard2.0)) (&& (>= net5.0) (< xamarintvos) (< xamarinwatchos)) (&& (>= netcoreapp3.0) (< xamarintvos) (< xamarinwatchos)) (>= netstandard2.1) System.Buffers (>= 4.5.1) - restriction: || (>= net462) (&& (< net6.0) (>= netstandard2.0)) System.Memory (>= 4.5.5) - restriction: || (>= net462) (&& (< net6.0) (>= netstandard2.0)) - System.IO (4.3) - restriction: || (&& (< monoandroid) (< net46) (< netstandard1.4) (>= netstandard2.0)) (&& (< monoandroid) (< net46) (< netstandard1.6) (>= netstandard2.0)) (&& (< monoandroid) (>= net5.0) (< netstandard1.4)) (&& (< monoandroid) (>= net5.0) (< netstandard1.6)) (&& (< monoandroid) (>= net5.0) (< netstandard2.0) (< xamarintvos) (< xamarinwatchos)) (&& (>= net46) (>= net5.0) (< netstandard1.4)) (&& (< net46) (>= net461) (< netstandard1.4) (>= netstandard2.0)) (&& (< net46) (>= net461) (< netstandard1.6) (>= netstandard2.0)) (&& (< net46) (>= net462) (< netstandard1.4) (>= netstandard2.0)) (&& (< net46) (>= net462) (< netstandard1.6) (>= netstandard2.0)) (&& (< net46) (>= net47) (>= netstandard2.0)) (&& (>= net461) (>= net5.0) (< netstandard1.4)) (&& (>= net461) (>= net5.0) (< netstandard1.6)) (&& (>= net462) (>= net5.0) (< netstandard1.4)) (&& (>= net462) (>= net5.0) (< netstandard1.6)) (&& (>= net463) (>= net5.0) (< netstandard1.4)) (&& (>= net463) (>= net5.0) (< netstandard1.6)) (&& (>= net463) (>= net5.0) (< netstandard2.0)) (&& (>= net463) (< netstandard1.4) (>= netstandard2.0)) (&& (>= net463) (< netstandard1.6) (>= netstandard2.0)) (&& (>= net47) (< net472) (>= netstandard2.0)) (&& (>= net47) (>= net5.0)) System.Memory (4.5.5) - restriction: || (&& (< monoandroid) (>= netcoreapp2.0) (< netcoreapp2.1) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (< net45) (< netcoreapp2.0) (>= netstandard2.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (>= net462) (>= netstandard2.0)) (&& (< net462) (>= netstandard2.0) (< netstandard2.1)) (>= net472) (&& (>= net5.0) (< netstandard2.1)) (&& (< net6.0) (>= netstandard2.0)) (&& (< net7.0) (>= netstandard2.0)) (&& (>= netstandard2.0) (>= uap10.1)) System.Buffers (>= 4.5.1) - restriction: || (&& (>= monoandroid) (< netstandard1.1)) (&& (< monoandroid) (< net45) (>= netstandard1.1) (< netstandard2.0) (< win8) (< wpa81)) (&& (< monoandroid) (< netstandard1.1) (>= portable-net45+win8+wpa81) (< win8)) (>= monotouch) (&& (>= net45) (< netstandard2.0)) (&& (< net45) (< netcoreapp2.0) (>= netstandard2.0)) (>= net461) (&& (< netstandard1.1) (>= win8)) (&& (< netstandard2.0) (< uap10.1) (>= wpa81)) (>= xamarinios) (>= xamarinmac) (>= xamarintvos) (>= xamarinwatchos) System.Numerics.Vectors (>= 4.4) - restriction: && (< net45) (< netcoreapp2.0) (>= netstandard2.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) @@ -1012,7 +1011,7 @@ NUGET System.Reactive (5.0) - restriction: >= netstandard2.0 System.Runtime.InteropServices.WindowsRuntime (>= 4.3) - restriction: && (< net472) (< netcoreapp3.1) (>= netstandard2.0) System.Threading.Tasks.Extensions (>= 4.5.4) - restriction: || (>= net472) (&& (< netcoreapp3.1) (>= netstandard2.0)) (>= uap10.1) - System.Runtime (4.3.1) - restriction: || (&& (< monoandroid) (< net45) (< netcoreapp3.1) (>= netstandard2.0) (< win8) (< wpa81) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (< monoandroid) (< net46) (< netstandard1.4) (>= netstandard2.0)) (&& (< monoandroid) (< net46) (< netstandard1.6) (>= netstandard2.0)) (&& (< monoandroid) (>= net5.0) (< netstandard1.4)) (&& (< monoandroid) (>= net5.0) (< netstandard1.6)) (&& (< monoandroid) (>= net5.0) (< netstandard2.0) (< xamarintvos) (< xamarinwatchos)) (&& (>= net46) (>= net5.0) (< netstandard1.4)) (&& (< net46) (>= net461) (< netstandard1.4) (>= netstandard2.0)) (&& (< net46) (>= net461) (< netstandard1.6) (>= netstandard2.0)) (&& (< net46) (>= net462) (< netstandard1.4) (>= netstandard2.0)) (&& (< net46) (>= net462) (< netstandard1.6) (>= netstandard2.0)) (&& (< net46) (>= net47) (>= netstandard2.0)) (&& (>= net461) (>= net5.0) (< netstandard1.4)) (&& (>= net461) (>= net5.0) (< netstandard1.6)) (&& (>= net462) (>= net5.0) (< netstandard1.4)) (&& (>= net462) (>= net5.0) (< netstandard1.6)) (&& (>= net463) (>= net5.0) (< netstandard1.4)) (&& (>= net463) (>= net5.0) (< netstandard1.6)) (&& (>= net463) (>= net5.0) (< netstandard2.0)) (&& (>= net463) (< netstandard1.4) (>= netstandard2.0)) (&& (>= net463) (< netstandard1.6) (>= netstandard2.0)) (&& (>= net47) (< net472) (>= netstandard2.0)) (&& (>= net47) (>= net5.0)) + System.Runtime (4.3.1) - restriction: && (< monoandroid) (< net45) (< netcoreapp3.1) (>= netstandard2.0) (< win8) (< wpa81) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) Microsoft.NETCore.Platforms (>= 1.1.1) - restriction: || (&& (< monoandroid) (< net45) (>= netstandard1.0) (< netstandard1.2) (< win8) (< wp8)) (&& (< monoandroid) (< net45) (>= netstandard1.2) (< netstandard1.3) (< win8) (< wpa81)) (&& (< monoandroid) (< net45) (>= netstandard1.3) (< netstandard1.5) (< win8) (< wpa81)) (&& (< monotouch) (< net45) (>= netstandard1.5) (< win8) (< wpa81) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) Microsoft.NETCore.Targets (>= 1.1.3) - restriction: || (&& (< monoandroid) (< net45) (>= netstandard1.0) (< netstandard1.2) (< win8) (< wp8)) (&& (< monoandroid) (< net45) (>= netstandard1.2) (< netstandard1.3) (< win8) (< wpa81)) (&& (< monoandroid) (< net45) (>= netstandard1.3) (< netstandard1.5) (< win8) (< wpa81)) (&& (< monotouch) (< net45) (>= netstandard1.5) (< win8) (< wpa81) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) System.Runtime.CompilerServices.Unsafe (6.0) - restriction: || (&& (>= monoandroid) (< netstandard1.1) (>= netstandard2.0)) (&& (< monoandroid) (>= netcoreapp2.0) (< netcoreapp2.1)) (&& (< monoandroid) (< netstandard1.0) (>= netstandard2.0) (< win8)) (&& (< monoandroid) (< netstandard1.1) (>= netstandard2.0) (< win8)) (&& (>= monotouch) (>= netstandard2.0)) (&& (< net45) (< netcoreapp2.0) (>= netstandard2.0)) (&& (< net45) (< netcoreapp2.1) (>= netstandard2.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (>= net461) (>= netstandard2.0)) (&& (>= net462) (>= netcoreapp2.0)) (&& (>= net462) (>= netstandard2.0)) (&& (>= net462) (>= xamarinios)) (&& (>= net462) (>= xamarinmac)) (>= net472) (&& (>= net6.0) (< net7.0)) (&& (< net6.0) (>= netstandard2.0)) (&& (< net6.0) (>= xamarinios)) (&& (< net6.0) (>= xamarinmac)) (&& (< netstandard1.0) (>= netstandard2.0) (>= win8)) (&& (< netstandard1.1) (>= netstandard2.0) (>= win8)) (&& (>= netstandard2.0) (>= uap10.1)) (&& (>= netstandard2.0) (>= wp8)) @@ -1020,22 +1019,14 @@ NUGET System.Runtime (>= 4.3) - restriction: && (< monoandroid) (< monotouch) (< net45) (>= netstandard1.0) (< win8) (< wp8) (< wpa81) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) System.Security.AccessControl (6.0) - restriction: || (&& (>= monoandroid) (< netstandard1.3) (>= netstandard2.0)) (&& (< monoandroid) (>= netcoreapp2.0)) (&& (>= monotouch) (>= netstandard2.0)) (&& (< net45) (>= net461) (>= netstandard2.0)) (&& (< net45) (< netcoreapp2.0) (>= netstandard2.0)) (&& (>= net462) (>= netstandard2.0)) (&& (< net6.0) (>= netstandard2.0)) (>= netcoreapp2.1) (&& (>= netstandard2.0) (>= uap10.1)) (&& (>= netstandard2.0) (>= xamarintvos)) (&& (>= netstandard2.0) (>= xamarinwatchos)) (>= xamarinios) (>= xamarinmac) System.Security.Principal.Windows (>= 5.0) - restriction: || (>= net461) (&& (< net6.0) (>= netstandard2.0)) - System.Security.Cryptography.Algorithms (4.3.1) - restriction: || (&& (< monoandroid) (< net46) (< netstandard1.4) (>= netstandard2.0)) (&& (< monoandroid) (< net46) (< netstandard1.6) (>= netstandard2.0)) (&& (< monoandroid) (>= net5.0) (< netstandard1.4)) (&& (< monoandroid) (>= net5.0) (< netstandard1.6)) (&& (< monoandroid) (>= net5.0) (< netstandard2.0) (< xamarintvos) (< xamarinwatchos)) (&& (>= net46) (>= net5.0) (< netstandard1.4)) (&& (>= net46) (< netstandard1.4) (>= netstandard2.0)) (&& (>= net461) (< net462) (< netstandard1.6) (>= netstandard2.0)) (&& (>= net461) (>= net5.0) (< netstandard1.6)) (&& (>= net462) (>= net5.0) (< netstandard1.6)) (&& (>= net462) (< netstandard1.6) (>= netstandard2.0)) (&& (>= net47) (< net472) (>= netstandard2.0)) (&& (>= net47) (>= net5.0)) - System.IO (>= 4.3) - restriction: || (&& (< monoandroid) (< net46) (>= netstandard1.3) (< netstandard1.4)) (&& (< monoandroid) (< net46) (>= netstandard1.4) (< netstandard1.6)) (&& (< monotouch) (< net46) (>= netstandard1.6) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (>= net463) - System.Runtime (>= 4.3) - restriction: || (&& (< monoandroid) (< net46) (>= netstandard1.3) (< netstandard1.4)) (&& (< monoandroid) (< net46) (>= netstandard1.4) (< netstandard1.6)) (&& (< monotouch) (< net46) (>= netstandard1.6) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (>= net463) - System.Security.Cryptography.Encoding (>= 4.3) - restriction: || (&& (< monotouch) (< net46) (>= netstandard1.6) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (>= net463) - System.Security.Cryptography.Primitives (>= 4.3) - restriction: || (&& (< monoandroid) (< net46) (>= netstandard1.3) (< netstandard1.4)) (&& (< monoandroid) (< net46) (>= netstandard1.4) (< netstandard1.6)) (&& (< monotouch) (< net46) (>= netstandard1.6) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (>= net46) (< netstandard1.4)) (&& (>= net461) (< netstandard1.6)) (>= net463) - System.Security.Cryptography.Cng (5.0) - restriction: || (&& (< net462) (>= netstandard2.0) (< netstandard2.1)) (&& (< net472) (>= netstandard2.0)) (>= net5.0) (&& (< net6.0) (>= netstandard2.1)) + System.Security.Cryptography.Cng (5.0) - restriction: || (&& (< net462) (>= netstandard2.0) (< netstandard2.1)) (&& (>= net5.0) (< net6.0)) (&& (>= net5.0) (< netstandard2.1)) (&& (< net6.0) (>= netstandard2.1)) Microsoft.NETCore.Platforms (>= 5.0) - restriction: && (< monoandroid) (>= netcoreapp2.0) (< netcoreapp2.1) (< netstandard2.1) (< xamarintvos) (< xamarinwatchos) System.Formats.Asn1 (>= 5.0) - restriction: && (>= netcoreapp3.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) - System.Security.Cryptography.Algorithms (>= 4.3.1) - restriction: || (&& (< monoandroid) (< monotouch) (< net46) (>= netstandard1.6) (< netstandard2.0) (< xamarintvos) (< xamarinwatchos)) (&& (< monoandroid) (< net46) (>= netstandard1.3) (< netstandard1.4)) (&& (< monoandroid) (< net46) (>= netstandard1.4) (< netstandard1.6) (< uap10.1)) (&& (>= net46) (< netstandard1.4)) (&& (>= net461) (< net462) (< netstandard1.6)) (&& (>= net462) (< netstandard1.6)) (>= net47) - System.Security.Cryptography.Encoding (4.3) - restriction: || (&& (< monoandroid) (< net46) (< netstandard1.4) (>= netstandard2.0)) (&& (< monoandroid) (< net46) (< netstandard1.6) (>= netstandard2.0)) (&& (< monoandroid) (>= net5.0) (< netstandard1.4)) (&& (< monoandroid) (>= net5.0) (< netstandard1.6)) (&& (< monoandroid) (>= net5.0) (< netstandard2.0) (< xamarintvos) (< xamarinwatchos)) (&& (>= net46) (>= net5.0) (< netstandard1.4)) (&& (< net46) (>= net461) (< netstandard1.6) (>= netstandard2.0)) (&& (< net46) (>= net462) (< netstandard1.6) (>= netstandard2.0)) (&& (< net46) (>= net47) (>= netstandard2.0)) (&& (>= net461) (>= net5.0) (< netstandard1.6)) (&& (>= net462) (>= net5.0) (< netstandard1.6)) (&& (>= net463) (>= net5.0) (< netstandard1.4)) (&& (>= net463) (>= net5.0) (< netstandard1.6)) (&& (>= net463) (>= net5.0) (< netstandard2.0)) (&& (>= net463) (< netstandard1.4) (>= netstandard2.0)) (&& (>= net463) (< netstandard1.6) (>= netstandard2.0)) (&& (>= net47) (< net472) (>= netstandard2.0)) (&& (>= net47) (>= net5.0)) System.Security.Cryptography.Pkcs (7.0.3) - restriction: || (&& (< net472) (>= netstandard2.0)) (>= net5.0) System.Buffers (>= 4.5.1) - restriction: && (< net462) (>= netstandard2.0) (< netstandard2.1) System.Formats.Asn1 (>= 7.0) - restriction: || (&& (< net462) (>= netstandard2.0)) (>= netstandard2.1) System.Memory (>= 4.5.5) - restriction: && (< net462) (>= netstandard2.0) (< netstandard2.1) System.Security.Cryptography.Cng (>= 5.0) - restriction: || (&& (< net462) (>= netstandard2.0) (< netstandard2.1)) (&& (< net6.0) (>= netstandard2.1)) - System.Security.Cryptography.Primitives (4.3) - restriction: || (&& (< monoandroid) (< net46) (< netstandard1.4) (>= netstandard2.0)) (&& (< monoandroid) (< net46) (< netstandard1.6) (>= netstandard2.0)) (&& (< monoandroid) (>= net5.0) (< netstandard1.4)) (&& (< monoandroid) (>= net5.0) (< netstandard1.6)) (&& (< monoandroid) (>= net5.0) (< netstandard2.0) (< xamarintvos) (< xamarinwatchos)) (&& (>= net46) (>= net5.0) (< netstandard1.4)) (&& (>= net46) (< netstandard1.4) (>= netstandard2.0)) (&& (< net46) (>= net461) (< netstandard1.6) (>= netstandard2.0)) (&& (< net46) (>= net47) (>= netstandard2.0)) (&& (>= net461) (< net462) (< netstandard1.6) (>= netstandard2.0)) (&& (>= net461) (>= net5.0) (< netstandard1.4)) (&& (>= net461) (>= net5.0) (< netstandard1.6)) (&& (>= net461) (< netstandard1.4) (>= netstandard2.0)) (&& (>= net462) (>= net5.0) (< netstandard1.4)) (&& (>= net462) (>= net5.0) (< netstandard1.6)) (&& (>= net462) (< netstandard1.4) (>= netstandard2.0)) (&& (>= net462) (< netstandard1.6) (>= netstandard2.0)) (&& (>= net463) (>= net5.0) (< netstandard1.4)) (&& (>= net463) (>= net5.0) (< netstandard1.6)) (&& (>= net463) (>= net5.0) (< netstandard2.0)) (&& (>= net463) (< netstandard1.4) (>= netstandard2.0)) (&& (>= net463) (< netstandard1.6) (>= netstandard2.0)) (&& (>= net47) (< net472) (>= netstandard2.0)) (&& (>= net47) (>= net5.0)) (&& (>= net47) (< netstandard1.4) (>= netstandard2.0)) (&& (>= net47) (< netstandard1.6) (>= netstandard2.0)) System.Security.Cryptography.ProtectedData (7.0.1) - restriction: || (&& (< net462) (>= netstandard2.0)) (&& (< net472) (>= netstandard2.0)) (>= net6.0) System.Memory (>= 4.5.5) - restriction: && (< net462) (< net6.0) (>= netstandard2.0) System.Security.Permissions (7.0) - restriction: >= netstandard2.0 @@ -1083,7 +1074,7 @@ NUGET Fable.Browser.Event (>= 1.5) - restriction: >= netstandard2.0 Fable.Core (>= 3.0) - restriction: >= netstandard2.0 FSharp.Core (>= 4.7.2) - restriction: >= netstandard2.0 - Fable.Core (4.0) - restriction: >= netstandard2.0 + Fable.Core (4.1) - restriction: >= netstandard2.0 Fable.React (9.3) Fable.React.Types (>= 18.3) - restriction: >= netstandard2.0 Fable.ReactDom.Types (>= 18.2) - restriction: >= netstandard2.0 @@ -1176,22 +1167,23 @@ NUGET System.Runtime.Loader (>= 4.0) - restriction: && (< net461) (>= netstandard2.0) System.Security.Cryptography.Algorithms (>= 4.3) - restriction: && (< net461) (>= netstandard2.0) System.ValueTuple (>= 4.4) - restriction: >= net461 - FSharp.Core (7.0.300) + FSharp.Core (7.0.400) FSharp.Formatting (4.0.0-rc1) FSharp.Compiler.Service (>= 34.1) - restriction: >= netstandard2.0 FSharp.Literate (4.0.0-rc1) FSharp.Compiler.Service (>= 34.1) - restriction: >= netstandard2.0 FSharp.Core (>= 4.7) - restriction: >= netstandard2.0 - Microsoft.Build.Framework (17.6.3) - restriction: >= netstandard2.0 + Microsoft.Build.Framework (17.7.2) - restriction: >= netstandard2.0 Microsoft.VisualStudio.Setup.Configuration.Interop (>= 3.2.2146) - restriction: >= net472 Microsoft.Win32.Registry (>= 5.0) - restriction: && (< net472) (< net7.0) (>= netstandard2.0) - System.Runtime.CompilerServices.Unsafe (>= 6.0) - restriction: >= net472 + System.Memory (>= 4.5.5) - restriction: && (< net472) (< net7.0) (>= netstandard2.0) + System.Runtime.CompilerServices.Unsafe (>= 6.0) - restriction: || (>= net472) (&& (< net7.0) (>= netstandard2.0)) System.Security.Permissions (>= 7.0) - restriction: || (&& (< net472) (>= netstandard2.0)) (>= net7.0) System.Security.Principal.Windows (>= 5.0) - restriction: && (< net472) (< net7.0) (>= netstandard2.0) - Microsoft.Build.Utilities.Core (17.6.3) - restriction: >= netstandard2.0 - Microsoft.Build.Framework (>= 17.6.3) - restriction: >= netstandard2.0 + Microsoft.Build.Utilities.Core (17.7.2) - restriction: >= netstandard2.0 + Microsoft.Build.Framework (>= 17.7.2) - restriction: >= netstandard2.0 Microsoft.IO.Redist (>= 6.0) - restriction: >= net472 - Microsoft.NET.StringTools (>= 17.6.3) - restriction: >= netstandard2.0 + Microsoft.NET.StringTools (>= 17.7.2) - restriction: >= netstandard2.0 Microsoft.VisualStudio.Setup.Configuration.Interop (>= 3.2.2146) - restriction: || (>= net472) (>= net7.0) Microsoft.Win32.Registry (>= 5.0) - restriction: && (< net472) (< net7.0) (>= netstandard2.0) System.Collections.Immutable (>= 7.0) - restriction: >= netstandard2.0 @@ -1204,12 +1196,12 @@ NUGET Microsoft.IO.Redist (6.0) - restriction: >= net472 System.Buffers (>= 4.5.1) - restriction: >= net472 System.Memory (>= 4.5.4) - restriction: >= net472 - Microsoft.NET.StringTools (17.6.3) - restriction: >= netstandard2.0 + Microsoft.NET.StringTools (17.7.2) - restriction: >= netstandard2.0 System.Memory (>= 4.5.5) - restriction: || (>= net472) (&& (< net7.0) (>= netstandard2.0)) System.Runtime.CompilerServices.Unsafe (>= 6.0) - restriction: || (>= net472) (&& (< net7.0) (>= netstandard2.0)) Microsoft.NETCore.Platforms (7.0.4) - restriction: || (&& (>= monoandroid) (>= netcoreapp2.0) (< netstandard1.3)) (&& (>= monoandroid) (>= netcoreapp2.1) (< netstandard1.3)) (&& (< monoandroid) (< net45) (< netstandard1.2) (>= netstandard2.0) (< win8)) (&& (< monoandroid) (< net45) (< netstandard1.3) (>= netstandard2.0) (< win8) (< wpa81)) (&& (< monoandroid) (< net45) (< netstandard1.5) (>= netstandard2.0) (< win8) (< wpa81)) (&& (< monoandroid) (>= net5.0) (< netcoreapp2.1) (< netstandard2.1) (< xamarintvos) (< xamarinwatchos)) (&& (< monoandroid) (>= netcoreapp2.0) (< netcoreapp2.1) (< netstandard2.1) (< xamarintvos) (< xamarinwatchos)) (&& (< monoandroid) (>= netcoreapp2.0) (< netcoreapp2.1) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (>= monotouch) (>= netcoreapp2.0)) (&& (>= monotouch) (>= netcoreapp2.1)) (&& (< net45) (>= netstandard2.0) (< win8) (< wpa81) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (< net46) (>= netstandard2.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (>= net461) (>= netcoreapp2.0)) (&& (>= net461) (>= netcoreapp2.1)) (&& (>= netcoreapp2.0) (>= uap10.1)) (&& (< netcoreapp2.0) (>= netcoreapp2.1) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (>= netcoreapp2.1) (< netcoreapp3.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (>= netcoreapp2.1) (>= uap10.1)) Microsoft.NETCore.Targets (5.0) - restriction: || (&& (< monoandroid) (< net45) (< netstandard1.2) (>= netstandard2.0) (< win8)) (&& (< monoandroid) (< net45) (< netstandard1.3) (>= netstandard2.0) (< win8) (< wpa81)) (&& (< monoandroid) (< net45) (< netstandard1.5) (>= netstandard2.0) (< win8) (< wpa81)) (&& (< net45) (>= netstandard2.0) (< win8) (< wpa81) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (< net46) (>= netstandard2.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) - Microsoft.VisualStudio.Setup.Configuration.Interop (3.6.2115) - restriction: || (>= net472) (>= net7.0) + Microsoft.VisualStudio.Setup.Configuration.Interop (3.7.2175) - restriction: || (>= net472) (>= net7.0) Microsoft.Win32.Primitives (4.3) - restriction: && (< net46) (>= netstandard2.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) Microsoft.NETCore.Platforms (>= 1.1) - restriction: && (< monoandroid) (< monotouch) (< net46) (>= netstandard1.3) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) Microsoft.NETCore.Targets (>= 1.1) - restriction: && (< monoandroid) (< monotouch) (< net46) (>= netstandard1.3) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) @@ -1221,25 +1213,24 @@ NUGET System.Security.Principal.Windows (>= 5.0) - restriction: || (&& (>= monoandroid) (< netstandard1.3)) (&& (< monoandroid) (>= netcoreapp2.0)) (>= monotouch) (&& (< net46) (< netcoreapp2.0) (>= netstandard2.0)) (>= net461) (>= netcoreapp2.1) (>= uap10.1) (>= xamarinios) (>= xamarinmac) (>= xamarintvos) (>= xamarinwatchos) Microsoft.Win32.SystemEvents (7.0) - restriction: >= net6.0 Mono.Posix.NETStandard (1.0) - restriction: >= netstandard2.0 - MSBuild.StructuredLogger (2.1.844) - restriction: >= netstandard2.0 + MSBuild.StructuredLogger (2.1.858) - restriction: >= netstandard2.0 Microsoft.Build.Framework (>= 17.5) - restriction: >= netstandard2.0 Microsoft.Build.Utilities.Core (>= 17.5) - restriction: >= netstandard2.0 Newtonsoft.Json (13.0.3) - restriction: >= netstandard2.0 - NuGet.Common (6.6.1) - restriction: >= netstandard2.0 - NuGet.Frameworks (>= 6.6.1) - restriction: >= netstandard2.0 - NuGet.Configuration (6.6.1) - restriction: >= netstandard2.0 - NuGet.Common (>= 6.6.1) - restriction: >= netstandard2.0 + NuGet.Common (6.7) - restriction: >= netstandard2.0 + NuGet.Frameworks (>= 6.7) - restriction: >= netstandard2.0 + NuGet.Configuration (6.7) - restriction: >= netstandard2.0 + NuGet.Common (>= 6.7) - restriction: >= netstandard2.0 System.Security.Cryptography.ProtectedData (>= 4.4) - restriction: && (< net472) (>= netstandard2.0) - NuGet.Frameworks (6.6.1) - restriction: >= netstandard2.0 - NuGet.Packaging (6.6.1) - restriction: >= netstandard2.0 + NuGet.Frameworks (6.7) - restriction: >= netstandard2.0 + NuGet.Packaging (6.7) - restriction: >= netstandard2.0 Newtonsoft.Json (>= 13.0.1) - restriction: >= netstandard2.0 - NuGet.Configuration (>= 6.6.1) - restriction: >= netstandard2.0 - NuGet.Versioning (>= 6.6.1) - restriction: >= netstandard2.0 - System.Security.Cryptography.Cng (>= 5.0) - restriction: || (&& (< net472) (>= netstandard2.0)) (>= net5.0) - System.Security.Cryptography.Pkcs (>= 5.0) - restriction: || (&& (< net472) (>= netstandard2.0)) (>= net5.0) - NuGet.Protocol (6.6.1) - restriction: >= netstandard2.0 - NuGet.Packaging (>= 6.6.1) - restriction: >= netstandard2.0 - NuGet.Versioning (6.6.1) - restriction: >= netstandard2.0 + NuGet.Configuration (>= 6.7) - restriction: >= netstandard2.0 + NuGet.Versioning (>= 6.7) - restriction: >= netstandard2.0 + System.Security.Cryptography.Pkcs (>= 6.0.4) - restriction: || (&& (< net472) (>= netstandard2.0)) (>= net5.0) + NuGet.Protocol (6.7) - restriction: >= netstandard2.0 + NuGet.Packaging (>= 6.7) - restriction: >= netstandard2.0 + NuGet.Versioning (6.7) - restriction: >= netstandard2.0 runtime.debian.8-x64.runtime.native.System.Security.Cryptography.OpenSsl (4.3.3) - restriction: && (< net46) (>= netstandard2.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) runtime.debian.9-x64.runtime.native.System.Security.Cryptography.OpenSsl (4.3.3) - restriction: && (< net46) (>= netstandard2.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) runtime.fedora.23-x64.runtime.native.System.Security.Cryptography.OpenSsl (4.3.3) - restriction: && (< net46) (>= netstandard2.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) @@ -1343,7 +1334,7 @@ NUGET System.Runtime (>= 4.3) - restriction: || (&& (< monoandroid) (< net45) (>= netstandard1.1) (< netstandard1.2) (< win8)) (&& (< monoandroid) (< net45) (>= netstandard1.2) (< netstandard1.3) (< win8) (< wpa81)) (&& (< monoandroid) (< net45) (>= netstandard1.3) (< netstandard1.5) (< win8) (< wpa81)) (&& (< monotouch) (< net45) (>= netstandard1.5) (< win8) (< wpa81) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) System.Drawing.Common (7.0) - restriction: >= net6.0 Microsoft.Win32.SystemEvents (>= 7.0) - restriction: >= net6.0 - System.Formats.Asn1 (7.0) - restriction: || (&& (< net462) (>= netstandard2.0)) (&& (>= net5.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (>= netcoreapp3.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (>= netstandard2.1) + System.Formats.Asn1 (7.0) - restriction: || (&& (< net462) (>= netstandard2.0)) (&& (>= net5.0) (< xamarintvos) (< xamarinwatchos)) (&& (>= netcoreapp3.0) (< xamarintvos) (< xamarinwatchos)) (>= netstandard2.1) System.Buffers (>= 4.5.1) - restriction: || (>= net462) (&& (< net6.0) (>= netstandard2.0)) System.Memory (>= 4.5.5) - restriction: || (>= net462) (&& (< net6.0) (>= netstandard2.0)) System.Globalization (4.3) - restriction: || (&& (< monoandroid) (< net45) (>= netstandard2.0) (< win8) (< wpa81) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (< net46) (>= netstandard2.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) @@ -1432,7 +1423,7 @@ NUGET System.Runtime.Extensions (>= 4.3) - restriction: && (< monoandroid) (< monotouch) (< net45) (>= netstandard1.3) (< win8) (< wpa81) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) System.Security.AccessControl (6.0) - restriction: || (&& (>= monoandroid) (< netstandard1.3) (>= netstandard2.0)) (&& (< monoandroid) (>= netcoreapp2.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (>= monotouch) (>= netstandard2.0)) (&& (< net46) (>= net461) (>= netstandard2.0)) (&& (< net46) (< netcoreapp2.0) (>= netstandard2.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (>= net462) (>= netstandard2.0)) (&& (< net6.0) (>= netstandard2.0)) (&& (>= netcoreapp2.1) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (>= netstandard2.0) (>= uap10.1)) System.Security.Principal.Windows (>= 5.0) - restriction: || (>= net461) (&& (< net6.0) (>= netstandard2.0)) - System.Security.Cryptography.Algorithms (4.3.1) - restriction: || (&& (< monoandroid) (< net46) (< netstandard1.4) (>= netstandard2.0)) (&& (< monoandroid) (< net46) (< netstandard1.6) (>= netstandard2.0)) (&& (< monoandroid) (>= net5.0) (< netstandard1.4)) (&& (< monoandroid) (>= net5.0) (< netstandard1.6)) (&& (< monoandroid) (>= net5.0) (< netstandard2.0) (< xamarintvos) (< xamarinwatchos)) (&& (>= net46) (>= net5.0) (< netstandard1.4)) (&& (>= net46) (< netstandard1.4) (>= netstandard2.0)) (&& (>= net461) (< net462) (< netstandard1.6) (>= netstandard2.0)) (&& (>= net461) (>= net5.0) (< netstandard1.6)) (&& (< net461) (>= netstandard2.0)) (&& (>= net462) (>= net5.0) (< netstandard1.6)) (&& (>= net462) (< netstandard1.6) (>= netstandard2.0)) (&& (>= net47) (< net472) (>= netstandard2.0)) (&& (>= net47) (>= net5.0)) + System.Security.Cryptography.Algorithms (4.3.1) - restriction: && (< net461) (>= netstandard2.0) Microsoft.NETCore.Platforms (>= 1.1) - restriction: && (< monotouch) (< net46) (>= netstandard1.6) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) runtime.native.System.Security.Cryptography.Apple (>= 4.3.1) - restriction: && (< monotouch) (< net46) (>= netstandard1.6) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) runtime.native.System.Security.Cryptography.OpenSsl (>= 4.3.2) - restriction: && (< monotouch) (< net46) (>= netstandard1.6) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) @@ -1447,10 +1438,9 @@ NUGET System.Security.Cryptography.Encoding (>= 4.3) - restriction: || (&& (< monotouch) (< net46) (>= netstandard1.6) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (>= net463) System.Security.Cryptography.Primitives (>= 4.3) - restriction: || (&& (< monoandroid) (< net46) (>= netstandard1.3) (< netstandard1.4)) (&& (< monoandroid) (< net46) (>= netstandard1.4) (< netstandard1.6)) (&& (< monotouch) (< net46) (>= netstandard1.6) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (>= net46) (< netstandard1.4)) (&& (>= net461) (< netstandard1.6)) (>= net463) System.Text.Encoding (>= 4.3) - restriction: && (< monotouch) (< net46) (>= netstandard1.6) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) - System.Security.Cryptography.Cng (5.0) - restriction: || (&& (< net462) (>= netstandard2.0) (< netstandard2.1)) (&& (< net472) (>= netstandard2.0)) (>= net5.0) (&& (< net6.0) (>= netstandard2.1)) + System.Security.Cryptography.Cng (5.0) - restriction: || (&& (< net462) (>= netstandard2.0) (< netstandard2.1)) (&& (>= net5.0) (< net6.0)) (&& (>= net5.0) (< netstandard2.1)) (&& (< net6.0) (>= netstandard2.1)) Microsoft.NETCore.Platforms (>= 5.0) - restriction: && (< monoandroid) (>= netcoreapp2.0) (< netcoreapp2.1) (< netstandard2.1) (< xamarintvos) (< xamarinwatchos) System.Formats.Asn1 (>= 5.0) - restriction: && (>= netcoreapp3.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) - System.Security.Cryptography.Algorithms (>= 4.3.1) - restriction: || (&& (< monoandroid) (< monotouch) (< net46) (>= netstandard1.6) (< netstandard2.0) (< xamarintvos) (< xamarinwatchos)) (&& (< monoandroid) (< net46) (>= netstandard1.3) (< netstandard1.4)) (&& (< monoandroid) (< net46) (>= netstandard1.4) (< netstandard1.6) (< uap10.1)) (&& (>= net46) (< netstandard1.4)) (&& (>= net461) (< net462) (< netstandard1.6)) (&& (>= net462) (< netstandard1.6)) (>= net47) System.Security.Cryptography.Encoding (4.3) - restriction: || (&& (< net46) (>= netstandard2.0) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos)) (&& (< net461) (>= net463) (>= netstandard2.0)) Microsoft.NETCore.Platforms (>= 1.1) - restriction: && (< monoandroid) (< monotouch) (< net46) (>= netstandard1.3) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) runtime.native.System.Security.Cryptography.OpenSsl (>= 4.3) - restriction: && (< monoandroid) (< monotouch) (< net46) (>= netstandard1.3) (< xamarinios) (< xamarinmac) (< xamarintvos) (< xamarinwatchos) diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/Algorithms.fs b/src/GraphBLAS-sharp.Backend/Algorithms/Algorithms.fs index e412d186..66c49ccb 100644 --- a/src/GraphBLAS-sharp.Backend/Algorithms/Algorithms.fs +++ b/src/GraphBLAS-sharp.Backend/Algorithms/Algorithms.fs @@ -7,3 +7,38 @@ open GraphBLAS.FSharp.Backend.Algorithms module Algorithms = module BFS = let singleSource = BFS.singleSource + + let singleSourceSparse = BFS.singleSourceSparse + + let singleSourcePushPull = BFS.singleSourcePushPull + + module MSBFS = + let runLevels = MSBFS.Levels.run + + let runParents = MSBFS.Parents.run + + module SSSP = + let run = SSSP.run + + module PageRank = + type PageRankMatrix = PageRank.PageRankMatrix + + /// + /// Computes PageRank of the given matrix. + /// Matrix should be prepared in advance using "PageRank.prepareMatrix" method. + /// Accepts accuracy as a parameter which determines how many iterations will be performed. + /// Values of accuracy higher than 1e-06 are not recommended since the process may never stop. + /// + /// + /// + /// let preparedMatrix = PageRank.prepareMatrix clContext workGroupSize queue matrix + /// let accuracy = 1e-05 + /// let pageRank = PageRank.run clContext workGroupSize queue preparedMatrix accuracy + /// + /// + let run = PageRank.run + + /// + /// Converts matrix representing a graph to a format suitable for PageRank algorithm. + /// + let prepareMatrix = PageRank.prepareMatrix diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs b/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs index de7f0cc8..2b9a3a83 100644 --- a/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs +++ b/src/GraphBLAS-sharp.Backend/Algorithms/BFS.fs @@ -5,67 +5,221 @@ open FSharp.Quotations open GraphBLAS.FSharp open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Backend.Quotes -open GraphBLAS.FSharp.Backend.Vector.Dense -open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Objects.ClCellExtensions module internal BFS = let singleSource - (add: Expr int option -> int option>) - (mul: Expr<'a option -> int option -> int option>) + (add: Expr bool option -> bool option>) + (mul: Expr bool option -> bool option>) (clContext: ClContext) workGroupSize = - let spMVTo = - Operations.SpMVInplace add mul clContext workGroupSize + let spMVInPlace = + Operations.SpMVInPlace add mul clContext workGroupSize let zeroCreate = - ClArray.zeroCreate clContext workGroupSize + Vector.zeroCreate clContext workGroupSize let ofList = Vector.ofList clContext workGroupSize - let maskComplementedTo = + let maskComplementedInPlace = Vector.map2InPlace Mask.complementedOp clContext workGroupSize let fillSubVectorTo = - Vector.assignByMaskInPlace (Convert.assignToOption Mask.assign) clContext workGroupSize + Vector.assignByMaskInPlace Mask.assign clContext workGroupSize let containsNonZero = - ClArray.exists Predicates.isSome clContext workGroupSize + Vector.exists Predicates.isSome clContext workGroupSize + + fun (queue: RawCommandQueue) (matrix: ClMatrix) (source: int) -> + let vertexCount = matrix.RowCount + + let levels = + zeroCreate queue DeviceOnly vertexCount Dense + + let front = + ofList queue DeviceOnly Dense vertexCount [ source, true ] + + let mutable level = 0 + let mutable stop = false + + while not stop do + level <- level + 1 + + //Assigning new level values + fillSubVectorTo queue levels front level + + //Getting new frontier + spMVInPlace queue matrix front front + + maskComplementedInPlace queue front levels + + //Checking if front is empty + stop <- + not + <| (containsNonZero queue front).ToHostAndFree queue + + front.Dispose() + + levels - fun (queue: MailboxProcessor) (matrix: ClMatrix<'a>) (source: int) -> + let singleSourceSparse + (add: Expr bool option -> bool option>) + (mul: Expr bool option -> bool option>) + (clContext: ClContext) + workGroupSize + = + + let spMSpV = + Operations.SpMSpVBool add mul clContext workGroupSize + + let zeroCreate = + Vector.zeroCreate clContext workGroupSize + + let ofList = Vector.ofList clContext workGroupSize + + let maskComplemented = + Vector.map2Sparse Mask.complementedOp clContext workGroupSize + + let fillSubVectorTo = + Vector.assignByMaskInPlace Mask.assign clContext workGroupSize + + fun (queue: RawCommandQueue) (matrix: ClMatrix) (source: int) -> let vertexCount = matrix.RowCount - let levels = zeroCreate queue HostInterop vertexCount + let levels = + zeroCreate queue DeviceOnly vertexCount Dense + + let mutable front = + ofList queue DeviceOnly Sparse vertexCount [ source, true ] + + let mutable level = 0 + let mutable stop = false - let frontier = - ofList queue DeviceOnly Dense vertexCount [ source, 1 ] + while not stop do + level <- level + 1 - match frontier with - | ClVector.Dense front -> + //Assigning new level values + fillSubVectorTo queue levels front level - let mutable level = 0 - let mutable stop = false + //Getting new frontier + match spMSpV queue matrix front with + | None -> + front.Dispose() + stop <- true + | Some newFrontier -> + front.Dispose() + //Filtering visited vertices + match maskComplemented queue DeviceOnly newFrontier levels with + | None -> + stop <- true + newFrontier.Dispose() + | Some f -> + front <- f + newFrontier.Dispose() - while not stop do - level <- level + 1 + levels - //Assigning new level values - fillSubVectorTo queue levels front (clContext.CreateClCell level) levels + let singleSourcePushPull + (add: Expr bool option -> bool option>) + (mul: Expr bool option -> bool option>) + (clContext: ClContext) + workGroupSize + = + + let spMVInPlace = + Operations.SpMVInPlace add mul clContext workGroupSize + + let spMSpV = + Operations.SpMSpVMaskedBool add mul clContext workGroupSize + + let zeroCreate = + Vector.zeroCreate clContext workGroupSize + + let ofList = Vector.ofList clContext workGroupSize + + let maskComplementedInPlace = + Vector.map2InPlace Mask.complementedOp clContext workGroupSize + + let fillSubVectorInPlace = + Vector.assignByMaskInPlace (Mask.assign) clContext workGroupSize + + let toSparse = + Vector.toSparseUnsorted clContext workGroupSize + + let toDense = Vector.toDense clContext workGroupSize + + let countNNZ = + ClArray.count Predicates.isSome clContext workGroupSize + + //Push or pull functions + let getNNZ (queue: RawCommandQueue) (v: ClVector) = + match v with + | ClVector.Sparse v -> v.NNZ + | ClVector.Dense v -> countNNZ queue v + + let SPARSITY = 0.05f + + let push nnz size = + (float32 nnz) / (float32 size) <= SPARSITY + + fun (queue: RawCommandQueue) (matrix: ClMatrix) (source: int) -> + let vertexCount = matrix.RowCount + + let levels = + zeroCreate queue DeviceOnly vertexCount Dense + + let mutable frontier = + ofList queue DeviceOnly Sparse vertexCount [ source, true ] + + let mutable level = 0 + let mutable stop = false + + while not stop do + level <- level + 1 + + //Assigning new level values + fillSubVectorInPlace queue levels frontier level + + match frontier with + | ClVector.Sparse _ -> + //Getting new frontier + match spMSpV queue matrix frontier levels with + | None -> + frontier.Dispose() + stop <- true + | Some newMaskedFrontier -> + frontier.Dispose() + + //Push/pull + let NNZ = getNNZ queue newMaskedFrontier + + if (push NNZ newMaskedFrontier.Size) then + frontier <- newMaskedFrontier + else + frontier <- toDense queue DeviceOnly newMaskedFrontier + newMaskedFrontier.Dispose() + | ClVector.Dense oldFrontier -> //Getting new frontier - spMVTo queue matrix frontier frontier + spMVInPlace queue matrix frontier frontier + + maskComplementedInPlace queue frontier levels - maskComplementedTo queue front levels front + //Emptiness check + let NNZ = getNNZ queue frontier - //Checking if front is empty - stop <- - not - <| (containsNonZero queue front).ToHostAndFree queue + stop <- NNZ = 0 - front.Free queue + //Push/pull + if not stop then + if (push NNZ frontier.Size) then + frontier <- toSparse queue DeviceOnly frontier + oldFrontier.Free() + else + frontier.Dispose() - levels - | _ -> failwith "Not implemented" + levels diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/MSBFS.fs b/src/GraphBLAS-sharp.Backend/Algorithms/MSBFS.fs new file mode 100644 index 00000000..4a1c8522 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Algorithms/MSBFS.fs @@ -0,0 +1,265 @@ +namespace GraphBLAS.FSharp.Backend.Algorithms + +open Brahma.FSharp +open FSharp.Quotations +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Common +open GraphBLAS.FSharp.Objects.ClMatrix +open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ClCellExtensions +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Matrix.LIL +open GraphBLAS.FSharp.Backend.Matrix.COO + +module internal MSBFS = + let private frontExclude (clContext: ClContext) workGroupSize = + + let invert = + ClArray.mapInPlace ArithmeticOperations.intNotQ clContext workGroupSize + + let prefixSum = + Common.PrefixSum.standardExcludeInPlace clContext workGroupSize + + let scatterIndices = + Scatter.lastOccurrence clContext workGroupSize + + let scatterValues = + Scatter.lastOccurrence clContext workGroupSize + + fun (queue: RawCommandQueue) allocationMode (front: ClMatrix.COO<_>) (intersection: ClArray) -> + + invert queue intersection + + let length = + (prefixSum queue intersection).ToHostAndFree queue + + if length = 0 then + None + else + let rows = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, length) + + let columns = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, length) + + let values = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, length) + + scatterIndices queue intersection front.Rows rows + scatterIndices queue intersection front.Columns columns + scatterValues queue intersection front.Values values + + { Context = clContext + Rows = rows + Columns = columns + Values = values + RowCount = front.RowCount + ColumnCount = front.ColumnCount } + |> Some + + module Levels = + let private updateFrontAndLevels (clContext: ClContext) workGroupSize = + + let updateFront = frontExclude clContext workGroupSize + + let mergeDisjoint = + Matrix.mergeDisjoint clContext workGroupSize + + let setLevel = ClArray.fill clContext workGroupSize + + let findIntersection = + Intersect.findKeysIntersection clContext workGroupSize + + fun (queue: RawCommandQueue) allocationMode (level: int) (front: ClMatrix.COO<_>) (levels: ClMatrix.COO<_>) -> + + // Find intersection of levels and front indices. + let intersection = + findIntersection queue DeviceOnly front levels + + // Remove mutual elements + let newFront = + updateFront queue allocationMode front intersection + + intersection.Free() + + match newFront with + | Some f -> + let levelClCell = clContext.CreateClCell level + + // Set current level value to all remaining front positions + setLevel queue levelClCell 0 f.Values.Length f.Values + + levelClCell.Free() + + // Update levels + let newLevels = mergeDisjoint queue levels f + + newLevels, newFront + | _ -> levels, None + + let run<'a when 'a: struct> + (add: Expr int -> int option>) + (mul: Expr 'a -> int option>) + (clContext: ClContext) + workGroupSize + = + + let spGeMM = + Operations.SpGeMM.COO.expand add mul clContext workGroupSize + + let copy = Matrix.copy clContext workGroupSize + + let updateFrontAndLevels = + updateFrontAndLevels clContext workGroupSize + + fun (queue: RawCommandQueue) (matrix: ClMatrix<'a>) (source: int list) -> + let vertexCount = matrix.RowCount + let sourceVertexCount = source.Length + + let source = source |> List.sort + + let startMatrix = + source |> List.mapi (fun i vertex -> i, vertex, 1) + + let mutable levels = + startMatrix + |> Matrix.ofList clContext DeviceOnly sourceVertexCount vertexCount + + let mutable front = copy queue DeviceOnly levels + + let mutable level = 1 + let mutable stop = false + + while not stop do + level <- level + 1 + + //Getting new frontier + match spGeMM queue DeviceOnly (ClMatrix.COO front) matrix with + | None -> + front.Dispose() + stop <- true + + | Some newFrontier -> + front.Dispose() + + //Filtering visited vertices + match updateFrontAndLevels queue DeviceOnly level newFrontier levels with + | l, Some f -> + front <- f + + levels.Dispose() + + levels <- l + + newFrontier.Dispose() + + | _, None -> + stop <- true + newFrontier.Dispose() + + ClMatrix.COO levels + + module Parents = + let private updateFrontAndParents (clContext: ClContext) workGroupSize = + let frontExclude = frontExclude clContext workGroupSize + + let mergeDisjoint = + Matrix.mergeDisjoint clContext workGroupSize + + let findIntersection = + Intersect.findKeysIntersection clContext workGroupSize + + let copyIndices = ClArray.copyTo clContext workGroupSize + + fun (queue: RawCommandQueue) allocationMode (front: ClMatrix.COO<_>) (parents: ClMatrix.COO<_>) -> + + // Find intersection of levels and front indices. + let intersection = + findIntersection queue DeviceOnly front parents + + // Remove mutual elements + let newFront = + frontExclude queue allocationMode front intersection + + intersection.Free() + + match newFront with + | Some f -> + // Update parents + let newParents = mergeDisjoint queue parents f + + copyIndices queue f.Columns f.Values + + newParents, Some f + + | _ -> parents, None + + let run<'a when 'a: struct> (clContext: ClContext) workGroupSize = + + let spGeMM = + Operations.SpGeMM.COO.expand + (ArithmeticOperations.min) + (ArithmeticOperations.fst) + clContext + workGroupSize + + let updateFrontAndParents = + updateFrontAndParents clContext workGroupSize + + fun (queue: RawCommandQueue) (inputMatrix: ClMatrix<'a>) (source: int list) -> + let vertexCount = inputMatrix.RowCount + let sourceVertexCount = source.Length + + let source = source |> List.sort + + let matrix = + match inputMatrix with + | ClMatrix.CSR m -> + { Context = clContext + RowPointers = m.RowPointers + Columns = m.Columns + Values = m.Columns + RowCount = m.RowCount + ColumnCount = m.ColumnCount } + |> ClMatrix.CSR + | _ -> failwith "Incorrect format" + + let mutable parents = + source + |> List.mapi (fun i vertex -> i, vertex, -1) + |> Matrix.ofList clContext DeviceOnly sourceVertexCount vertexCount + + let mutable front = + source + |> List.mapi (fun i vertex -> i, vertex, vertex) + |> Matrix.ofList clContext DeviceOnly sourceVertexCount vertexCount + + let mutable stop = false + + while not stop do + //Getting new frontier + match spGeMM queue DeviceOnly (ClMatrix.COO front) matrix with + | None -> + front.Dispose() + stop <- true + + | Some newFrontier -> + front.Dispose() + + //Filtering visited vertices + match updateFrontAndParents queue DeviceOnly newFrontier parents with + | p, Some f -> + front <- f + + parents.Dispose() + parents <- p + + newFrontier.Dispose() + + | _, None -> + stop <- true + newFrontier.Dispose() + + ClMatrix.COO parents diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/PageRank.fs b/src/GraphBLAS-sharp.Backend/Algorithms/PageRank.fs new file mode 100644 index 00000000..a13d567a --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Algorithms/PageRank.fs @@ -0,0 +1,203 @@ +namespace GraphBLAS.FSharp.Backend.Algorithms + +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend +open Brahma.FSharp +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Vector.Dense +open GraphBLAS.FSharp.Objects.ClMatrix +open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.ClCellExtensions + +[] +module PageRank = + type PageRankMatrix = + | PreparedMatrix of ClMatrix + + member this.Dispose() = + match this with + | PreparedMatrix matrix -> matrix.Dispose() + + let private countOutDegree (clContext: ClContext) workGroupSize = + + let one = + <@ fun (x: float32 option) (_: int option) -> + let mutable res = 0 + + match x with + | Some _ -> res <- 1 + | None -> () + + if res = 0 then None else Some res @> + + let spMV = + Operations.SpMV.runTo ArithmeticOperations.intSumOption one clContext workGroupSize + + let zeroCreate = + GraphBLAS.FSharp.ClArray.zeroCreate clContext workGroupSize + + fun (queue: RawCommandQueue) (matrix: ClMatrix.CSR) -> + let outDegree: ClArray = + zeroCreate queue DeviceOnly matrix.ColumnCount + + spMV queue matrix outDegree outDegree + + outDegree + + let internal prepareMatrix (clContext: ClContext) workGroupSize = + + //Passing global variable to kernel in Brahma is not possible + let alpha = Constants.PageRank.alpha + + let op = + <@ fun (x: float32 option) y -> + let mutable res = None + + match x, y with + | Some _, Some y -> res <- Some(alpha / (float32 y)) + | _ -> () + + res @> + + //TODO: generalize to map2 Matrix x Vector + let multiply = + <@ fun (range: Range1D) (numberOfRows: int) (matrixRowPointers: ClArray) (matrixValues: ClArray) (vectorValues: ClArray) (resultMatrixValues: ClArray) -> + + let i = range.GlobalID0 + let li = range.LocalID0 + let group = i / workGroupSize + + if group < numberOfRows then + let rowStart = matrixRowPointers.[group] + let rowEnd = matrixRowPointers.[group + 1] + + let vectorValue = vectorValues.[group] + let mutable index = rowStart + li + + while index < rowEnd do + let matrixValue = matrixValues.[index] + let resultValue = (%op) (Some matrixValue) vectorValue + + match resultValue with + | Some v -> resultMatrixValues.[index] <- v + | None -> () //This should not be reachable + + index <- index + workGroupSize @> + + let countOutDegree = countOutDegree clContext workGroupSize + + let copy = + GraphBLAS.FSharp.ClArray.copy clContext workGroupSize + + let transposeInPlace = + Matrix.CSR.Matrix.transposeInPlace clContext workGroupSize + + let multiply = clContext.Compile multiply + + fun (queue: RawCommandQueue) (matrix: ClMatrix) -> + + match matrix with + | ClMatrix.CSR matrix -> + + let outDegree = countOutDegree queue matrix + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, matrix.Values.Length) + + let kernel = multiply.GetKernel() + + let ndRange = + Range1D.CreateValid(matrix.RowCount * workGroupSize, workGroupSize) + + kernel.KernelFunc ndRange matrix.RowCount matrix.RowPointers matrix.Values outDegree resultValues + + queue.RunKernel(kernel) + + outDegree.Free() + + let newMatrix = + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + RowPointers = copy queue DeviceOnly matrix.RowPointers matrix.RowPointers.Length + Columns = copy queue DeviceOnly matrix.Columns matrix.Columns.Length + Values = resultValues } + + transposeInPlace queue DeviceOnly newMatrix + |> ClMatrix.CSR + |> PreparedMatrix + | _ -> failwith "Not implemented" + + // PageRank algorithm explanation: pi.math.cornell.edu/~mec/Winter2009/RalucaRemus/Lecture3/lecture3 + let internal run (clContext: ClContext) workGroupSize = + + let squareOfDifference = ArithmeticOperations.squareOfDifference + let plus = ArithmeticOperations.float32SumOption + let mul = ArithmeticOperations.float32MulOption + + let spMVTo = + Operations.SpMVInPlace plus mul clContext workGroupSize + + let addToResult = + GraphBLAS.FSharp.Vector.map2InPlace plus clContext workGroupSize + + let subtractAndSquare = + GraphBLAS.FSharp.Vector.map2To squareOfDifference clContext workGroupSize + + let reduce = + GraphBLAS.FSharp.Vector.reduce <@ (+) @> clContext workGroupSize + + let create = + GraphBLAS.FSharp.Vector.create clContext workGroupSize + + fun (queue: RawCommandQueue) (PreparedMatrix matrix) accuracy -> + let vertexCount = matrix.RowCount + + //None is 0 + let mutable rank = + create queue DeviceOnly vertexCount Dense None + + let mutable prevRank = + create queue DeviceOnly vertexCount Dense (Some(1.0f / (float32 vertexCount))) + + let mutable errors = + create queue DeviceOnly vertexCount Dense None + + let addition = + create + queue + DeviceOnly + vertexCount + Dense + (Some( + (1.0f - Constants.PageRank.alpha) + / (float32 vertexCount) + )) + + let mutable error = accuracy + 0.1f + + let mutable i = 0 + + while error > accuracy do + i <- i + 1 + + // rank = matrix*rank + (1 - ALPHA)/N + spMVTo queue matrix prevRank rank + addToResult queue rank addition + + // error + subtractAndSquare queue rank prevRank errors + error <- sqrt <| (reduce queue errors).ToHostAndFree queue + + //Swap vectors + let temp = rank + rank <- prevRank + prevRank <- temp + + prevRank.Dispose() + errors.Dispose() + addition.Dispose() + + rank diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/PageRank.fsi b/src/GraphBLAS-sharp.Backend/Algorithms/PageRank.fsi new file mode 100644 index 00000000..1f95c19c --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Algorithms/PageRank.fsi @@ -0,0 +1,14 @@ +namespace GraphBLAS.FSharp.Backend.Algorithms + +open Brahma.FSharp +open GraphBLAS.FSharp.Objects + +[] +module PageRank = + [] + type PageRankMatrix = + member Dispose : unit -> unit + + val internal prepareMatrix : ClContext -> int -> (RawCommandQueue -> ClMatrix -> PageRankMatrix) + + val internal run : ClContext -> int -> (RawCommandQueue -> PageRankMatrix -> float32 -> ClVector) diff --git a/src/GraphBLAS-sharp.Backend/Algorithms/SSSP.fs b/src/GraphBLAS-sharp.Backend/Algorithms/SSSP.fs new file mode 100644 index 00000000..d7c80f96 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Algorithms/SSSP.fs @@ -0,0 +1,79 @@ +namespace GraphBLAS.FSharp.Backend.Algorithms + +open Brahma.FSharp +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ClCellExtensions + +module internal SSSP = + let run (clContext: ClContext) workGroupSize = + + let less = ArithmeticOperations.less + let min = ArithmeticOperations.minOption + let plus = ArithmeticOperations.intSumAsMul + + let spMVInPlace = + Operations.SpMVInPlace min plus clContext workGroupSize + + let create = ClArray.create clContext workGroupSize + + let ofList = Vector.ofList clContext workGroupSize + + let eWiseMulLess = + Vector.map2To less clContext workGroupSize + + let eWiseAddMin = + Vector.map2To min clContext workGroupSize + + let filter = + Vector.map2To Mask.op clContext workGroupSize + + let containsNonZero = + Vector.exists Predicates.isSome clContext workGroupSize + + fun (queue: RawCommandQueue) (matrix: ClMatrix) (source: int) -> + let vertexCount = matrix.RowCount + + //None is System.Int32.MaxValue + let distance = + ofList queue DeviceOnly Dense vertexCount [ source, 0 ] + + let mutable front1 = + ofList queue DeviceOnly Dense vertexCount [ source, 0 ] + + let mutable front2 = + create queue DeviceOnly vertexCount None + |> ClVector.Dense + + let mutable stop = false + + while not stop do + //Getting new frontier + spMVInPlace queue matrix front1 front2 + + //Checking which distances were updated + eWiseMulLess queue front2 distance front1 + //Updating + eWiseAddMin queue distance front2 distance + + //Filtering unproductive vertices + //Front1 is a mask + filter queue front2 front1 front2 + + //Swap fronts + let temp = front1 + front1 <- front2 + front2 <- temp + + //Checking if no distances were updated + stop <- + not + <| (containsNonZero queue front1) + .ToHostAndFree(queue) + + front1.Dispose() + front2.Dispose() + + distance diff --git a/src/GraphBLAS-sharp.Backend/Common/Bitmap.fs b/src/GraphBLAS-sharp.Backend/Common/Bitmap.fs new file mode 100644 index 00000000..8063e43a --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Common/Bitmap.fs @@ -0,0 +1,99 @@ +namespace GraphBLAS.FSharp.Backend.Common + +open Brahma.FSharp +open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Common.Map + +module Bitmap = + let private getUniqueBitmapGeneral predicate (clContext: ClContext) workGroupSize = + + let getUniqueBitmap = + <@ fun (ndRange: Range1D) (inputArray: ClArray<'a>) inputLength (isUniqueBitmap: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < inputLength then + let isUnique = (%predicate) gid inputLength inputArray // brahma error + + if isUnique then + isUniqueBitmap.[gid] <- 1 + else + isUniqueBitmap.[gid] <- 0 @> + + let kernel = clContext.Compile(getUniqueBitmap) + + fun (processor: RawCommandQueue) allocationMode (inputArray: ClArray<'a>) -> + + let inputLength = inputArray.Length + + let ndRange = + Range1D.CreateValid(inputLength, workGroupSize) + + let bitmap = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputLength) + + let kernel = kernel.GetKernel() + + kernel.KernelFunc ndRange inputArray inputLength bitmap + + processor.RunKernel kernel + + bitmap + + /// + /// Gets the bitmap that indicates the first elements of the sequences of consecutive identical elements + /// + /// OpenCL context. + let firstOccurrence clContext = + getUniqueBitmapGeneral + <| Predicates.firstOccurrence () + <| clContext + + /// + /// Gets the bitmap that indicates the last elements of the sequences of consecutive identical elements + /// + /// OpenCL context. + let lastOccurrence clContext = + getUniqueBitmapGeneral + <| Predicates.lastOccurrence () + <| clContext + + let private getUniqueBitmap2General<'a when 'a: equality> getUniqueBitmap (clContext: ClContext) workGroupSize = + + let map = + map2 <@ fun x y -> x ||| y @> clContext workGroupSize + + let firstGetBitmap = getUniqueBitmap clContext workGroupSize + + fun (processor: RawCommandQueue) allocationMode (firstArray: ClArray<'a>) (secondArray: ClArray<'a>) -> + let firstBitmap = + firstGetBitmap processor DeviceOnly firstArray + + let secondBitmap = + firstGetBitmap processor DeviceOnly secondArray + + let result = + map processor allocationMode firstBitmap secondBitmap + + firstBitmap.Free() + secondBitmap.Free() + + result + + /// + /// Gets the bitmap that indicates the first elements of the sequences + /// of consecutive identical elements from either first array or second array. + /// + /// OpenCL context. + let firstOccurrence2 clContext = + getUniqueBitmap2General firstOccurrence clContext + + /// + /// Gets the bitmap that indicates the last elements of the sequences + /// of consecutive identical elements from either first array or second array. + /// + /// OpenCL context. + let lastOccurrence2 clContext = + getUniqueBitmap2General lastOccurrence clContext diff --git a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs index c983415a..bc324850 100644 --- a/src/GraphBLAS-sharp.Backend/Common/ClArray.fs +++ b/src/GraphBLAS-sharp.Backend/Common/ClArray.fs @@ -28,7 +28,7 @@ module ClArray = let program = clContext.Compile(init) - fun (processor: MailboxProcessor<_>) allocationMode (length: int) -> + fun (processor: RawCommandQueue) allocationMode (length: int) -> let outputArray = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, length) @@ -37,8 +37,8 @@ module ClArray = let ndRange = Range1D.CreateValid(length, workGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange outputArray length)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc ndRange outputArray length + processor.RunKernel kernel outputArray @@ -59,7 +59,7 @@ module ClArray = let program = clContext.Compile(create) - fun (processor: MailboxProcessor<_>) allocationMode (length: int) (value: 'a) -> + fun (processor: RawCommandQueue) allocationMode (length: int) (value: 'a) -> let value = clContext.CreateClCell(value) let outputArray = @@ -70,9 +70,9 @@ module ClArray = let ndRange = Range1D.CreateValid(length, workGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange outputArray length value)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) - processor.Post(Msg.CreateFreeMsg(value)) + kernel.KernelFunc ndRange outputArray length value + processor.RunKernel kernel + value.Free() outputArray @@ -85,7 +85,7 @@ module ClArray = let create = create clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode length -> + fun (processor: RawCommandQueue) allocationMode length -> create processor allocationMode length Unchecked.defaultof<'a> /// @@ -95,330 +95,259 @@ module ClArray = /// Should be a power of 2 and greater than 1. let copy (clContext: ClContext) workGroupSize = let copy = - <@ fun (ndRange: Range1D) (inputArrayBuffer: ClArray<'a>) (outputArrayBuffer: ClArray<'a>) inputArrayLength -> + <@ fun (ndRange: Range1D) (inputArrayBuffer: ClArray<'a>) (outputArrayBuffer: ClArray<'a>) resultSize -> let i = ndRange.GlobalID0 - if i < inputArrayLength then + if i < resultSize then outputArrayBuffer.[i] <- inputArrayBuffer.[i] @> let program = clContext.Compile(copy) - fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (inputArray: ClArray<'a>) (resultSize: int) -> + if resultSize > inputArray.Length then + failwith "Result size is greater than input array size" + let ndRange = - Range1D.CreateValid(inputArray.Length, workGroupSize) + Range1D.CreateValid(resultSize, workGroupSize) let outputArray = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputArray.Length) + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultSize) let kernel = program.GetKernel() - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray outputArray inputArray.Length) - ) + kernel.KernelFunc ndRange inputArray outputArray resultSize - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.RunKernel kernel outputArray /// - /// Creates an array of the given size by replicating the values of the given initial array. + /// Copies all elements from source to destination array. /// /// OpenCL context. /// Should be a power of 2 and greater than 1. - let replicate (clContext: ClContext) workGroupSize = - - let replicate = - <@ fun (ndRange: Range1D) (inputArrayBuffer: ClArray<'a>) (outputArrayBuffer: ClArray<'a>) inputArrayLength outputArrayLength -> + let copyTo (clContext: ClContext) workGroupSize = + let copy = + <@ fun (ndRange: Range1D) (source: ClArray<'a>) (destination: ClArray<'a>) inputArrayLength -> let i = ndRange.GlobalID0 - if i < outputArrayLength then - outputArrayBuffer.[i] <- inputArrayBuffer.[i % inputArrayLength] @> - - let kernel = clContext.Compile(replicate) + if i < inputArrayLength then + destination.[i] <- source.[i] @> - fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) count -> - let outputArrayLength = inputArray.Length * count + let program = clContext.Compile(copy) - let outputArray = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, outputArrayLength) + fun (processor: RawCommandQueue) (source: ClArray<'a>) (destination: ClArray<'a>) -> + if source.Length <> destination.Length then + failwith "The source array length differs from the destination array length." let ndRange = - Range1D.CreateValid(outputArray.Length, workGroupSize) + Range1D.CreateValid(source.Length, workGroupSize) - let kernel = kernel.GetKernel() + let kernel = program.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange inputArray outputArray inputArray.Length outputArrayLength) - ) + kernel.KernelFunc ndRange source destination source.Length - processor.Post(Msg.CreateRunMsg<_, _> kernel) - - outputArray + processor.RunKernel kernel /// - /// Builds a new array whose elements are the results of applying the given function - /// to each of the elements of the array. + /// Creates an array of the given size by replicating the values of the given initial array. /// - /// The function to transform elements of the array. /// OpenCL context. /// Should be a power of 2 and greater than 1. - let map<'a, 'b> (op: Expr<'a -> 'b>) (clContext: ClContext) workGroupSize = + let replicate (clContext: ClContext) workGroupSize = - let map = - <@ fun (ndRange: Range1D) lenght (inputArray: ClArray<'a>) (result: ClArray<'b>) -> + let replicate = + <@ fun (ndRange: Range1D) (inputArrayBuffer: ClArray<'a>) (outputArrayBuffer: ClArray<'a>) inputArrayLength outputArrayLength -> - let gid = ndRange.GlobalID0 + let i = ndRange.GlobalID0 - if gid < lenght then - result.[gid] <- (%op) inputArray.[gid] @> + if i < outputArrayLength then + outputArrayBuffer.[i] <- inputArrayBuffer.[i % inputArrayLength] @> - let kernel = clContext.Compile map + let kernel = clContext.Compile(replicate) - fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (inputArray: ClArray<'a>) count -> + let outputArrayLength = inputArray.Length * count - let result = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputArray.Length) + let outputArray = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, outputArrayLength) let ndRange = - Range1D.CreateValid(inputArray.Length, workGroupSize) + Range1D.CreateValid(outputArray.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray.Length inputArray result)) + kernel.KernelFunc ndRange inputArray outputArray inputArray.Length outputArrayLength - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel - result + outputArray /// - /// Builds a new array whose elements are the results of applying the given function - /// to the corresponding pairs of values, where the first element of pair is from the given array - /// and the second element is the given value. + /// Removes duplicates form the given array. /// - /// The function to transform elements of the array. - /// OpenCL context. + /// Computational context /// Should be a power of 2 and greater than 1. - let mapWithValue<'a, 'b, 'c> (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b -> 'c>) = - - let map = - <@ fun (ndRange: Range1D) lenght (value: ClCell<'a>) (inputArray: ClArray<'b>) (result: ClArray<'c>) -> + /// Should be sorted. + let removeDuplications (clContext: ClContext) workGroupSize = + let sequential = + <@ fun (ndRange: Range1D) (length: int) (keys: ClArray<'a>) (resultKeys: ClArray<'a>) (resultCount: ClCell) -> let gid = ndRange.GlobalID0 - if gid < lenght then - result.[gid] <- (%op) value.Value inputArray.[gid] @> + if gid = 0 then + let mutable count = 0 + let mutable currentKey = keys.[0] - let kernel = clContext.Compile map + let mutable offset = 1 - fun (processor: MailboxProcessor<_>) allocationMode (value: 'a) (inputArray: ClArray<'b>) -> + while offset < length do + if keys.[offset] <> currentKey then + resultKeys.[count] <- currentKey + currentKey <- keys.[offset] + count <- count + 1 - let result = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputArray.Length) + offset <- offset + 1 - let valueClCell = value |> clContext.CreateClCell + resultKeys.[count] <- currentKey + resultCount.Value <- count + 1 @> - let ndRange = - Range1D.CreateValid(inputArray.Length, workGroupSize) + let maxWorkGroupSize = clContext.ClDevice.MaxWorkGroupSize - let kernel = kernel.GetKernel() + let small = + <@ fun (ndRange: Range1D) keysLength (keys: ClArray<'a>) (resultKeys: ClArray<'a>) (resultCount: ClCell) -> + let lid = ndRange.LocalID0 - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray.Length valueClCell inputArray result) - ) + let alignedSize = + (%ArithmeticOperations.ceilToPowerOfTwo) keysLength - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + let offsets = localArray maxWorkGroupSize - result + let mutable isUniqueKey = 0 - /// - /// Fills the third given array with the results of applying the given function - /// to the corresponding elements of the first two given arrays pairwise. - /// - /// - /// The first two input arrays must have the same lengths. - /// - /// The function to transform the pairs of the input elements. - /// OpenCL context. - /// Should be a power of 2 and greater than 1. - let map2InPlace<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c>) (clContext: ClContext) workGroupSize = + if lid < keysLength then + let is_neq = lid > 0 && keys.[lid] <> keys.[lid - 1] + let is_first = lid = 0 - let kernel = - <@ fun (ndRange: Range1D) length (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) (resultArray: ClArray<'c>) -> + if is_neq || is_first then + isUniqueKey <- 1 + else + isUniqueKey <- 0 - let gid = ndRange.GlobalID0 + offsets.[lid] <- isUniqueKey - if gid < length then + let mutable offset = 1 - resultArray.[gid] <- (%map) leftArray.[gid] rightArray.[gid] @> + while offset < alignedSize do + barrierLocal () + let mutable value = offsets.[lid] - let kernel = clContext.Compile kernel + if (offset <= lid) then + value <- value + offsets.[lid - offset] - fun (processor: MailboxProcessor<_>) (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) (resultArray: ClArray<'c>) -> + barrierLocal () + offsets.[lid] <- value + offset <- offset * 2 - let ndRange = - Range1D.CreateValid(resultArray.Length, workGroupSize) + barrierLocal () - let kernel = kernel.GetKernel() + let n_values = offsets.[keysLength - 1] - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange resultArray.Length leftArray rightArray resultArray) - ) + if lid < n_values then + let id = lid + 1 - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + let start_idx = + (%Search.Bin.lowerPositionLocal) keysLength id offsets - /// - /// Builds a new array whose elements are the results of applying the given function - /// to the corresponding elements of the two given arrays pairwise. - /// - /// - /// The two input arrays must have the same lengths. - /// - /// The function to transform the pairs of the input elements. - /// OpenCL context. - /// Should be a power of 2 and greater than 1. - let map2<'a, 'b, 'c> map (clContext: ClContext) workGroupSize = - let map2 = - map2InPlace<'a, 'b, 'c> map clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) -> + match start_idx with + | Some idx -> resultKeys.[lid] <- keys.[idx] + | None -> () - let resultArray = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, leftArray.Length) + if lid = 0 then + resultCount.Value <- n_values @> - map2 processor leftArray rightArray resultArray + let sequential = clContext.Compile sequential + let small = clContext.Compile small - resultArray + let copy = copy clContext workGroupSize - module Bitmap = - let private getUniqueBitmapGeneral predicate (clContext: ClContext) workGroupSize = - - let getUniqueBitmap = - <@ fun (ndRange: Range1D) (inputArray: ClArray<'a>) inputLength (isUniqueBitmap: ClArray) -> + let scatter = + Scatter.lastOccurrence clContext workGroupSize - let gid = ndRange.GlobalID0 + let getUniqueBitmap = + Bitmap.lastOccurrence clContext workGroupSize - if gid < inputLength then - let isUnique = (%predicate) gid inputLength inputArray // brahma error + let prefixSumExclude = + ScanInternal.standardExcludeInPlace clContext workGroupSize - if isUnique then - isUniqueBitmap.[gid] <- 1 - else - isUniqueBitmap.[gid] <- 0 @> + let sequentialSwitch = 32 + let smallSwitch = maxWorkGroupSize - let kernel = clContext.Compile(getUniqueBitmap) + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) -> - fun (processor: MailboxProcessor<_>) allocationMode (inputArray: ClArray<'a>) -> + let inputLength = inputArray.Length - let inputLength = inputArray.Length + if inputLength = 1 then + copy processor DeviceOnly inputArray 1 + elif inputLength <= sequentialSwitch then + let resultLength = clContext.CreateClCell() - let ndRange = - Range1D.CreateValid(inputLength, workGroupSize) + let temp = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, inputLength) - let bitmap = - clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputLength) + let kernel = sequential.GetKernel() - let kernel = kernel.GetKernel() + let ndRange = Range1D.CreateValid(1, maxWorkGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange inputArray inputLength bitmap)) + kernel.KernelFunc ndRange inputArray.Length inputArray temp resultLength - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.RunKernel kernel - bitmap + let result = + copy processor DeviceOnly temp (resultLength.ToHostAndFree processor) - /// - /// Gets the bitmap that indicates the first elements of the sequences of consecutive identical elements - /// - /// OpenCL context. - let firstOccurrence clContext = - getUniqueBitmapGeneral - <| Predicates.firstOccurrence () - <| clContext + temp.Free() - /// - /// Gets the bitmap that indicates the last elements of the sequences of consecutive identical elements - /// - /// OpenCL context. - let lastOccurrence clContext = - getUniqueBitmapGeneral - <| Predicates.lastOccurrence () - <| clContext + result + else if inputLength <= smallSwitch then + let resultLength = clContext.CreateClCell() - let private getUniqueBitmap2General<'a when 'a: equality> getUniqueBitmap (clContext: ClContext) workGroupSize = + let temp = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, inputLength) - let map = - map2 <@ fun x y -> x ||| y @> clContext workGroupSize + let kernel = small.GetKernel() - let firstGetBitmap = getUniqueBitmap clContext workGroupSize + let ndRange = + Range1D.CreateValid(inputLength, maxWorkGroupSize) - fun (processor: MailboxProcessor<_>) allocationMode (firstArray: ClArray<'a>) (secondArray: ClArray<'a>) -> - let firstBitmap = - firstGetBitmap processor DeviceOnly firstArray + kernel.KernelFunc ndRange inputArray.Length inputArray temp resultLength - let secondBitmap = - firstGetBitmap processor DeviceOnly secondArray + processor.RunKernel kernel let result = - map processor allocationMode firstBitmap secondBitmap + copy processor DeviceOnly temp (resultLength.ToHostAndFree processor) - firstBitmap.Free processor - secondBitmap.Free processor + temp.Free() result + else + let bitmap = + getUniqueBitmap processor DeviceOnly inputArray - /// - /// Gets the bitmap that indicates the first elements of the sequences - /// of consecutive identical elements from either first array or second array. - /// - /// OpenCL context. - let firstOccurrence2 clContext = - getUniqueBitmap2General firstOccurrence clContext - - /// - /// Gets the bitmap that indicates the last elements of the sequences - /// of consecutive identical elements from either first array or second array. - /// - /// OpenCL context. - let lastOccurrence2 clContext = - getUniqueBitmap2General lastOccurrence clContext - - /// - /// Removes duplicates form the given array. - /// - /// Computational context - /// Should be a power of 2 and greater than 1. - /// Should be sorted. - let removeDuplications (clContext: ClContext) workGroupSize = - - let scatter = - Scatter.lastOccurrence clContext workGroupSize - - let getUniqueBitmap = - Bitmap.lastOccurrence clContext workGroupSize - - let prefixSumExclude = - PrefixSum.runExcludeInPlace <@ (+) @> clContext workGroupSize + let resultLength = + (prefixSumExclude processor bitmap) + .ToHostAndFree(processor) - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> + let outputArray = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - let bitmap = - getUniqueBitmap processor DeviceOnly inputArray + scatter processor bitmap inputArray outputArray - let resultLength = - (prefixSumExclude processor bitmap 0) - .ToHostAndFree(processor) + bitmap.Free() - let outputArray = - clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) - - scatter processor bitmap inputArray outputArray - - processor.Post <| Msg.CreateFreeMsg<_>(bitmap) - - outputArray + outputArray /// /// Tests if any element of the array satisfies the given predicate. @@ -433,14 +362,14 @@ module ClArray = let gid = ndRange.GlobalID0 - if gid < length then + if gid < length && not result.Value then let isExist = (%predicate) vector.[gid] if isExist then result.Value <- true @> let kernel = clContext.Compile exists - fun (processor: MailboxProcessor<_>) (vector: ClArray<'a>) -> + fun (processor: RawCommandQueue) (vector: ClArray<'a>) -> let result = clContext.CreateClCell false @@ -449,9 +378,9 @@ module ClArray = let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange vector.Length vector result)) + kernel.KernelFunc ndRange vector.Length vector result - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel result @@ -482,22 +411,19 @@ module ClArray = let kernel = clContext.Compile assign - fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (positions: ClArray) (result: ClArray<'b>) -> + fun (processor: RawCommandQueue) (values: ClArray<'a>) (positions: ClArray) (result: ClArray<'b>) -> if values.Length <> positions.Length then - failwith "lengths must be the same" + failwith "Lengths must be the same" let ndRange = Range1D.CreateValid(values.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange values.Length values positions result result.Length) - ) + kernel.KernelFunc ndRange values.Length values positions result result.Length - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel /// /// Applies the given function to each element of the array. @@ -509,15 +435,15 @@ module ClArray = /// Should be a power of 2 and greater than 1. let choose<'a, 'b> (predicate: Expr<'a -> 'b option>) (clContext: ClContext) workGroupSize = let getBitmap = - map<'a, int> (Map.chooseBitmap predicate) clContext workGroupSize + Map.map<'a, int> (Map.chooseBitmap predicate) clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInPlace clContext workGroupSize + ScanInternal.standardExcludeInPlace clContext workGroupSize let assignValues = assignOption predicate clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (sourceValues: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (sourceValues: ClArray<'a>) -> let positions = getBitmap processor DeviceOnly sourceValues @@ -527,7 +453,7 @@ module ClArray = .ToHostAndFree(processor) if resultLength = 0 then - positions.Free processor + positions.Free() None else @@ -536,7 +462,7 @@ module ClArray = assignValues processor sourceValues positions result - positions.Free processor + positions.Free() Some result @@ -569,31 +495,20 @@ module ClArray = let kernel = clContext.Compile assign - fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (positions: ClArray) (result: ClArray<'c>) -> + fun (processor: RawCommandQueue) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (positions: ClArray) (result: ClArray<'c>) -> if firstValues.Length <> secondValues.Length || secondValues.Length <> positions.Length then - failwith "lengths must be the same" + failwith "Lengths must be the same" let ndRange = Range1D.CreateValid(firstValues.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - firstValues.Length - firstValues - secondValues - positions - result - result.Length) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc ndRange firstValues.Length firstValues secondValues positions result result.Length + + processor.RunKernel kernel /// /// Applies the given function to each pair of elements of the two given arrays. @@ -605,15 +520,15 @@ module ClArray = /// Should be a power of 2 and greater than 1. let choose2 (predicate: Expr<'a -> 'b -> 'c option>) (clContext: ClContext) workGroupSize = let getBitmap = - map2<'a, 'b, int> (Map.choose2Bitmap predicate) clContext workGroupSize + Map.map2<'a, 'b, int> (Map.choose2Bitmap predicate) clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInPlace clContext workGroupSize + ScanInternal.standardExcludeInPlace clContext workGroupSize let assignValues = assignOption2 predicate clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) -> + fun (processor: RawCommandQueue) allocationMode (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) -> let positions = getBitmap processor DeviceOnly firstValues secondValues @@ -648,7 +563,7 @@ module ClArray = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) allocationMode (sourceArray: ClArray<'a>) startIndex count -> + fun (processor: RawCommandQueue) allocationMode (sourceArray: ClArray<'a>) startIndex count -> if count <= 0 then failwith "Count must be greater than zero" @@ -666,9 +581,9 @@ module ClArray = let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange startIndex count sourceArray result)) + kernel.KernelFunc ndRange startIndex count sourceArray result - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel result @@ -684,7 +599,7 @@ module ClArray = let sub = sub clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode chunkSize (sourceArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode chunkSize (sourceArray: ClArray<'a>) -> if chunkSize <= 0 then failwith "The size of the chunk cannot be less than 1" @@ -711,7 +626,7 @@ module ClArray = let chunkBySizeLazy = lazyChunkBySize clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode chunkSize (sourceArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode chunkSize (sourceArray: ClArray<'a>) -> chunkBySizeLazy processor allocationMode chunkSize sourceArray |> Seq.map (fun lazyValue -> lazyValue.Value) |> Seq.toArray @@ -736,7 +651,7 @@ module ClArray = let kernel = clContext.Compile assign - fun (processor: MailboxProcessor<_>) (sourceArray: ClArray<'a>) sourceIndex (targetArray: ClArray<'a>) targetIndex count -> + fun (processor: RawCommandQueue) (sourceArray: ClArray<'a>) sourceIndex (targetArray: ClArray<'a>) targetIndex count -> if count = 0 then // nothing to do () @@ -757,12 +672,9 @@ module ClArray = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange sourceIndex sourceArray targetArray targetIndex count) - ) + kernel.KernelFunc ndRange sourceIndex sourceArray targetArray targetIndex count - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel /// /// Builds a new array that contains the elements of each of the given sequence of arrays. @@ -773,7 +685,7 @@ module ClArray = let blit = blit clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (sourceArrays: ClArray<'a> seq) -> + fun (processor: RawCommandQueue) allocationMode (sourceArrays: ClArray<'a> seq) -> let resultLength = sourceArrays @@ -811,7 +723,7 @@ module ClArray = let kernel = clContext.Compile fill - fun (processor: MailboxProcessor<_>) value firstPosition count (targetArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) value firstPosition count (targetArray: ClArray<'a>) -> if count = 0 then () else @@ -826,11 +738,9 @@ module ClArray = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange firstPosition count value targetArray) - ) + kernel.KernelFunc ndRange firstPosition count value targetArray - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel /// /// Returns an array of each element in the input array and its predecessor, @@ -847,9 +757,9 @@ module ClArray = Gather.runInit Map.inc clContext workGroupSize let map = - map2 <@ fun first second -> (first, second) @> clContext workGroupSize + Map.map2 <@ fun first second -> (first, second) @> clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (values: ClArray<'a>) -> if values.Length > 1 then let resultLength = values.Length - 1 @@ -866,8 +776,8 @@ module ClArray = let result = map processor allocationMode firstItems secondItems - firstItems.Free processor - secondItems.Free processor + firstItems.Free() + secondItems.Free() Some result else @@ -891,7 +801,7 @@ module ClArray = let program = clContext.Compile(kernel) - fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (value: ClCell<'a>) -> + fun (processor: RawCommandQueue) (values: ClArray<'a>) (value: ClCell<'a>) -> let result = clContext.CreateClCell Unchecked.defaultof<'b> @@ -899,8 +809,8 @@ module ClArray = let ndRange = Range1D.CreateValid(1, workGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange values.Length values value result)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc ndRange values.Length values value result + processor.RunKernel kernel result @@ -942,7 +852,7 @@ module ClArray = let program = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (index: int) (array: ClArray<'a>) -> + fun (processor: RawCommandQueue) (index: int) (array: ClArray<'a>) -> if index < 0 || index >= array.Length then failwith "Index out of range" @@ -954,8 +864,8 @@ module ClArray = let ndRange = Range1D.CreateValid(1, workGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange index array result)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc ndRange index array result + processor.RunKernel kernel result @@ -976,7 +886,7 @@ module ClArray = let program = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) (index: int) (value: 'a) -> + fun (processor: RawCommandQueue) (array: ClArray<'a>) (index: int) (value: 'a) -> if index < 0 || index >= array.Length then failwith "Index out of range" @@ -987,5 +897,132 @@ module ClArray = let ndRange = Range1D.CreateValid(1, workGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange index array value)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc ndRange index array value + processor.RunKernel kernel + + let count<'a> (predicate: Expr<'a -> bool>) (clContext: ClContext) workGroupSize = + + let count = + <@ fun (ndRange: Range1D) (length: int) (array: ClArray<'a>) (count: ClCell) -> + let gid = ndRange.GlobalID0 + let mutable countLocal = 0 + let step = ndRange.GlobalWorkSize + + let mutable i = gid + + while i < length do + let res = (%predicate) array.[i] + if res then countLocal <- countLocal + 1 + i <- i + step + + atomic (+) count.Value countLocal |> ignore @> + + let count = clContext.Compile count + + fun (processor: RawCommandQueue) (array: ClArray<'a>) -> + + let result = clContext.CreateClCell(0) + + let numberOfGroups = + Utils.divUpClamp array.Length workGroupSize 1 1024 + + let ndRange = + Range1D.CreateValid(workGroupSize * numberOfGroups, workGroupSize) + + let kernel = count.GetKernel() + + kernel.KernelFunc ndRange array.Length array result + + processor.RunKernel kernel + + result.ToHostAndFree processor + + /// + /// Builds a new array whose elements are the results of applying the given function + /// to each of the elements of the array. + /// + /// The function to transform elements of the array. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map<'a, 'b> (op: Expr<'a -> 'b>) (clContext: ClContext) workGroupSize = Map.map op clContext workGroupSize + + /// + /// Builds a new array whose elements are the results of applying the given function + /// to each of the elements of the array. + /// + /// The function to transform elements of the array. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let mapInPlace<'a> (op: Expr<'a -> 'a>) (clContext: ClContext) workGroupSize = + Map.mapInPlace op clContext workGroupSize + + /// + /// Builds a new array whose elements are the results of applying the given function + /// to the corresponding pairs of values, where the first element of pair is from the given array + /// and the second element is the given value. + /// + /// The function to transform elements of the array. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let mapWithValue<'a, 'b, 'c> (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b -> 'c>) = + Map.mapWithValue clContext workGroupSize op + + /// + /// Builds a new array whose elements are the results of applying the given function + /// to the corresponding elements of the two given arrays pairwise. + /// + /// + /// The two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c>) (clContext: ClContext) workGroupSize = + Map.map2 map clContext workGroupSize + + /// + /// Fills the third given array with the results of applying the given function + /// to the corresponding elements of the first two given arrays pairwise. + /// + /// + /// The first two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2InPlace<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c>) (clContext: ClContext) workGroupSize = + Map.map2InPlace map clContext workGroupSize + + /// + /// Excludes elements, pointed by the bitmap. + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let excludeElements (clContext: ClContext) workGroupSize = + + let invert = + mapInPlace ArithmeticOperations.intNotQ clContext workGroupSize + + let prefixSum = + ScanInternal.standardExcludeInPlace clContext workGroupSize + + let scatter = + Scatter.lastOccurrence clContext workGroupSize + + fun (queue: RawCommandQueue) allocationMode (excludeBitmap: ClArray) (inputArray: ClArray<'a>) -> + + invert queue excludeBitmap + + let length = + (prefixSum queue excludeBitmap) + .ToHostAndFree queue + + if length = 0 then + None + else + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, length) + + scatter queue excludeBitmap inputArray result + + Some result diff --git a/src/GraphBLAS-sharp.Backend/Common/Common.fs b/src/GraphBLAS-sharp.Backend/Common/Common.fs index 53777d33..852da1c4 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Common.fs @@ -7,10 +7,29 @@ open GraphBLAS.FSharp.Backend.Common module Common = module Sort = module Bitonic = + /// + /// Sorts in-place input array of values by their indices, + /// which are stored in two given arrays of keys: rows and columns. + /// When comparing, it first looks at rows, then columns. + /// Note that maximum possible workGroupSize is used internally for better perfomance. + /// + /// + /// + /// let keys = [| 0; 0; 3; 2; 1; 0; 5 |] + /// let values = [| 1.9; 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; |] + /// sortKeyValuesInplace clContext 32 processor rows columns values + /// ... + /// > val keys = [| 0; 0; 0; 1; 2; 3; 5 |] + /// > val values = [| 1.9; 2.8; 6.4; 5.5; 4.6; 3.7; 7.3 |] + /// + /// + let sortKeyValuesInplace<'a> = Sort.Bitonic.sortKeyValuesInplace<'a> + /// /// Sorts in-place input array of values by their 2d indices, /// which are stored in two given arrays of keys: rows and columns. /// When comparing, it first looks at rows, then columns. + /// Note that maximum possible workGroupSize is used internally for better perfomance. /// /// /// @@ -24,8 +43,8 @@ module Common = /// > val values = [| 1.9; 2.8; 6.4; 5.5; 4.6; 3.7; 7.3 |] /// /// - let sortKeyValuesInplace<'n, 'a when 'n: comparison> = - Sort.Bitonic.sortKeyValuesInplace<'n, 'a> + let sortRowsColumnsValuesInplace<'a> = + Sort.Bitonic.sortRowsColumnsValuesInplace<'a> module Radix = /// @@ -43,6 +62,20 @@ module Common = /// let runByKeysStandard = Sort.Radix.runByKeysStandard + /// + /// Sorts stable input array of values by given integer keys and return only values. + /// + /// + /// + /// let keys = [| 0; 4; 3; 1; 2; 6; 5 |] + /// let values = [| 1.9; 2.8; 3.7; 4.6; 5.5; 6.4; 7.3; |] + /// runByKeysStandard clContext 32 processor keys values + /// ... + /// > val values = [| 1.9; 4.6; 5.5; 3.7; 2.8; 7.3; 6.4 |] + /// + /// + let runByKeysStandardValuesOnly = Sort.Radix.runByKeysStandardValuesOnly + /// /// Sorts stable input array of integer keys. /// @@ -197,7 +230,7 @@ module Common = /// Should be a power of 2 and greater than 1. /// Associative binary operation. /// Zero element for binary operation. - let runExcludeInPlace plus = PrefixSum.runExcludeInPlace plus + let runExcludeInPlace plus = ScanInternal.runExcludeInPlace plus /// /// Include in-place prefix sum. @@ -217,7 +250,8 @@ module Common = /// ClContext. /// Should be a power of 2 and greater than 1. /// Zero element for binary operation. - let runIncludeInPlace plus = PrefixSum.runIncludeInPlace plus + let runIncludeInPlace plus = + PrefixSumInternal.runIncludeInPlace plus /// /// Exclude in-place prefix sum. Array is scanned starting from the end. @@ -227,7 +261,7 @@ module Common = /// Should be a power of 2 and greater than 1. /// Zero element for binary operation. let runBackwardsExcludeInPlace plus = - PrefixSum.runBackwardsExcludeInPlace plus + PrefixSumInternal.runBackwardsExcludeInPlace plus /// /// Include in-place prefix sum. Array is scanned starting from the end. @@ -237,7 +271,7 @@ module Common = /// Should be a power of 2 and greater than 1. /// Zero element for binary operation. let runBackwardsIncludeInPlace plus = - PrefixSum.runBackwardsIncludeInPlace plus + PrefixSumInternal.runBackwardsIncludeInPlace plus /// /// Exclude in-place prefix sum of integer array with addition operation and start value that is equal to 0. @@ -253,7 +287,7 @@ module Common = /// > val sum = [| 4 |] /// /// - let standardExcludeInPlace = PrefixSum.standardExcludeInPlace + let standardExcludeInPlace = ScanInternal.standardExcludeInPlace /// /// Include in-place prefix sum of integer array with addition operation and start value that is equal to 0. @@ -271,7 +305,7 @@ module Common = /// /// ClContext. /// Should be a power of 2 and greater than 1. - let standardIncludeInPlace = PrefixSum.standardIncludeInPlace + let standardIncludeInPlace = PrefixSumInternal.standardIncludeInPlace module ByKey = /// @@ -285,7 +319,8 @@ module Common = /// > val result = [| 0; 0; 1; 2; 0; 1 |] /// /// - let sequentialExclude op = PrefixSum.ByKey.sequentialExclude op + let sequentialExclude op = + PrefixSumInternal.ByKey.sequentialExclude op /// /// Include scan by key. @@ -298,7 +333,8 @@ module Common = /// > val result = [| 1; 1; 2; 3; 1; 2 |] /// /// - let sequentialInclude op = PrefixSum.ByKey.sequentialInclude op + let sequentialInclude op = + PrefixSumInternal.ByKey.sequentialInclude op module Reduce = /// @@ -371,8 +407,27 @@ module Common = /// /// The length of the result must be calculated in advance. /// - let segmentSequential<'a> (reduceOp: Expr<'a -> 'a -> 'a option>) (clContext: ClContext) workGroupSize = + let segmentSequential<'a> + (reduceOp: Expr<'a option -> 'a option -> 'a option>) + (clContext: ClContext) + workGroupSize + = Reduce.ByKey.Option.segmentSequential reduceOp clContext workGroupSize + /// + /// 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 and offsets for each segment must be calculated in advance. + /// + let segmentSequentialByOffsets<'a> + (reduceOp: Expr<'a -> 'a -> 'a option>) + (clContext: ClContext) + workGroupSize + = + Reduce.ByKey.Option.segmentSequentialByOffsets reduceOp clContext workGroupSize module ByKey2D = /// diff --git a/src/GraphBLAS-sharp.Backend/Common/Gather.fs b/src/GraphBLAS-sharp.Backend/Common/Gather.fs index 32d90859..dbcaf382 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Gather.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Gather.fs @@ -34,16 +34,16 @@ module Gather = let program = clContext.Compile gather - fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> let kernel = program.GetKernel() let ndRange = Range1D.CreateValid(outputArray.Length, workGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange values.Length values outputArray)) + kernel.KernelFunc ndRange values.Length values outputArray - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel /// /// Fills the given output array using the given value and position arrays. Array of positions indicates @@ -76,7 +76,7 @@ module Gather = let program = clContext.Compile gather - fun (processor: MailboxProcessor<_>) (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) (positions: ClArray) (values: ClArray<'a>) (outputArray: ClArray<'a>) -> if positions.Length <> outputArray.Length then failwith "Lengths must be the same" @@ -86,9 +86,6 @@ module Gather = let ndRange = Range1D.CreateValid(positions.Length, workGroupSize) - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange positions.Length values.Length positions values outputArray) - ) + kernel.KernelFunc ndRange positions.Length values.Length positions values outputArray - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel diff --git a/src/GraphBLAS-sharp.Backend/Common/Map.fs b/src/GraphBLAS-sharp.Backend/Common/Map.fs new file mode 100644 index 00000000..9e0cacea --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Common/Map.fs @@ -0,0 +1,169 @@ +namespace GraphBLAS.FSharp.Backend.Common + +open Brahma.FSharp +open Microsoft.FSharp.Quotations +open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ClCellExtensions + +module Map = + /// + /// Builds a new array whose elements are the results of applying the given function + /// to each of the elements of the array. + /// + /// The function to transform elements of the array. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map<'a, 'b> (op: Expr<'a -> 'b>) (clContext: ClContext) workGroupSize = + + let map = + <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) (result: ClArray<'b>) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + result.[gid] <- (%op) inputArray.[gid] @> + + let kernel = clContext.Compile map + + fun (processor: RawCommandQueue) allocationMode (inputArray: ClArray<'a>) -> + + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputArray.Length) + + let ndRange = + Range1D.CreateValid(inputArray.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + kernel.KernelFunc ndRange inputArray.Length inputArray result + + processor.RunKernel kernel + + result + + /// + /// Changes elements of the input array, applying the given function + /// to each element of the array. + /// + /// The function to transform elements of the array. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let mapInPlace<'a> (op: Expr<'a -> 'a>) (clContext: ClContext) workGroupSize = + + let map = + <@ fun (ndRange: Range1D) length (inputArray: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + inputArray.[gid] <- (%op) inputArray.[gid] @> + + let kernel = clContext.Compile map + + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) -> + + let ndRange = + Range1D.CreateValid(inputArray.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + kernel.KernelFunc ndRange inputArray.Length inputArray + + processor.RunKernel kernel + + /// + /// Builds a new array whose elements are the results of applying the given function + /// to the corresponding pairs of values, where the first element of pair is from the given array + /// and the second element is the given value. + /// + /// The function to transform elements of the array. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let mapWithValue<'a, 'b, 'c> (clContext: ClContext) workGroupSize (op: Expr<'a -> 'b -> 'c>) = + + let map = + <@ fun (ndRange: Range1D) length (value: ClCell<'a>) (inputArray: ClArray<'b>) (result: ClArray<'c>) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + result.[gid] <- (%op) value.Value inputArray.[gid] @> + + let kernel = clContext.Compile map + + fun (processor: RawCommandQueue) allocationMode (value: 'a) (inputArray: ClArray<'b>) -> + + let result = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, inputArray.Length) + + let valueClCell = value |> clContext.CreateClCell + + let ndRange = + Range1D.CreateValid(inputArray.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + kernel.KernelFunc ndRange inputArray.Length valueClCell inputArray result + + processor.RunKernel kernel + + valueClCell.Free() + + result + + /// + /// Fills the third given array with the results of applying the given function + /// to the corresponding elements of the first two given arrays pairwise. + /// + /// + /// The first two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2InPlace<'a, 'b, 'c> (map: Expr<'a -> 'b -> 'c>) (clContext: ClContext) workGroupSize = + + let kernel = + <@ fun (ndRange: Range1D) length (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) (resultArray: ClArray<'c>) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + + resultArray.[gid] <- (%map) leftArray.[gid] rightArray.[gid] @> + + let kernel = clContext.Compile kernel + + fun (processor: RawCommandQueue) (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) (resultArray: ClArray<'c>) -> + + let ndRange = + Range1D.CreateValid(resultArray.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + kernel.KernelFunc ndRange resultArray.Length leftArray rightArray resultArray + + processor.RunKernel kernel + + /// + /// Builds a new array whose elements are the results of applying the given function + /// to the corresponding elements of the two given arrays pairwise. + /// + /// + /// The two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2<'a, 'b, 'c> map (clContext: ClContext) workGroupSize = + let map2 = + map2InPlace<'a, 'b, 'c> map clContext workGroupSize + + fun (processor: RawCommandQueue) allocationMode (leftArray: ClArray<'a>) (rightArray: ClArray<'b>) -> + + let resultArray = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, leftArray.Length) + + map2 processor leftArray rightArray resultArray + + resultArray diff --git a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs index a56af91f..31ac8e88 100644 --- a/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/PrefixSum.fs @@ -6,7 +6,7 @@ open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Objects.ArraysExtensions open GraphBLAS.FSharp.Objects.ClCellExtensions -module PrefixSum = +module internal PrefixSumInternal = let private update (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize = let update = @@ -25,7 +25,7 @@ module PrefixSum = let program = clContext.Compile(update) - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) (inputArrayLength: int) (vertices: ClArray<'a>) (bunchLength: int) (mirror: bool) -> + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) (inputArrayLength: int) (vertices: ClArray<'a>) (bunchLength: int) (mirror: bool) -> let kernel = program.GetKernel() @@ -34,13 +34,10 @@ module PrefixSum = let mirror = clContext.CreateClCell mirror - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange inputArrayLength bunchLength inputArray vertices mirror) - ) + kernel.KernelFunc ndRange inputArrayLength bunchLength inputArray vertices mirror - processor.Post(Msg.CreateRunMsg<_, _> kernel) - mirror.Free processor + processor.RunKernel kernel + mirror.Free() let private scanGeneral beforeLocalSumClear @@ -93,7 +90,7 @@ module PrefixSum = let program = clContext.Compile(scan) - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) (inputArrayLength: int) (vertices: ClArray<'a>) (verticesLength: int) (totalSum: ClCell<'a>) (zero: 'a) (mirror: bool) -> + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) (inputArrayLength: int) (vertices: ClArray<'a>) (verticesLength: int) (totalSum: ClCell<'a>) (zero: 'a) (mirror: bool) -> // TODO: передавать zero как константу let zero = clContext.CreateClCell(zero) @@ -105,24 +102,12 @@ module PrefixSum = let mirror = clContext.CreateClCell mirror - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - inputArrayLength - verticesLength - inputArray - vertices - totalSum - zero - mirror) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) - - zero.Free processor - mirror.Free processor + kernel.KernelFunc ndRange inputArrayLength verticesLength inputArray vertices totalSum zero mirror + + processor.RunKernel kernel + + zero.Free() + mirror.Free() let private scanExclusive<'a when 'a: struct> = scanGeneral @@ -153,7 +138,7 @@ module PrefixSum = let update = update opAdd clContext workGroupSize - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) (zero: 'a) -> + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) (zero: 'a) -> let firstVertices = clContext.CreateClArray<'a>( @@ -195,8 +180,8 @@ module PrefixSum = verticesArrays <- swap verticesArrays verticesLength <- (verticesLength - 1) / workGroupSize + 1 - firstVertices.Free processor - secondVertices.Free processor + firstVertices.Free() + secondVertices.Free() totalSum @@ -224,12 +209,14 @@ module PrefixSum = /// /// ClContext. /// Should be a power of 2 and greater than 1. + [] let standardExcludeInPlace (clContext: ClContext) workGroupSize = let scan = runExcludeInPlace <@ (+) @> clContext workGroupSize - fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> + fun (processor: RawCommandQueue) (inputArray: ClArray) -> scan processor inputArray 0 @@ -254,7 +241,7 @@ module PrefixSum = let scan = runIncludeInPlace <@ (+) @> clContext workGroupSize - fun (processor: MailboxProcessor<_>) (inputArray: ClArray) -> + fun (processor: RawCommandQueue) (inputArray: ClArray) -> scan processor inputArray 0 @@ -286,19 +273,16 @@ module PrefixSum = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) uniqueKeysCount (values: ClArray<'a>) (keys: ClArray) (offsets: ClArray) -> + fun (processor: RawCommandQueue) uniqueKeysCount (values: ClArray<'a>) (keys: ClArray) (offsets: ClArray) -> let kernel = kernel.GetKernel() let ndRange = Range1D.CreateValid(values.Length, workGroupSize) - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange values.Length uniqueKeysCount values keys offsets) - ) + kernel.KernelFunc ndRange values.Length uniqueKeysCount values keys offsets - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.RunKernel kernel /// /// Exclude scan by key. diff --git a/src/GraphBLAS-sharp.Backend/Common/Scan.fs b/src/GraphBLAS-sharp.Backend/Common/Scan.fs new file mode 100644 index 00000000..b88c97fb --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Common/Scan.fs @@ -0,0 +1,262 @@ +namespace GraphBLAS.FSharp.Backend.Common + +open Brahma.FSharp +open FSharp.Quotations +open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.ClContextExtensions + +module internal ScanInternal = + + let private preScan + (opAdd: Expr<'a -> 'a -> 'a>) + (zero: 'a) + (saveSum: bool) + (clContext: ClContext) + (workGroupSize: int) + = + + let blockSize = + min clContext.ClDevice.MaxWorkGroupSize 256 + + let valuesPerBlock = 2 * blockSize + let numberOfMemBanks = 32 + + let localArraySize = + valuesPerBlock + + (valuesPerBlock / numberOfMemBanks) + + let getIndex = + <@ fun index -> index + (index / numberOfMemBanks) @> + + let preScan = + <@ fun (ndRange: Range1D) (valuesLength: int) (valuesBuffer: ClArray<'a>) (carryBuffer: ClArray<'a>) (totalSumCell: ClCell<'a>) -> + let gid = ndRange.GlobalID0 / blockSize + let lid = ndRange.LocalID0 + let gstart = gid * blockSize * 2 + + let sumValues = localArray<'a> localArraySize + + //Load values + if (gstart + lid + blockSize * 0) < valuesLength then + sumValues.[(%getIndex) (lid + blockSize * 0)] <- valuesBuffer.[gstart + lid + blockSize * 0] + else + sumValues.[(%getIndex) (lid + blockSize * 0)] <- zero + + + if (gstart + lid + blockSize * 1) < valuesLength then + sumValues.[(%getIndex) (lid + blockSize * 1)] <- valuesBuffer.[gstart + lid + blockSize * 1] + else + sumValues.[(%getIndex) (lid + blockSize * 1)] <- zero + + //Sweep up + let mutable offset = 1 + let mutable d = blockSize + + while d > 0 do + barrierLocal () + + if lid < d then + let ai = (%getIndex) (offset * (2 * lid + 1) - 1) + let bi = (%getIndex) (offset * (2 * lid + 2) - 1) + sumValues.[bi] <- (%opAdd) sumValues.[bi] sumValues.[ai] + + offset <- offset * 2 + d <- d / 2 + + barrierLocal () + + if lid = 0 then + let ai = (%getIndex) (2 * blockSize - 1) + carryBuffer.[gid] <- sumValues.[ai] + sumValues.[ai] <- zero + + // This condition means this thread will rewrite last element in array + // Saving it here for totalSum + if saveSum + && (gstart + lid + blockSize * 1 = valuesLength - 1 + || gstart + lid + blockSize * 0 = valuesLength - 1) then + totalSumCell.Value <- valuesBuffer.[valuesLength - 1] + + //Sweep down + d <- 1 + + while d <= blockSize do + barrierLocal () + + offset <- offset / 2 + + if lid < d then + let ai = (%getIndex) (offset * (2 * lid + 1) - 1) + let bi = (%getIndex) (offset * (2 * lid + 2) - 1) + + let tmp = sumValues.[ai] + sumValues.[ai] <- sumValues.[bi] + sumValues.[bi] <- (%opAdd) sumValues.[bi] tmp + + d <- d * 2 + + barrierLocal () + + if (gstart + lid + blockSize * 0) < valuesLength then + valuesBuffer.[gstart + lid + blockSize * 0] <- sumValues.[(%getIndex) (lid + blockSize * 0)] + + if (gstart + lid + blockSize * 1) < valuesLength then + valuesBuffer.[gstart + lid + blockSize * 1] <- sumValues.[(%getIndex) (lid + blockSize * 1)] @> + + let preScan = clContext.Compile(preScan) + + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) (totalSum: ClCell<'a>) -> + let numberOfGroups = + inputArray.Length / valuesPerBlock + + (if inputArray.Length % valuesPerBlock = 0 then + 0 + else + 1) + + let carry = + clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, numberOfGroups) + + let ndRangePreScan = + Range1D.CreateValid(numberOfGroups * blockSize, blockSize) + + let preScanKernel = preScan.GetKernel() + + preScanKernel.KernelFunc ndRangePreScan inputArray.Length inputArray carry totalSum + + processor.RunKernel preScanKernel + + carry, numberOfGroups > 1 + + let private scan (opAdd: Expr<'a -> 'a -> 'a>) (saveSum: bool) (clContext: ClContext) (workGroupSize: int) = + + let blockSize = + min clContext.ClDevice.MaxWorkGroupSize 256 + + let valuesPerBlock = 2 * blockSize + + let scan = + <@ fun (ndRange: Range1D) (valuesLength: int) (valuesBuffer: ClArray<'a>) (carryBuffer: ClArray<'a>) (totalSumCell: ClCell<'a>) -> + let gid = ndRange.GlobalID0 + 2 * blockSize + let cid = gid / (2 * blockSize) + + if gid < valuesLength then + valuesBuffer.[gid] <- (%opAdd) valuesBuffer.[gid] carryBuffer.[cid] + + if saveSum && gid = valuesLength - 1 then + totalSumCell.Value <- (%opAdd) totalSumCell.Value valuesBuffer.[gid] @> + + let scan = clContext.Compile(scan) + + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) (carry: ClArray<'a>) (totalSum: ClCell<'a>) -> + let numberOfGroups = + inputArray.Length / valuesPerBlock + + (if inputArray.Length % valuesPerBlock = 0 then + 0 + else + 1) + + let ndRangeScan = + Range1D.CreateValid((numberOfGroups - 1) * valuesPerBlock, blockSize) + + let scan = scan.GetKernel() + + scan.KernelFunc ndRangeScan inputArray.Length inputArray carry totalSum + + processor.RunKernel scan + + let runExcludeInPlace plus zero (clContext: ClContext) workGroupSize = + + let blockSize = + min clContext.ClDevice.MaxWorkGroupSize 256 + + let valuesPerBlock = 2 * blockSize + + let getTotalSum = + <@ fun (ndRange: Range1D) (valuesLength: int) (valuesBuffer: ClArray<'a>) (totalSumCell: ClCell<'a>) -> + totalSumCell.Value <- (%plus) valuesBuffer.[valuesLength - 1] totalSumCell.Value @> + + let preScanSaveSum = + preScan plus zero true clContext workGroupSize + + let preScan = + preScan plus zero false clContext workGroupSize + + let scanSaveSum = scan plus true clContext workGroupSize + let scan = scan plus false clContext workGroupSize + let getTotalSum = clContext.Compile(getTotalSum) + + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) -> + + let totalSum = clContext.CreateClCell<'a>() + + let carry, needRecursion = + preScanSaveSum processor inputArray totalSum + + if not needRecursion then + carry.Free() + + let ndRangeTotalSum = Range1D.CreateValid(1, 1) + let getTotalSum = getTotalSum.GetKernel() + + getTotalSum.KernelFunc ndRangeTotalSum inputArray.Length inputArray totalSum + + processor.RunKernel getTotalSum + else + let mutable carryStack = [ carry; inputArray ] + let mutable stop = not needRecursion + + // Run preScan for carry until we get fully scanned carry + // If during preScan numberOfGroups = 1 means input is fully scanned + while not stop do + let input = carryStack.Head + let carry, needRecursion = preScan processor input totalSum + + if needRecursion then + carryStack <- carry :: carryStack + else + stop <- true + carry.Free() + + stop <- false + + // Run scan for each not fully scanned carry until we get inputArray scanned + while not stop do + match carryStack with + | carry :: inputCarry :: tail -> + if tail.IsEmpty then + scanSaveSum processor inputCarry carry totalSum + stop <- true + else + scan processor inputCarry carry totalSum + + carry.Free() + carryStack <- carryStack.Tail + | _ -> failwith "carryStack always has at least 2 elements" + + totalSum + + /// + /// Exclude in-place prefix sum of integer array with addition operation and start value that is equal to 0. + /// + /// + /// + /// let arr = [| 1; 1; 1; 1 |] + /// let sum = [| 0 |] + /// runExcludeInplace clContext workGroupSize processor arr sum (+) 0 + /// |> ignore + /// ... + /// > val arr = [| 0; 1; 2; 3 |] + /// > val sum = [| 4 |] + /// + /// + /// ClContext. + /// Should be a power of 2 and greater than 1. + /// Note that maximum possible workGroupSize is used for better perfomance + let standardExcludeInPlace (clContext: ClContext) workGroupSize = + + let scan = + runExcludeInPlace <@ (+) @> 0 clContext workGroupSize + + fun (processor: RawCommandQueue) (inputArray: ClArray) -> + + scan processor inputArray diff --git a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs index 82980465..c816ab7a 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Scatter.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Scatter.fs @@ -26,7 +26,7 @@ module Scatter = let program = clContext.Compile(run) - fun (processor: MailboxProcessor<_>) (positions: ClArray) (values: ClArray<'a>) (result: ClArray<'a>) -> + fun (processor: RawCommandQueue) (positions: ClArray) (values: ClArray<'a>) (result: ClArray<'a>) -> if positions.Length <> values.Length then failwith "Lengths must be the same" @@ -38,12 +38,9 @@ module Scatter = let kernel = program.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange positions positionsLength values result result.Length) - ) + kernel.KernelFunc ndRange positions positionsLength values result result.Length - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel /// /// Creates a new array from the given one where it is indicated @@ -114,7 +111,7 @@ module Scatter = let program = clContext.Compile(run) - fun (processor: MailboxProcessor<_>) (positions: ClArray) (result: ClArray<'a>) -> + fun (processor: RawCommandQueue) (positions: ClArray) (result: ClArray<'a>) -> let positionsLength = positions.Length @@ -123,11 +120,9 @@ module Scatter = let kernel = program.GetKernel() - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange positions positionsLength result result.Length) - ) + kernel.KernelFunc ndRange positions positionsLength result result.Length - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel /// /// Creates a new array from the given one where it is indicated by the array of positions at which position in the new array diff --git a/src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs b/src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs index f51e94ce..11b6b62e 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sort/Bitonic.fs @@ -1,317 +1,481 @@ namespace GraphBLAS.FSharp.Backend.Common.Sort open Brahma.FSharp -open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend module Bitonic = - let private localBegin (clContext: ClContext) workGroupSize = - let processedSize = workGroupSize * 2 + let sortRowsColumnsValuesInplace<'a> (clContext: ClContext) (workGroupSize: int) = - let localBegin = - <@ fun (range: Range1D) (rows: ClArray<'n>) (cols: ClArray<'n>) (values: ClArray<'a>) (length: int) -> + let localSize = + Common.Utils.floorToPower2 ( + int (clContext.ClDevice.LocalMemSize) + / (sizeof + sizeof<'a>) + ) + / 2 + + let maxThreadsPerBlock = + min (clContext.ClDevice.MaxWorkGroupSize) (localSize / 2) - let lid = range.LocalID0 - let gid = range.GlobalID0 + let waveSize = 32 + let maxWorkGroupSize = clContext.ClDevice.MaxWorkGroupSize + + let localStep = + <@ fun (ndRange: Range1D) (rows: ClArray) (cols: ClArray) (vals: ClArray<'a>) (length: int) -> + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 + let workGroupSize = ndRange.LocalWorkSize let groupId = gid / workGroupSize - // 1 рабочая группа обрабатывает 2 * workGroupSize элементов - let localRows = localArray<'n> processedSize - let localCols = localArray<'n> processedSize - let localValues = localArray<'a> processedSize + let offset = groupId * localSize + let border = min (offset + localSize) length + let n = border - offset - let mutable readIdx = processedSize * groupId + lid - let mutable localLength = local () - localLength <- processedSize + let nAligned = + (%Quotes.ArithmeticOperations.ceilToPowerOfTwo) n - // копируем элементы из глобальной памяти в локальную - if readIdx < length then - localRows.[lid] <- rows.[readIdx] - localCols.[lid] <- cols.[readIdx] - localValues.[lid] <- values.[readIdx] + let numberOfThreads = nAligned / 2 - if readIdx = length then - localLength <- lid + let sortedKeys = localArray localSize + let sortedVals = localArray<'a> localSize - readIdx <- readIdx + workGroupSize + let mutable i = lid - if readIdx < length then - localRows.[lid + workGroupSize] <- rows.[readIdx] - localCols.[lid + workGroupSize] <- cols.[readIdx] - localValues.[lid + workGroupSize] <- values.[readIdx] + while i + offset < border do + let key: uint64 = + ((uint64 rows.[i + offset]) <<< 32) + ||| (uint64 cols.[i + offset]) - if readIdx = length then - localLength <- lid + workGroupSize + sortedKeys.[i] <- key + sortedVals.[i] <- vals.[i + offset] + i <- i + workGroupSize barrierLocal () - let mutable segmentLength = 1 - - while segmentLength < processedSize do - segmentLength <- segmentLength <<< 1 - let localLineId = lid % (segmentLength >>> 1) - let localTwinId = segmentLength - localLineId - 1 - let groupLineId = lid / (segmentLength >>> 1) + let mutable segmentSize = 2 - let lineId = - segmentLength * groupLineId + localLineId + while segmentSize <= nAligned do + let segmentSizeHalf = segmentSize / 2 - let twinId = - segmentLength * groupLineId + localTwinId + let mutable tid = lid - if twinId < localLength - && (localRows.[lineId] > localRows.[twinId] - || localRows.[lineId] = localRows.[twinId] - && localCols.[lineId] > localCols.[twinId]) then - let tmpRow = localRows.[lineId] - localRows.[lineId] <- localRows.[twinId] - localRows.[twinId] <- tmpRow + while tid < numberOfThreads do + let segmentId = tid / segmentSizeHalf + let innerId = tid % segmentSizeHalf + let innerIdSibling = segmentSize - innerId - 1 + let i = segmentId * segmentSize + innerId + let j = segmentId * segmentSize + innerIdSibling - let tmpCol = localCols.[lineId] - localCols.[lineId] <- localCols.[twinId] - localCols.[twinId] <- tmpCol + if (i < n && j < n && sortedKeys.[i] > sortedKeys.[j]) then + let tempK = sortedKeys.[i] + sortedKeys.[i] <- sortedKeys.[j] + sortedKeys.[j] <- tempK + let tempV = sortedVals.[i] + sortedVals.[i] <- sortedVals.[j] + sortedVals.[j] <- tempV - let tmpValue = localValues.[lineId] - localValues.[lineId] <- localValues.[twinId] - localValues.[twinId] <- tmpValue + tid <- tid + workGroupSize barrierLocal () - let mutable j = segmentLength >>> 1 + let mutable k = segmentSizeHalf / 2 - while j > 1 do - let localLineId = lid % (j >>> 1) - let localTwinId = localLineId + (j >>> 1) - let groupLineId = lid / (j >>> 1) - let lineId = j * groupLineId + localLineId - let twinId = j * groupLineId + localTwinId + while k > 0 do - if twinId < localLength - && (localRows.[lineId] > localRows.[twinId] - || localRows.[lineId] = localRows.[twinId] - && localCols.[lineId] > localCols.[twinId]) then - let tmpRow = localRows.[lineId] - localRows.[lineId] <- localRows.[twinId] - localRows.[twinId] <- tmpRow + let mutable tid = lid - let tmpCol = localCols.[lineId] - localCols.[lineId] <- localCols.[twinId] - localCols.[twinId] <- tmpCol + while tid < numberOfThreads do + let segmentSizeInner = k * 2 + let segmentId = tid / k + let innerId = tid % k + let innerIdSibling = innerId + k + let i = segmentId * segmentSizeInner + innerId - let tmpValue = localValues.[lineId] - localValues.[lineId] <- localValues.[twinId] - localValues.[twinId] <- tmpValue + let j = + segmentId * segmentSizeInner + innerIdSibling + if (i < n && j < n && sortedKeys.[i] > sortedKeys.[j]) then + let tempK = sortedKeys.[i] + sortedKeys.[i] <- sortedKeys.[j] + sortedKeys.[j] <- tempK + let tempV = sortedVals.[i] + sortedVals.[i] <- sortedVals.[j] + sortedVals.[j] <- tempV + + tid <- tid + workGroupSize + + k <- k / 2 barrierLocal () - j <- j >>> 1 + segmentSize <- segmentSize * 2 - let mutable writeIdx = processedSize * groupId + lid + let mutable i = lid - if writeIdx < length then - rows.[writeIdx] <- localRows.[lid] - cols.[writeIdx] <- localCols.[lid] - values.[writeIdx] <- localValues.[lid] + while i + offset < border do + let key = sortedKeys.[i] + rows.[i + offset] <- int (key >>> 32) + cols.[i + offset] <- int key + vals.[i + offset] <- sortedVals.[i] + i <- i + workGroupSize @> - writeIdx <- writeIdx + workGroupSize + let globalStep = + <@ fun (ndRange: Range1D) (rows: ClArray) (cols: ClArray) (vals: ClArray<'a>) (length: int) (segmentStart: int) -> + let lid = ndRange.LocalID0 + let workGroupSize = ndRange.LocalWorkSize - if writeIdx < length then - rows.[writeIdx] <- localRows.[lid + workGroupSize] - cols.[writeIdx] <- localCols.[lid + workGroupSize] - values.[writeIdx] <- localValues.[lid + workGroupSize] @> + let n = length - let program = clContext.Compile(localBegin) + let nAligned = + (%Quotes.ArithmeticOperations.ceilToPowerOfTwo) n - fun (queue: MailboxProcessor<_>) (rows: ClArray<'n>) (cols: ClArray<'n>) (values: ClArray<'a>) -> + let numberOfThreads = nAligned / 2 - let ndRange = - Range1D.CreateValid(Utils.floorToPower2 values.Length, workGroupSize) + let mutable segmentSize = segmentStart - let kernel = program.GetKernel() + while segmentSize <= nAligned do + let segmentSizeHalf = segmentSize / 2 - queue.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange rows cols values values.Length)) - queue.Post(Msg.CreateRunMsg<_, _>(kernel)) + let mutable tid = lid + while tid < numberOfThreads do + let segmentId = tid / segmentSizeHalf + let innerId = tid % segmentSizeHalf + let innerIdSibling = segmentSize - innerId - 1 + let i = segmentId * segmentSize + innerId + let j = segmentId * segmentSize + innerIdSibling - let private globalStep (clContext: ClContext) workGroupSize = + if (i < n && j < n) then + let keyI = + ((uint64 rows.[i]) <<< 32) ||| (uint64 cols.[i]) - let globalStep = - <@ fun (range: Range1D) (rows: ClArray<'n>) (cols: ClArray<'n>) (values: ClArray<'a>) (length: int) (segmentLength: int) (mirror: ClCell) -> + let keyJ = + ((uint64 rows.[j]) <<< 32) ||| (uint64 cols.[j]) - let mirror = mirror.Value + if (keyI > keyJ) then + let tempR = rows.[i] + rows.[i] <- rows.[j] + rows.[j] <- tempR + let tempC = cols.[i] + cols.[i] <- cols.[j] + cols.[j] <- tempC + let tempV = vals.[i] + vals.[i] <- vals.[j] + vals.[j] <- tempV - let gid = range.GlobalID0 + tid <- tid + workGroupSize - let localLineId = gid % (segmentLength >>> 1) - let mutable localTwinId = 0 + barrierGlobal () - if mirror then - localTwinId <- segmentLength - localLineId - 1 - else - localTwinId <- localLineId + (segmentLength >>> 1) + let mutable k = segmentSizeHalf / 2 - let groupLineId = gid / (segmentLength >>> 1) + while k > 0 do - let lineId = - segmentLength * groupLineId + localLineId + let mutable tid = lid - let twinId = - segmentLength * groupLineId + localTwinId + while tid < numberOfThreads do + let segmentSizeInner = k * 2 + let segmentId = tid / k + let innerId = tid % k + let innerIdSibling = innerId + k + let i = segmentId * segmentSizeInner + innerId - if twinId < length - && (rows.[lineId] > rows.[twinId] - || rows.[lineId] = rows.[twinId] - && cols.[lineId] > cols.[twinId]) then - let tmpRow = rows.[lineId] - rows.[lineId] <- rows.[twinId] - rows.[twinId] <- tmpRow + let j = + segmentId * segmentSizeInner + innerIdSibling - let tmpCol = cols.[lineId] - cols.[lineId] <- cols.[twinId] - cols.[twinId] <- tmpCol + if (i < n && j < n) then + let keyI = + ((uint64 rows.[i]) <<< 32) ||| (uint64 cols.[i]) - let tmpV = values.[lineId] - values.[lineId] <- values.[twinId] - values.[twinId] <- tmpV @> + let keyJ = + ((uint64 rows.[j]) <<< 32) ||| (uint64 cols.[j]) - let program = clContext.Compile(globalStep) + if (keyI > keyJ) then + let tempR = rows.[i] + rows.[i] <- rows.[j] + rows.[j] <- tempR + let tempC = cols.[i] + cols.[i] <- cols.[j] + cols.[j] <- tempC + let tempV = vals.[i] + vals.[i] <- vals.[j] + vals.[j] <- tempV - fun (queue: MailboxProcessor<_>) (rows: ClArray<'n>) (cols: ClArray<'n>) (values: ClArray<'a>) (segmentLength: int) (mirror: bool) -> + tid <- tid + workGroupSize - let ndRange = - Range1D.CreateValid(Utils.floorToPower2 values.Length, workGroupSize) + k <- k / 2 + barrierGlobal () - let mirror = clContext.CreateClCell mirror + segmentSize <- segmentSize * 2 @> - let kernel = program.GetKernel() + let localStep = clContext.Compile(localStep) + let globalStep = clContext.Compile(globalStep) - queue.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange rows cols values values.Length segmentLength mirror) - ) + fun (queue: RawCommandQueue) (rows: ClArray) (cols: ClArray) (values: ClArray<'a>) -> - queue.Post(Msg.CreateRunMsg<_, _>(kernel)) - queue.Post(Msg.CreateFreeMsg(mirror)) + let size = values.Length + if (size = 1) then + () + else if (size <= localSize) then + let numberOfThreads = + Common.Utils.ceilToMultiple waveSize (min size maxThreadsPerBlock) - let private localEnd (clContext: ClContext) workGroupSize = + let ndRangeLocal = + Range1D.CreateValid(numberOfThreads, numberOfThreads) - let processedSize = workGroupSize * 2 + let kernel = localStep.GetKernel() - let localEnd = - <@ fun (range: Range1D) (rows: ClArray<'n>) (cols: ClArray<'n>) (values: ClArray<'a>) (length: int) -> + kernel.KernelFunc ndRangeLocal rows cols values values.Length + queue.RunKernel(kernel) + else + let numberOfGroups = + size / localSize + + (if size % localSize = 0 then 0 else 1) - let lid = range.LocalID0 - let gid = range.GlobalID0 - let groupId = gid / workGroupSize + let ndRangeLocal = + Range1D.CreateValid(maxThreadsPerBlock * numberOfGroups, maxThreadsPerBlock) + + let kernelLocal = localStep.GetKernel() + + kernelLocal.KernelFunc ndRangeLocal rows cols values values.Length - // 1 рабочая группа обрабатывает 2 * wgSize элементов - let localRows = localArray<'n> processedSize - let localCols = localArray<'n> processedSize - let localValues = localArray<'a> processedSize + queue.RunKernel(kernelLocal) - let mutable readIdx = processedSize * groupId + lid - let mutable localLength = local () - localLength <- processedSize + let ndRangeGlobal = + Range1D.CreateValid(maxWorkGroupSize, maxWorkGroupSize) - // копируем элементы из глобальной памяти в локальную - if readIdx < length then - localRows.[lid] <- rows.[readIdx] - localCols.[lid] <- cols.[readIdx] - localValues.[lid] <- values.[readIdx] + let kernelGlobal = globalStep.GetKernel() - if readIdx = length then - localLength <- lid + kernelGlobal.KernelFunc ndRangeGlobal rows cols values values.Length (localSize * 2) - readIdx <- readIdx + workGroupSize + queue.RunKernel(kernelGlobal) - if readIdx < length then - localRows.[lid + workGroupSize] <- rows.[readIdx] - localCols.[lid + workGroupSize] <- cols.[readIdx] - localValues.[lid + workGroupSize] <- values.[readIdx] - if readIdx = length then - localLength <- lid + workGroupSize + let sortKeyValuesInplace<'a> (clContext: ClContext) (workGroupSize: int) = + + let localSize = + Common.Utils.floorToPower2 ( + int (clContext.ClDevice.LocalMemSize) + / (sizeof + sizeof<'a>) + ) + / 2 + + let maxThreadsPerBlock = + min (clContext.ClDevice.MaxWorkGroupSize) (localSize / 2) + + let waveSize = 32 + let maxWorkGroupSize = clContext.ClDevice.MaxWorkGroupSize + + let localStep = + <@ fun (ndRange: Range1D) (rows: ClArray) (vals: ClArray<'a>) (length: int) -> + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 + let workGroupSize = ndRange.LocalWorkSize + let groupId = gid / workGroupSize + + let offset = groupId * localSize + let border = min (offset + localSize) length + let n = border - offset + + let nAligned = + (%Quotes.ArithmeticOperations.ceilToPowerOfTwo) n + + let numberOfThreads = nAligned / 2 + + let sortedKeys = localArray localSize + let sortedVals = localArray<'a> localSize + + let mutable i = lid + + while i + offset < border do + let key = rows.[i + offset] + sortedKeys.[i] <- key + sortedVals.[i] <- vals.[i + offset] + i <- i + workGroupSize barrierLocal () - let mutable segmentLength = processedSize - let mutable j = segmentLength + let mutable segmentSize = 2 - while j > 1 do - let localLineId = lid % (j / 2) - let localTwinId = localLineId + (j / 2) - let groupLineId = lid / (j / 2) - let lineId = j * groupLineId + localLineId - let twinId = j * groupLineId + localTwinId + while segmentSize <= nAligned do + let segmentSizeHalf = segmentSize / 2 - if twinId < localLength - && (localRows.[lineId] > localRows.[twinId] - || localRows.[lineId] = localRows.[twinId] - && localCols.[lineId] > localCols.[twinId]) then - let tmpRow = localRows.[lineId] - localRows.[lineId] <- localRows.[twinId] - localRows.[twinId] <- tmpRow + let mutable tid = lid - let tmpCol = localCols.[lineId] - localCols.[lineId] <- localCols.[twinId] - localCols.[twinId] <- tmpCol + while tid < numberOfThreads do + let segmentId = tid / segmentSizeHalf + let innerId = tid % segmentSizeHalf + let innerIdSibling = segmentSize - innerId - 1 + let i = segmentId * segmentSize + innerId + let j = segmentId * segmentSize + innerIdSibling - let tmpValue = localValues.[lineId] - localValues.[lineId] <- localValues.[twinId] - localValues.[twinId] <- tmpValue + if (i < n && j < n && sortedKeys.[i] > sortedKeys.[j]) then + let tempK = sortedKeys.[i] + sortedKeys.[i] <- sortedKeys.[j] + sortedKeys.[j] <- tempK + let tempV = sortedVals.[i] + sortedVals.[i] <- sortedVals.[j] + sortedVals.[j] <- tempV + + tid <- tid + workGroupSize barrierLocal () - j <- j >>> 1 + let mutable k = segmentSizeHalf / 2 + + while k > 0 do + + let mutable tid = lid + + while tid < numberOfThreads do + let segmentSizeInner = k * 2 + let segmentId = tid / k + let innerId = tid % k + let innerIdSibling = innerId + k + let i = segmentId * segmentSizeInner + innerId + + let j = + segmentId * segmentSizeInner + innerIdSibling + + if (i < n && j < n && sortedKeys.[i] > sortedKeys.[j]) then + let tempK = sortedKeys.[i] + sortedKeys.[i] <- sortedKeys.[j] + sortedKeys.[j] <- tempK + let tempV = sortedVals.[i] + sortedVals.[i] <- sortedVals.[j] + sortedVals.[j] <- tempV + + tid <- tid + workGroupSize + + k <- k / 2 + barrierLocal () + + segmentSize <- segmentSize * 2 + + let mutable i = lid + + while i + offset < border do + let key = sortedKeys.[i] + rows.[i + offset] <- key + vals.[i + offset] <- sortedVals.[i] + i <- i + workGroupSize @> + + let globalStep = + <@ fun (ndRange: Range1D) (rows: ClArray) (vals: ClArray<'a>) (length: int) (segmentStart: int) -> + let lid = ndRange.LocalID0 + let workGroupSize = ndRange.LocalWorkSize + + let n = length + + let nAligned = + (%Quotes.ArithmeticOperations.ceilToPowerOfTwo) n + + let numberOfThreads = nAligned / 2 + + let mutable segmentSize = segmentStart + + while segmentSize <= nAligned do + let segmentSizeHalf = segmentSize / 2 + + let mutable tid = lid + + while tid < numberOfThreads do + let segmentId = tid / segmentSizeHalf + let innerId = tid % segmentSizeHalf + let innerIdSibling = segmentSize - innerId - 1 + let i = segmentId * segmentSize + innerId + let j = segmentId * segmentSize + innerIdSibling + + if (i < n && j < n) then + let keyI = rows.[i] + let keyJ = rows.[j] + + if (keyI > keyJ) then + let tempR = rows.[i] + rows.[i] <- rows.[j] + rows.[j] <- tempR + let tempV = vals.[i] + vals.[i] <- vals.[j] + vals.[j] <- tempV + + tid <- tid + workGroupSize + + barrierGlobal () + + let mutable k = segmentSizeHalf / 2 + + while k > 0 do + + let mutable tid = lid + + while tid < numberOfThreads do + let segmentSizeInner = k * 2 + let segmentId = tid / k + let innerId = tid % k + let innerIdSibling = innerId + k + let i = segmentId * segmentSizeInner + innerId + + let j = + segmentId * segmentSizeInner + innerIdSibling + + if (i < n && j < n) then + let keyI = rows.[i] + let keyJ = rows.[j] + + if (keyI > keyJ) then + let tempR = rows.[i] + rows.[i] <- rows.[j] + rows.[j] <- tempR + let tempV = vals.[i] + vals.[i] <- vals.[j] + vals.[j] <- tempV + + tid <- tid + workGroupSize + + k <- k / 2 + barrierGlobal () - let mutable writeIdx = processedSize * groupId + lid + segmentSize <- segmentSize * 2 @> - if writeIdx < length then - rows.[writeIdx] <- localRows.[lid] - cols.[writeIdx] <- localCols.[lid] - values.[writeIdx] <- localValues.[lid] + let localStep = clContext.Compile(localStep) + let globalStep = clContext.Compile(globalStep) - writeIdx <- writeIdx + workGroupSize + fun (queue: RawCommandQueue) (rows: ClArray) (values: ClArray<'a>) -> - if writeIdx < length then - rows.[writeIdx] <- localRows.[lid + workGroupSize] - cols.[writeIdx] <- localCols.[lid + workGroupSize] - values.[writeIdx] <- localValues.[lid + workGroupSize] @> + let size = values.Length - let program = clContext.Compile(localEnd) + if (size = 1) then + () + else if (size <= localSize) then + let numberOfThreads = + Common.Utils.ceilToMultiple waveSize (min size maxThreadsPerBlock) - fun (queue: MailboxProcessor<_>) (rows: ClArray<'n>) (cols: ClArray<'n>) (values: ClArray<'a>) -> + let ndRangeLocal = + Range1D.CreateValid(numberOfThreads, numberOfThreads) - let ndRange = - Range1D.CreateValid(Utils.floorToPower2 values.Length, workGroupSize) + let kernel = localStep.GetKernel() - let kernel = program.GetKernel() + kernel.KernelFunc ndRangeLocal rows values values.Length + queue.RunKernel(kernel) + else + let numberOfGroups = + size / localSize + + (if size % localSize = 0 then 0 else 1) - queue.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange rows cols values values.Length)) - queue.Post(Msg.CreateRunMsg<_, _>(kernel)) + let ndRangeLocal = + Range1D.CreateValid(maxThreadsPerBlock * numberOfGroups, maxThreadsPerBlock) - let sortKeyValuesInplace<'n, 'a when 'n: comparison> (clContext: ClContext) workGroupSize = + let kernelLocal = localStep.GetKernel() - let localBegin = localBegin clContext workGroupSize - let globalStep = globalStep clContext workGroupSize - let localEnd = localEnd clContext workGroupSize + kernelLocal.KernelFunc ndRangeLocal rows values values.Length - fun (queue: MailboxProcessor<_>) (rows: ClArray<'n>) (cols: ClArray<'n>) (values: ClArray<'a>) -> + queue.RunKernel(kernelLocal) - let lengthCeiled = Utils.ceilToPower2 values.Length + let ndRangeGlobal = + Range1D.CreateValid(maxWorkGroupSize, maxWorkGroupSize) - let rec loopNested i = - if i > workGroupSize * 2 then - globalStep queue rows cols values i false - loopNested (i >>> 1) + let kernelGlobal = globalStep.GetKernel() - let rec mainLoop segmentLength = - if segmentLength <= lengthCeiled then - globalStep queue rows cols values segmentLength true - loopNested (segmentLength >>> 1) - localEnd queue rows cols values - mainLoop (segmentLength <<< 1) + kernelGlobal.KernelFunc ndRangeGlobal rows values values.Length (localSize * 2) - localBegin queue rows cols values - mainLoop (workGroupSize <<< 2) + queue.RunKernel(kernelGlobal) diff --git a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs index 03ad4ed0..11cb9d81 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sort/Radix.fs @@ -76,7 +76,7 @@ module internal Radix = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (indices: ClArray) (clWorkGroupCount: ClCell) (shift: ClCell) -> + fun (processor: RawCommandQueue) (indices: ClArray) (clWorkGroupCount: ClCell) (shift: ClCell) -> let ndRange = Range1D.CreateValid(indices.Length, workGroupSize) @@ -92,20 +92,9 @@ module internal Radix = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - indices.Length - indices - clWorkGroupCount - shift - globalOffsets - localOffsets) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc ndRange indices.Length indices clWorkGroupCount shift globalOffsets localOffsets + + processor.RunKernel kernel globalOffsets, localOffsets @@ -133,20 +122,16 @@ module internal Radix = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (keys: ClArray) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: ClArray) (localOffsets: ClArray) (result: ClArray) -> + fun (processor: RawCommandQueue) (keys: ClArray) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: ClArray) (localOffsets: ClArray) (result: ClArray) -> let ndRange = Range1D.CreateValid(keys.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc ndRange keys.Length keys shift workGroupCount globalOffset localOffsets result) - ) + kernel.KernelFunc ndRange keys.Length keys shift workGroupCount globalOffset localOffsets result - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel let private runKeysOnly (clContext: ClContext) workGroupSize bitCount = let copy = ClArray.copy clContext workGroupSize @@ -156,15 +141,16 @@ module internal Radix = let count = count clContext workGroupSize mask let prefixSum = - PrefixSum.standardExcludeInPlace clContext workGroupSize + ScanInternal.standardExcludeInPlace clContext workGroupSize let scatter = scatter clContext workGroupSize mask - fun (processor: MailboxProcessor<_>) (keys: ClArray) -> + fun (processor: RawCommandQueue) (keys: ClArray) -> if keys.Length <= 1 then - copy processor DeviceOnly keys // TODO(allocation mode) + copy processor DeviceOnly keys keys.Length else - let firstKeys = copy processor DeviceOnly keys + let firstKeys = + copy processor DeviceOnly keys keys.Length let secondKeys = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys.Length) @@ -183,17 +169,17 @@ module internal Radix = let globalOffset, localOffset = count processor (fst pair) workGroupCount shift - (prefixSum processor globalOffset).Free processor + (prefixSum processor globalOffset).Free() scatter processor (fst pair) shift workGroupCount globalOffset localOffset (snd pair) pair <- swap pair - globalOffset.Free processor - localOffset.Free processor - shift.Free processor + globalOffset.Free() + localOffset.Free() + shift.Free() - (snd pair).Free processor + (snd pair).Free() fst pair let standardRunKeysOnly clContext workGroupSize = @@ -224,30 +210,26 @@ module internal Radix = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (keys: ClArray) (values: ClArray<'a>) (shift: ClCell) (workGroupCount: ClCell) (globalOffset: ClArray) (localOffsets: ClArray) (resultKeys: ClArray) (resultValues: ClArray<'a>) -> + fun (processor: RawCommandQueue) (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) let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - keys.Length - keys - values - shift - workGroupCount - globalOffset - localOffsets - resultKeys - resultValues) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + keys.Length + keys + values + shift + workGroupCount + globalOffset + localOffsets + resultKeys + resultValues + + processor.RunKernel kernel let private runByKeys (clContext: ClContext) workGroupSize bitCount = let copy = ClArray.copy clContext workGroupSize @@ -259,24 +241,26 @@ module internal Radix = let count = count clContext workGroupSize mask let prefixSum = - PrefixSum.standardExcludeInPlace clContext workGroupSize + ScanInternal.standardExcludeInPlace clContext workGroupSize let scatterByKey = scatterByKey clContext workGroupSize mask - fun (processor: MailboxProcessor<_>) allocationMode (keys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (keys: ClArray) (values: ClArray<'a>) -> if values.Length <> keys.Length then failwith "Mismatch of key lengths and value. Lengths must be the same" if values.Length <= 1 then - dataCopy processor allocationMode values + copy processor DeviceOnly keys keys.Length, dataCopy processor DeviceOnly values values.Length else - let firstKeys = copy processor DeviceOnly keys + let firstKeys = + copy processor DeviceOnly keys keys.Length let secondKeys = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, keys.Length) - let firstValues = dataCopy processor DeviceOnly values + let firstValues = + dataCopy processor DeviceOnly values values.Length let secondValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values.Length) @@ -303,7 +287,7 @@ module internal Radix = let globalOffset, localOffset = count processor currentKeys workGroupCount shift - (prefixSum processor globalOffset).Free processor + (prefixSum processor globalOffset).Free() scatterByKey processor @@ -319,14 +303,26 @@ module internal Radix = keysPair <- swap keysPair valuesPair <- swap valuesPair - localOffset.Free processor - shift.Free processor + globalOffset.Free() + localOffset.Free() + shift.Free() + + (snd keysPair).Free() + (snd valuesPair).Free() + + (fst keysPair, fst valuesPair) + + let runByKeysStandardValuesOnly clContext workGroupSize = + let runByKeys = + runByKeys clContext workGroupSize defaultBitCount + + fun (processor: RawCommandQueue) allocationMode (keys: ClArray) (values: ClArray<'a>) -> + let keys, values = + runByKeys processor allocationMode keys values - (fst keysPair).Free processor - (snd keysPair).Free processor - (snd valuesPair).Free processor + keys.Free() - (fst valuesPair) + values let runByKeysStandard clContext workGroupSize = runByKeys clContext workGroupSize defaultBitCount diff --git a/src/GraphBLAS-sharp.Backend/Common/Sum.fs b/src/GraphBLAS-sharp.Backend/Common/Sum.fs index 8f3fe936..475e4069 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Sum.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Sum.fs @@ -14,7 +14,7 @@ module Reduce = /// let private runGeneral (clContext: ClContext) workGroupSize scan scanToCell = - fun (processor: MailboxProcessor<_>) (inputArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) (inputArray: ClArray<'a>) -> let scan = scan processor @@ -50,8 +50,8 @@ module Reduce = let result = scanToCell processor fstVertices verticesLength - firstVerticesArray.Free processor - secondVerticesArray.Free processor + firstVerticesArray.Free() + secondVerticesArray.Free() result @@ -80,17 +80,15 @@ module Reduce = let kernel = clContext.Compile(scan) - fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength (resultArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) (valuesArray: ClArray<'a>) valuesLength (resultArray: ClArray<'a>) -> let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultArray) - ) + kernel.KernelFunc ndRange valuesLength valuesArray resultArray - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel let private scanToCellSum (opAdd: Expr<'a -> 'a -> 'a>) (clContext: ClContext) workGroupSize zero = @@ -117,7 +115,7 @@ module Reduce = let kernel = clContext.Compile(scan) - fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength -> + fun (processor: RawCommandQueue) (valuesArray: ClArray<'a>) valuesLength -> let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) @@ -126,9 +124,9 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultCell)) + kernel.KernelFunc ndRange valuesLength valuesArray resultCell - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel resultCell @@ -149,7 +147,7 @@ module Reduce = let run = runGeneral clContext workGroupSize scan scanToCell - fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) -> run processor array + fun (processor: RawCommandQueue) (array: ClArray<'a>) -> run processor array let private scanReduce<'a when 'a: struct> (opAdd: Expr<'a -> 'a -> 'a>) @@ -179,18 +177,16 @@ module Reduce = let kernel = clContext.Compile(scan) - fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength (resultArray: ClArray<'a>) -> + fun (processor: RawCommandQueue) (valuesArray: ClArray<'a>) valuesLength (resultArray: ClArray<'a>) -> let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultArray) - ) + kernel.KernelFunc ndRange valuesLength valuesArray resultArray - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel let private scanToCellReduce<'a when 'a: struct> (opAdd: Expr<'a -> 'a -> 'a>) @@ -220,7 +216,7 @@ module Reduce = let kernel = clContext.Compile(scan) - fun (processor: MailboxProcessor<_>) (valuesArray: ClArray<'a>) valuesLength -> + fun (processor: RawCommandQueue) (valuesArray: ClArray<'a>) valuesLength -> let ndRange = Range1D.CreateValid(valuesArray.Length, workGroupSize) @@ -230,9 +226,9 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange valuesLength valuesArray resultCell)) + kernel.KernelFunc ndRange valuesLength valuesArray resultCell - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel resultCell @@ -252,7 +248,7 @@ module Reduce = let run = runGeneral clContext workGroupSize scan scanToCell - fun (processor: MailboxProcessor<_>) (array: ClArray<'a>) -> run processor array + fun (processor: RawCommandQueue) (array: ClArray<'a>) -> run processor array /// /// Reduction of an array of values by an array of keys. @@ -295,7 +291,7 @@ module Reduce = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (keys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (resultLength: int) (keys: ClArray) (values: ClArray<'a>) -> let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) @@ -308,12 +304,9 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange keys.Length keys values reducedValues reducedKeys) - ) + kernel.KernelFunc ndRange keys.Length keys values reducedValues reducedKeys - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel reducedValues, reducedKeys @@ -352,7 +345,7 @@ module Reduce = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (resultLength: int) (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) -> let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) @@ -365,21 +358,9 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - keys.Length - offsets - keys - values - reducedValues - reducedKeys) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc ndRange resultLength keys.Length offsets keys values reducedValues reducedKeys + + processor.RunKernel kernel reducedValues, reducedKeys @@ -428,7 +409,7 @@ module Reduce = let itemKeyId = lid + 1 let startKeyIndex = - (%Search.Bin.lowerPosition) length itemKeyId localBitmap + (%Search.Bin.lowerPositionLocal) length itemKeyId localBitmap match startKeyIndex with | Some startPosition -> @@ -448,7 +429,7 @@ module Reduce = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (keys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (resultLength: int) (keys: ClArray) (values: ClArray<'a>) -> if keys.Length > workGroupSize then failwith "The length of the value should not exceed the size of the workgroup" @@ -463,16 +444,138 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange keys.Length keys values reducedValues reducedKeys) - ) + kernel.KernelFunc ndRange keys.Length keys values reducedValues reducedKeys - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel kernel reducedValues, reducedKeys module Option = + /// + /// Reduces values by key. Each segment is reduced by one work item. + /// + /// ClContext. + /// Work group size. + /// Operation for reducing values. + let segmentSequential<'a> + (reduceOp: Expr<'a option -> 'a option -> 'a option>) + (clContext: ClContext) + workGroupSize + = + + let kernel = + <@ fun (ndRange: Range1D) uniqueKeyCount keysLength (offsets: ClArray) (keys: ClArray) (values: ClArray<'a option>) (reducedValues: ClArray<'a>) (firstReducedKeys: ClArray) (resultPositions: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < uniqueKeyCount then + let startPosition = + (%Search.Bin.lowerPosition) keysLength gid offsets + + match startPosition with + | Some startPosition -> + let firstSourceKey = keys.[startPosition] + + let mutable sum = None + + let mutable currentPosition = startPosition + + while currentPosition < keysLength + && firstSourceKey = keys.[currentPosition] do + let result = (%reduceOp) sum values.[currentPosition] // brahma error + sum <- result + currentPosition <- currentPosition + 1 + + match sum with + | Some value -> + reducedValues.[gid] <- value + resultPositions.[gid] <- 1 + | None -> resultPositions.[gid] <- 0 + + firstReducedKeys.[gid] <- firstSourceKey + | None -> () @> // not possible if done correctly + + let kernel = clContext.Compile kernel + + let getUniqueBitmap = + Bitmap.lastOccurrence clContext workGroupSize + + let scatterData = + Scatter.lastOccurrence clContext workGroupSize + + let scatterIndices = + Scatter.lastOccurrence clContext workGroupSize + + let prefixSum = + ScanInternal.standardExcludeInPlace clContext workGroupSize + + fun (processor: RawCommandQueue) allocationMode (keys: ClArray) (values: ClArray<'a option>) -> + + let offsets = + getUniqueBitmap processor DeviceOnly keys + + let uniqueKeysCount = + (prefixSum processor offsets) + .ToHostAndFree(processor) + + let reducedValues = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) + + let reducedKeys = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) + + let resultPositions = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) + + let ndRange = + Range1D.CreateValid(uniqueKeysCount, workGroupSize) + + let kernel = kernel.GetKernel() + + kernel.KernelFunc + ndRange + uniqueKeysCount + keys.Length + offsets + keys + values + reducedValues + reducedKeys + resultPositions + + processor.RunKernel kernel + + offsets.Free() + + let resultLength = + (prefixSum processor resultPositions) + .ToHostAndFree(processor) + + if resultLength = 0 then + reducedValues.Free() + reducedKeys.Free() + resultPositions.Free() + None + else + // write values + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + scatterData processor resultPositions reducedValues resultValues + + reducedValues.Free() + + // write keys + let resultKeys = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + scatterIndices processor resultPositions reducedKeys resultKeys + + reducedKeys.Free() + resultPositions.Free() + + Some(resultValues, resultKeys) + /// /// Reduces values by key. Each segment is reduced by one work item. /// @@ -480,9 +583,13 @@ module Reduce = /// Work group size. /// Operation for reducing values. /// - /// The length of the result must be calculated in advance. + /// The length of the result and offsets for each segment must be calculated in advance. /// - let segmentSequential<'a> (reduceOp: Expr<'a -> 'a -> 'a option>) (clContext: ClContext) workGroupSize = + let segmentSequentialByOffsets<'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) -> @@ -528,9 +635,9 @@ module Reduce = Scatter.lastOccurrence clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInPlace clContext workGroupSize + ScanInternal.standardExcludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (resultLength: int) (offsets: ClArray) (keys: ClArray) (values: ClArray<'a>) -> let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) @@ -546,28 +653,28 @@ module Reduce = 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)) + kernel.KernelFunc + ndRange + resultLength + keys.Length + offsets + keys + values + reducedValues + reducedKeys + resultPositions + + processor.RunKernel kernel let resultLength = (prefixSum processor resultPositions) - .ToHostAndFree processor + .ToHostAndFree(processor) if resultLength = 0 then + reducedValues.Free() + reducedKeys.Free() + resultPositions.Free() + None else // write values @@ -576,7 +683,7 @@ module Reduce = scatterData processor resultPositions reducedValues resultValues - reducedValues.Free processor + reducedValues.Free() // write keys let resultKeys = @@ -584,8 +691,8 @@ module Reduce = scatterIndices processor resultPositions reducedKeys resultKeys - reducedKeys.Free processor - resultPositions.Free processor + reducedKeys.Free() + resultPositions.Free() Some(resultValues, resultKeys) @@ -635,7 +742,7 @@ module Reduce = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (resultLength: int) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) @@ -651,21 +758,17 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - firstKeys.Length - firstKeys - secondKeys - values - reducedValues - firstReducedKeys - secondReducedKeys) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + firstKeys.Length + firstKeys + secondKeys + values + reducedValues + firstReducedKeys + secondReducedKeys + + processor.RunKernel kernel reducedValues, firstReducedKeys, secondReducedKeys @@ -708,7 +811,7 @@ module Reduce = let kernel = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) @@ -724,23 +827,19 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - firstKeys.Length - offsets - firstKeys - secondKeys - values - reducedValues - firstReducedKeys - secondReducedKeys) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + resultLength + firstKeys.Length + offsets + firstKeys + secondKeys + values + reducedValues + firstReducedKeys + secondReducedKeys + + processor.RunKernel kernel reducedValues, firstReducedKeys, secondReducedKeys @@ -803,9 +902,9 @@ module Reduce = Scatter.lastOccurrence clContext workGroupSize let prefixSum = - PrefixSum.standardExcludeInPlace clContext workGroupSize + ScanInternal.standardExcludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> + fun (processor: RawCommandQueue) allocationMode (resultLength: int) (offsets: ClArray) (firstKeys: ClArray) (secondKeys: ClArray) (values: ClArray<'a>) -> let reducedValues = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) @@ -824,30 +923,31 @@ module Reduce = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - firstKeys.Length - offsets - firstKeys - secondKeys - values - reducedValues - firstReducedKeys - secondReducedKeys - resultPositions) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + resultLength + firstKeys.Length + offsets + firstKeys + secondKeys + values + reducedValues + firstReducedKeys + secondReducedKeys + resultPositions + + processor.RunKernel kernel let resultLength = (prefixSum processor resultPositions) - .ToHostAndFree processor + .ToHostAndFree(processor) if resultLength = 0 then + reducedValues.Free() + firstReducedKeys.Free() + secondReducedKeys.Free() + resultPositions.Free() + None else // write value @@ -856,7 +956,7 @@ module Reduce = scatterData processor resultPositions reducedValues resultValues - reducedValues.Free processor + reducedValues.Free() // write first keys let resultFirstKeys = @@ -864,7 +964,7 @@ module Reduce = scatterIndices processor resultPositions firstReducedKeys resultFirstKeys - firstReducedKeys.Free processor + firstReducedKeys.Free() // write second keys let resultSecondKeys = @@ -872,8 +972,8 @@ module Reduce = scatterIndices processor resultPositions secondReducedKeys resultSecondKeys - secondReducedKeys.Free processor + secondReducedKeys.Free() - resultPositions.Free processor + resultPositions.Free() Some(resultValues, resultFirstKeys, resultSecondKeys) diff --git a/src/GraphBLAS-sharp.Backend/Common/Utils.fs b/src/GraphBLAS-sharp.Backend/Common/Utils.fs index 0e4ac564..ef4c3371 100644 --- a/src/GraphBLAS-sharp.Backend/Common/Utils.fs +++ b/src/GraphBLAS-sharp.Backend/Common/Utils.fs @@ -1,7 +1,6 @@ namespace GraphBLAS.FSharp.Backend.Common module internal Utils = - let defaultWorkGroupSize = 32 let floorToPower2 = fun x -> x ||| (x >>> 1) @@ -20,6 +19,10 @@ module internal Utils = >> fun x -> x ||| (x >>> 16) >> fun x -> x + 1 + let divUp x y = x / y + (if x % y = 0 then 0 else 1) + + let divUpClamp x y left right = min (max (divUp x y) left) right + let floorToMultiple multiple x = x / multiple * multiple let ceilToMultiple multiple x = ((x - 1) / multiple + 1) * multiple diff --git a/src/GraphBLAS-sharp.Backend/Constants/Constants.fs b/src/GraphBLAS-sharp.Backend/Constants/Constants.fs new file mode 100644 index 00000000..5609de06 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Constants/Constants.fs @@ -0,0 +1,18 @@ +namespace GraphBLAS.FSharp + +[] +module Constants = + module PageRank = + /// + /// PageRank algorithms will finish then + /// difference of current and previous vectors + /// is less than accuracy + /// + let accuracy = 1e-6f + /// + /// Damping factor for PageRank algorithm + /// + let alpha = 0.85f + + module Common = + let defaultWorkGroupSize = 32 diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index f78fdefc..dd6fa038 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -1,4 +1,4 @@ - + @@ -11,6 +11,7 @@ + @@ -18,7 +19,6 @@ - @@ -28,17 +28,18 @@ - + + + - @@ -50,6 +51,7 @@ + @@ -57,16 +59,18 @@ - + - + + + + - diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Intersect.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Intersect.fs new file mode 100644 index 00000000..701b5f4f --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Intersect.fs @@ -0,0 +1,57 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.COO + +open Brahma.FSharp +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Objects.ClContextExtensions + +module internal Intersect = + let findKeysIntersection (clContext: ClContext) workGroupSize = + + let findIntersection = + <@ fun (ndRange: Range1D) (leftNNZ: int) (rightNNZ: int) (leftRows: ClArray) (leftColumns: ClArray) (rightRows: ClArray) (rightColumns: ClArray) (bitmap: ClArray) -> + + let gid = ndRange.GlobalID0 + let bitmapSize = leftNNZ + + if gid < bitmapSize then + + let index: uint64 = + ((uint64 leftRows.[gid]) <<< 32) + ||| (uint64 leftColumns.[gid]) + + let intersect = + (%Search.Bin.existsByKey2D) rightNNZ index rightRows rightColumns + + if intersect then + bitmap.[gid] <- 1 + else + bitmap.[gid] <- 0 @> + + let kernel = clContext.Compile <| findIntersection + + fun (processor: RawCommandQueue) allocationMode (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.COO<'b>) -> + + let bitmapSize = leftMatrix.NNZ + + let bitmap = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, bitmapSize) + + let ndRange = + Range1D.CreateValid(bitmapSize, workGroupSize) + + let kernel = kernel.GetKernel() + + kernel.KernelFunc + ndRange + leftMatrix.NNZ + rightMatrix.NNZ + leftMatrix.Rows + leftMatrix.Columns + rightMatrix.Rows + rightMatrix.Columns + bitmap + + processor.RunKernel kernel + + bitmap diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs index 9b9377f0..e3434771 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map.fs @@ -1,6 +1,5 @@ namespace GraphBLAS.FSharp.Backend.Matrix.COO -open System open Brahma.FSharp open GraphBLAS.FSharp.Backend.Matrix open GraphBLAS.FSharp.Backend.Quotes @@ -9,6 +8,7 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Objects.ClMatrix open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions module internal Map = let private preparePositions<'a, 'b> opAdd (clContext: ClContext) workGroupSize = @@ -41,7 +41,7 @@ module internal Map = let kernel = clContext.Compile <| preparePositions opAdd - fun (processor: MailboxProcessor<_>) rowCount columnCount (values: ClArray<'a>) (rowPointers: ClArray) (columns: ClArray) -> + fun (processor: RawCommandQueue) rowCount columnCount (values: ClArray<'a>) (rowPointers: ClArray) (columns: ClArray) -> let (resultLength: int) = columnCount * rowCount @@ -62,24 +62,21 @@ module internal Map = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - rowCount - columnCount - values.Length - values - rowPointers - columns - resultBitmap - resultValues - resultRows - resultColumns) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + + kernel.KernelFunc + ndRange + rowCount + columnCount + values.Length + values + rowPointers + columns + resultBitmap + resultValues + resultRows + resultColumns + + processor.RunKernel kernel resultBitmap, resultValues, resultRows, resultColumns @@ -95,7 +92,7 @@ module internal Map = let setPositions = Common.setPositions<'b> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> + fun (queue: RawCommandQueue) allocationMode (matrix: ClMatrix.COO<'a>) -> let bitmap, values, rows, columns = map queue matrix.RowCount matrix.ColumnCount matrix.Values matrix.Rows matrix.Columns @@ -103,10 +100,10 @@ module internal Map = let resultRows, resultColumns, resultValues, _ = setPositions queue allocationMode rows columns values bitmap - queue.Post(Msg.CreateFreeMsg<_>(bitmap)) - queue.Post(Msg.CreateFreeMsg<_>(values)) - queue.Post(Msg.CreateFreeMsg<_>(rows)) - queue.Post(Msg.CreateFreeMsg<_>(columns)) + bitmap.Free() + values.Free() + rows.Free() + columns.Free() { Context = clContext RowCount = matrix.RowCount diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs index a728d546..33a74edc 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Map2.fs @@ -5,6 +5,7 @@ open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClMatrix open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Backend.Matrix @@ -44,7 +45,7 @@ module internal Map2 = let kernel = clContext.Compile <| preparePositions opAdd - fun (processor: MailboxProcessor<_>) rowCount columnCount (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumns: ClArray) -> + fun (processor: RawCommandQueue) rowCount columnCount (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumns: ClArray) -> let (resultLength: int) = columnCount * rowCount @@ -65,28 +66,24 @@ module internal Map2 = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - rowCount - columnCount - leftValues.Length - rightValues.Length - leftValues - leftRows - leftColumns - rightValues - rightRows - rightColumns - resultBitmap - resultValues - resultRows - resultColumns) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc + ndRange + rowCount + columnCount + leftValues.Length + rightValues.Length + leftValues + leftRows + leftColumns + rightValues + rightRows + rightColumns + resultBitmap + resultValues + resultRows + resultColumns + + processor.RunKernel kernel resultBitmap, resultValues, resultRows, resultColumns @@ -105,7 +102,7 @@ module internal Map2 = let setPositions = Common.setPositions<'c> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> + fun (queue: RawCommandQueue) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> let bitmap, values, rows, columns = map2 @@ -122,10 +119,10 @@ module internal Map2 = let resultRows, resultColumns, resultValues, _ = setPositions queue allocationMode rows columns values bitmap - queue.Post(Msg.CreateFreeMsg<_>(bitmap)) - queue.Post(Msg.CreateFreeMsg<_>(values)) - queue.Post(Msg.CreateFreeMsg<_>(rows)) - queue.Post(Msg.CreateFreeMsg<_>(columns)) + bitmap.Free() + values.Free() + rows.Free() + columns.Free() { Context = clContext RowCount = matrixLeft.RowCount @@ -176,7 +173,7 @@ module internal Map2 = let kernel = clContext.Compile(preparePositions) - fun (processor: MailboxProcessor<_>) (allRows: ClArray) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> + fun (processor: RawCommandQueue) (allRows: ClArray) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> let length = leftValues.Length let ndRange = @@ -190,22 +187,18 @@ module internal Map2 = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - length - allRows - allColumns - leftValues - rightValues - allValues - rawPositionsGpu - isLeft) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + length + allRows + allColumns + leftValues + rightValues + allValues + rawPositionsGpu + isLeft + + processor.RunKernel kernel rawPositionsGpu, allValues @@ -227,7 +220,7 @@ module internal Map2 = let setPositions = Common.setPositions<'c> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> + fun (queue: RawCommandQueue) allocationMode (matrixLeft: ClMatrix.COO<'a>) (matrixRight: ClMatrix.COO<'b>) -> let allRows, allColumns, leftMergedValues, rightMergedValues, isLeft = merge queue matrixLeft matrixRight @@ -235,17 +228,17 @@ module internal Map2 = let rawPositions, allValues = preparePositions queue allRows allColumns leftMergedValues rightMergedValues isLeft - queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues)) - queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues)) + leftMergedValues.Free() + rightMergedValues.Free() let resultRows, resultColumns, resultValues, _ = setPositions queue allocationMode allRows allColumns allValues rawPositions - queue.Post(Msg.CreateFreeMsg<_>(isLeft)) - queue.Post(Msg.CreateFreeMsg<_>(rawPositions)) - queue.Post(Msg.CreateFreeMsg<_>(allRows)) - queue.Post(Msg.CreateFreeMsg<_>(allColumns)) - queue.Post(Msg.CreateFreeMsg<_>(allValues)) + isLeft.Free() + rawPositions.Free() + allRows.Free() + allColumns.Free() + allValues.Free() { Context = clContext RowCount = matrixLeft.RowCount diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs index 327a1b45..9bf0f6ce 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Matrix.fs @@ -8,8 +8,28 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClMatrix open GraphBLAS.FSharp.Objects.ClCellExtensions open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.ClContextExtensions module Matrix = + /// + /// Creates new COO matrix with the values from the given one. + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let copy (clContext: ClContext) workGroupSize = + + let copy = ClArray.copy clContext workGroupSize + + let copyData = ClArray.copy clContext workGroupSize + + fun (processor: RawCommandQueue) allocationMode (matrix: COO<'a>) -> + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + Rows = copy processor allocationMode matrix.Rows matrix.Rows.Length + Columns = copy processor allocationMode matrix.Columns matrix.Columns.Length + Values = copyData processor allocationMode matrix.Values matrix.Values.Length } + /// /// Builds a new COO matrix whose elements are the results of applying the given function /// to each of the elements of the matrix. @@ -63,16 +83,16 @@ module Matrix = let copyData = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.COO<'a>) -> let resultRows = - copy processor allocationMode matrix.Rows + copy processor allocationMode matrix.Rows matrix.Rows.Length let resultColumns = - copy processor allocationMode matrix.Columns + copy processor allocationMode matrix.Columns matrix.Columns.Length let resultValues = - copyData processor allocationMode matrix.Values + copyData processor allocationMode matrix.Values matrix.Values.Length { Context = clContext RowIndices = resultRows @@ -84,7 +104,7 @@ module Matrix = /// /// OpenCL context. /// Should be a power of 2 and greater than 1. - let private compressRows (clContext: ClContext) workGroupSize = + let compressRows (clContext: ClContext) workGroupSize = let compressRows = <@ fun (ndRange: Range1D) (rows: ClArray) (nnz: int) (rowPointers: ClArray) -> @@ -104,7 +124,7 @@ module Matrix = let scan = Common.PrefixSum.runBackwardsIncludeInPlace <@ min @> clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (rowIndices: ClArray) rowCount -> + fun (processor: RawCommandQueue) allocationMode (rowIndices: ClArray) rowCount -> let nnz = rowIndices.Length @@ -114,10 +134,10 @@ module Matrix = let kernel = program.GetKernel() let ndRange = Range1D.CreateValid(nnz, workGroupSize) - processor.Post(Msg.MsgSetArguments(fun () -> kernel.KernelFunc ndRange rowIndices nnz rowPointers)) - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc ndRange rowIndices nnz rowPointers + processor.RunKernel kernel - (scan processor rowPointers nnz).Free processor + (scan processor rowPointers nnz).Free() rowPointers @@ -134,15 +154,15 @@ module Matrix = let copyData = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.COO<'a>) -> let rowPointers = prepare processor allocationMode matrix.Rows matrix.RowCount let cols = - copy processor allocationMode matrix.Columns + copy processor allocationMode matrix.Columns matrix.Columns.Length let values = - copyData processor allocationMode matrix.Values + copyData processor allocationMode matrix.Values matrix.Values.Length { Context = clContext RowCount = matrix.RowCount @@ -160,11 +180,11 @@ module Matrix = let toCSRInPlace (clContext: ClContext) workGroupSize = let prepare = compressRows clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.COO<'a>) -> let rowPointers = prepare processor allocationMode matrix.Rows matrix.RowCount - matrix.Rows.Free processor + matrix.Rows.Free() { Context = clContext RowCount = matrix.RowCount @@ -182,9 +202,9 @@ module Matrix = let transposeInPlace (clContext: ClContext) workGroupSize = let sort = - Common.Sort.Bitonic.sortKeyValuesInplace clContext workGroupSize + Common.Sort.Bitonic.sortRowsColumnsValuesInplace clContext workGroupSize - fun (queue: MailboxProcessor<_>) (matrix: ClMatrix.COO<'a>) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix.COO<'a>) -> sort queue matrix.Columns matrix.Rows matrix.Values { Context = clContext @@ -197,8 +217,8 @@ module Matrix = /// /// Transposes the given matrix and returns result as a new matrix. /// - ///OpenCL context. - ///Should be a power of 2 and greater than 1. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. let transpose (clContext: ClContext) workGroupSize = let transposeInPlace = transposeInPlace clContext workGroupSize @@ -207,12 +227,115 @@ module Matrix = let copyData = ClArray.copy clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> + fun (queue: RawCommandQueue) allocationMode (matrix: ClMatrix.COO<'a>) -> { Context = clContext RowCount = matrix.RowCount ColumnCount = matrix.ColumnCount - Rows = copy queue allocationMode matrix.Rows - Columns = copy queue allocationMode matrix.Columns - Values = copyData queue allocationMode matrix.Values } + Rows = copy queue allocationMode matrix.Rows matrix.Rows.Length + Columns = copy queue allocationMode matrix.Columns matrix.Columns.Length + Values = copyData queue allocationMode matrix.Values matrix.Values.Length } |> transposeInPlace queue + + /// + /// Builds a bitmap. Maps non-zero elements of the left matrix + /// to 1 if the right matrix has non zero element under the same row and column pair, otherwise 0. + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let findKeysIntersection (clContext: ClContext) workGroupSize = + Intersect.findKeysIntersection clContext workGroupSize + + /// + /// Merges two disjoint matrices of the same size. + /// + /// + /// Matrices should have the same number of rows and columns.
+ /// Matrices should not have non zero values with the same index. + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let mergeDisjoint (clContext: ClContext) workGroupSize = + Merge.runDisjoint clContext workGroupSize + + let ofList (clContext: ClContext) allocationMode rowCount columnCount (elements: (int * int * 'a) list) = + let rows, columns, values = + let elements = elements |> Array.ofList + + elements + |> Array.sortInPlaceBy (fun (x, _, _) -> x) + + elements |> Array.unzip3 + + { Context = clContext + Rows = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, rows) + Columns = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, columns) + Values = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, values) + RowCount = rowCount + ColumnCount = columnCount } + + /// + /// Returns matrix composed of all elements from the given row range of the input matrix. + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let subRows (clContext: ClContext) workGroupSize = + + let upperBound = + ClArray.upperBound clContext workGroupSize + + let blit = ClArray.blit clContext workGroupSize + + let blitData = ClArray.blit clContext workGroupSize + + fun (processor: RawCommandQueue) allocationMode startRow count (matrix: ClMatrix.COO<'a>) -> + if count <= 0 then + failwith "Count must be greater than zero" + + if startRow < 0 then + failwith "startIndex must be greater then zero" + + if startRow + count > matrix.RowCount then + failwith "startIndex and count sum is larger than the matrix row count" + + let firstRowClCell = clContext.CreateClCell(startRow - 1) + let lastRowClCell = clContext.CreateClCell(startRow + count) + + // extract rows + let firstIndex = + (upperBound processor matrix.Rows firstRowClCell) + .ToHostAndFree processor + + let lastIndex = + (upperBound processor matrix.Rows lastRowClCell) + .ToHostAndFree processor + - 1 + + firstRowClCell.Free() + lastRowClCell.Free() + + let resultLength = lastIndex - firstIndex + 1 + + let rows = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + blit processor matrix.Columns firstIndex rows 0 resultLength + + // extract values + let values = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + blitData processor matrix.Values firstIndex values 0 resultLength + + // extract indices + let columns = + clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultLength) + + blit processor matrix.Columns firstIndex columns 0 resultLength + + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + Rows = rows + Columns = columns + Values = values } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COO/Merge.fs b/src/GraphBLAS-sharp.Backend/Matrix/COO/Merge.fs index 5e847976..340d9db2 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COO/Merge.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COO/Merge.fs @@ -1,8 +1,10 @@ namespace GraphBLAS.FSharp.Backend.Matrix.COO open Brahma.FSharp -open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ClMatrix +open GraphBLAS.FSharp.Objects.ArraysExtensions module Merge = let run<'a, 'b when 'a: struct and 'b: struct> (clContext: ClContext) workGroupSize = @@ -130,7 +132,7 @@ module Merge = let kernel = clContext.Compile(merge) - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.COO<'b>) -> + fun (processor: RawCommandQueue) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.COO<'b>) -> let firstSide = leftMatrix.Columns.Length let secondSide = rightMatrix.Columns.Length @@ -156,27 +158,66 @@ module Merge = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - firstSide - secondSide - sumOfSides - leftMatrix.Rows - leftMatrix.Columns - leftMatrix.Values - rightMatrix.Rows - rightMatrix.Columns - rightMatrix.Values - allRows - allColumns - leftMergedValues - rightMergedValues - isLeft) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + firstSide + secondSide + sumOfSides + leftMatrix.Rows + leftMatrix.Columns + leftMatrix.Values + rightMatrix.Rows + rightMatrix.Columns + rightMatrix.Values + allRows + allColumns + leftMergedValues + rightMergedValues + isLeft + + processor.RunKernel kernel allRows, allColumns, leftMergedValues, rightMergedValues, isLeft + + let runDisjoint<'a when 'a: struct> (clContext: ClContext) workGroupSize = + + let mergeValues = + <@ fun (ndRange: Range1D) (length: int) (leftValues: ClArray<'a>) (rightValues: ClArray<'a>) (isLeft: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + + if isLeft.[gid] = 0 then + leftValues.[gid] <- rightValues.[gid] @> + + let mergeValuesKernel = clContext.Compile(mergeValues) + + let merge = run clContext workGroupSize + + fun (processor: RawCommandQueue) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.COO<'a>) -> + + let length = + leftMatrix.Columns.Length + + rightMatrix.Columns.Length + + let rows, cols, leftValues, rightValues, isLeft = merge processor leftMatrix rightMatrix + + let ndRange = + Range1D.CreateValid(length, workGroupSize) + + let mergeValuesKernel = mergeValuesKernel.GetKernel() + + mergeValuesKernel.KernelFunc ndRange length leftValues rightValues isLeft + + processor.RunKernel(mergeValuesKernel) + + isLeft.Free() + rightValues.Free() + + { Context = clContext + Rows = rows + Columns = cols + Values = leftValues + ColumnCount = leftMatrix.ColumnCount + RowCount = leftMatrix.RowCount } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs index 8d068d09..2d407992 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map.fs @@ -41,7 +41,7 @@ module internal Map = let kernel = clContext.Compile <| preparePositions op - fun (processor: MailboxProcessor<_>) rowCount columnCount (values: ClArray<'a>) (rowPointers: ClArray) (columns: ClArray) -> + fun (processor: RawCommandQueue) rowCount columnCount (values: ClArray<'a>) (rowPointers: ClArray) (columns: ClArray) -> let (resultLength: int) = columnCount * rowCount @@ -62,23 +62,19 @@ module internal Map = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - rowCount - columnCount - values - rowPointers - columns - resultBitmap - resultValues - resultRows - resultColumns) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc + ndRange + rowCount + columnCount + values + rowPointers + columns + resultBitmap + resultValues + resultRows + resultColumns + + processor.RunKernel kernel resultBitmap, resultValues, resultRows, resultColumns @@ -94,7 +90,7 @@ module internal Map = let setPositions = Common.setPositions<'b> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (queue: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> let bitmap, values, rows, columns = map queue matrix.RowCount matrix.ColumnCount matrix.Values matrix.RowPointers matrix.Columns @@ -102,10 +98,10 @@ module internal Map = let resultRows, resultColumns, resultValues, _ = setPositions queue allocationMode rows columns values bitmap - bitmap.Free queue - values.Free queue - rows.Free queue - columns.Free queue + bitmap.Free() + values.Free() + rows.Free() + columns.Free() { Context = clContext RowCount = matrix.RowCount @@ -144,7 +140,7 @@ module internal Map = let kernel = clContext.Compile <| preparePositions op - fun (processor: MailboxProcessor<_>) (operand: ClCell<'a option>) (matrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) (operand: ClCell<'a option>) (matrix: ClMatrix.CSR<'b>) -> let resultLength = matrix.RowCount * matrix.ColumnCount @@ -165,24 +161,20 @@ module internal Map = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - operand - matrix.RowCount - matrix.ColumnCount - matrix.Values - matrix.RowPointers - matrix.Columns - resultBitmap - resultValues - resultRows - resultColumns) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc + ndRange + operand + matrix.RowCount + matrix.ColumnCount + matrix.Values + matrix.RowPointers + matrix.Columns + resultBitmap + resultValues + resultRows + resultColumns + + processor.RunKernel kernel resultBitmap, resultValues, resultRows, resultColumns @@ -198,20 +190,20 @@ module internal Map = let setPositions = Common.setPositionsOption<'c> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (value: 'a option) (matrix: ClMatrix.CSR<'b>) -> + fun (queue: RawCommandQueue) allocationMode (value: 'a option) (matrix: ClMatrix.CSR<'b>) -> let valueClCell = clContext.CreateClCell value let bitmap, values, rows, columns = mapWithValue queue valueClCell matrix - valueClCell.Free queue + valueClCell.Free() let result = setPositions queue allocationMode rows columns values bitmap - bitmap.Free queue - values.Free queue - rows.Free queue - columns.Free queue + bitmap.Free() + values.Free() + rows.Free() + columns.Free() result |> Option.map diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs index 70599c16..4e0b9322 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Map2.fs @@ -8,6 +8,7 @@ open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClMatrix open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions module internal Map2 = let private preparePositions<'a, 'b, 'c> opAdd (clContext: ClContext) workGroupSize = @@ -46,7 +47,7 @@ module internal Map2 = let kernel = clContext.Compile <| preparePositions opAdd - fun (processor: MailboxProcessor<_>) rowCount columnCount (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumns: ClArray) -> + fun (processor: RawCommandQueue) rowCount columnCount (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumns: ClArray) -> let (resultLength: int) = columnCount * rowCount @@ -67,26 +68,22 @@ module internal Map2 = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - rowCount - columnCount - leftValues - leftRows - leftColumns - rightValues - rightRows - rightColumns - resultBitmap - resultValues - resultRows - resultColumns) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc + ndRange + rowCount + columnCount + leftValues + leftRows + leftColumns + rightValues + rightRows + rightColumns + resultBitmap + resultValues + resultRows + resultColumns + + processor.RunKernel kernel resultBitmap, resultValues, resultRows, resultColumns @@ -105,7 +102,7 @@ module internal Map2 = let setPositions = Common.setPositions<'c> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> + fun (queue: RawCommandQueue) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> let bitmap, values, rows, columns = map2 @@ -122,10 +119,10 @@ module internal Map2 = let resultRows, resultColumns, resultValues, _ = setPositions queue allocationMode rows columns values bitmap - queue.Post(Msg.CreateFreeMsg<_>(bitmap)) - queue.Post(Msg.CreateFreeMsg<_>(values)) - queue.Post(Msg.CreateFreeMsg<_>(rows)) - queue.Post(Msg.CreateFreeMsg<_>(columns)) + bitmap.Free() + values.Free() + rows.Free() + columns.Free() { Context = clContext RowCount = matrixLeft.RowCount @@ -166,7 +163,7 @@ module internal Map2 = let kernel = clContext.Compile(preparePositions) - fun (processor: MailboxProcessor<_>) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isEndOfRow: ClArray) (isLeft: ClArray) -> + fun (processor: RawCommandQueue) (allColumns: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isEndOfRow: ClArray) (isLeft: ClArray) -> let length = leftValues.Length let ndRange = @@ -180,22 +177,18 @@ module internal Map2 = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - length - allColumns - leftValues - rightValues - allValues - rowPositions - isEndOfRow - isLeft) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + length + allColumns + leftValues + rightValues + allValues + rowPositions + isEndOfRow + isLeft + + processor.RunKernel kernel rowPositions, allValues let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> @@ -212,7 +205,7 @@ module internal Map2 = let setPositions = Common.setPositions<'c> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> + fun (queue: RawCommandQueue) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> let allRows, allColumns, leftMergedValues, rightMergedValues, isRowEnd, isLeft = merge queue matrixLeft matrixRight @@ -220,18 +213,18 @@ module internal Map2 = let positions, allValues = preparePositions queue allColumns leftMergedValues rightMergedValues isRowEnd isLeft - queue.Post(Msg.CreateFreeMsg<_>(leftMergedValues)) - queue.Post(Msg.CreateFreeMsg<_>(rightMergedValues)) + leftMergedValues.Free() + rightMergedValues.Free() let resultRows, resultColumns, resultValues, _ = setPositions queue allocationMode allRows allColumns allValues positions - queue.Post(Msg.CreateFreeMsg<_>(allRows)) - queue.Post(Msg.CreateFreeMsg<_>(isLeft)) - queue.Post(Msg.CreateFreeMsg<_>(isRowEnd)) - queue.Post(Msg.CreateFreeMsg<_>(positions)) - queue.Post(Msg.CreateFreeMsg<_>(allColumns)) - queue.Post(Msg.CreateFreeMsg<_>(allValues)) + allRows.Free() + isLeft.Free() + isRowEnd.Free() + positions.Free() + allColumns.Free() + allValues.Free() { Context = clContext RowCount = matrixLeft.RowCount diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs index 7373a0d7..06d8ee7a 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Matrix.fs @@ -32,7 +32,7 @@ module Matrix = let program = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> let rows = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, matrix.Columns.Length) @@ -42,18 +42,9 @@ module Matrix = let ndRange = Range1D.CreateValid(matrix.Columns.Length, workGroupSize) - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - matrix.Columns.Length - matrix.RowPointers.Length - matrix.RowPointers - rows) - ) + kernel.KernelFunc ndRange matrix.Columns.Length matrix.RowPointers.Length matrix.RowPointers rows - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.RunKernel kernel rows @@ -77,7 +68,7 @@ module Matrix = let program = clContext.Compile kernel - fun (processor: MailboxProcessor<_>) (row: int) (column: int) (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) (row: int) (column: int) (matrix: ClMatrix.CSR<'a>) -> if row < 0 || row >= matrix.RowCount then failwith "Row out of range" @@ -91,13 +82,9 @@ module Matrix = let ndRange = Range1D.CreateValid(1, workGroupSize) - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc ndRange row column matrix.RowPointers matrix.Columns matrix.Values result) - ) + kernel.KernelFunc ndRange row column matrix.RowPointers matrix.Columns matrix.Values result - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.RunKernel kernel result @@ -128,7 +115,7 @@ module Matrix = let blitData = ClArray.blit clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode startIndex count (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) allocationMode startIndex count (matrix: ClMatrix.CSR<'a>) -> if count <= 0 then failwith "Count must be greater than zero" @@ -153,19 +140,9 @@ module Matrix = let ndRange = Range1D.CreateValid(matrix.Columns.Length, workGroupSize) - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - resultLength - startIndex - matrix.RowPointers.Length - matrix.RowPointers - rows) - ) + kernel.KernelFunc ndRange resultLength startIndex matrix.RowPointers.Length matrix.RowPointers rows - processor.Post(Msg.CreateRunMsg<_, _> kernel) + processor.RunKernel kernel let startPosition = rowPointers.[startIndex] @@ -202,14 +179,14 @@ module Matrix = let copyData = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> let rows = prepare processor allocationMode matrix let cols = - copy processor allocationMode matrix.Columns + copy processor allocationMode matrix.Columns matrix.Columns.Length let values = - copyData processor allocationMode matrix.Values + copyData processor allocationMode matrix.Values matrix.Values.Length { Context = clContext RowCount = matrix.RowCount @@ -228,10 +205,10 @@ module Matrix = let prepare = expandRowPointers clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> let rows = prepare processor allocationMode matrix - processor.Post(Msg.CreateFreeMsg(matrix.RowPointers)) + matrix.RowPointers.Free() { Context = clContext RowCount = matrix.RowCount @@ -298,7 +275,7 @@ module Matrix = let toCSRInPlace = COO.Matrix.toCSRInPlace clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (queue: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> toCOOInPlace queue allocationMode matrix |> transposeInPlace queue |> toCSRInPlace queue allocationMode @@ -318,7 +295,7 @@ module Matrix = let toCSRInPlace = COO.Matrix.toCSRInPlace clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (queue: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> toCOO queue allocationMode matrix |> transposeInPlace queue |> toCSRInPlace queue allocationMode @@ -334,7 +311,7 @@ module Matrix = let getChunkIndices = ClArray.sub clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> let getChunkValues = getChunkValues processor allocationMode matrix.Values @@ -372,7 +349,7 @@ module Matrix = let runLazy = byRowsLazy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> runLazy processor allocationMode matrix |> Seq.map (fun lazyValue -> lazyValue.Value) @@ -385,7 +362,7 @@ module Matrix = let byRows = byRows clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) -> let rows = byRows processor allocationMode matrix |> Seq.toList @@ -393,8 +370,7 @@ module Matrix = { Context = clContext RowCount = matrix.RowCount ColumnCount = matrix.ColumnCount - Rows = rows - NNZ = matrix.NNZ } + Rows = rows } /// /// Gets the number of non-zero elements in each row. @@ -406,9 +382,9 @@ module Matrix = let pairwise = ClArray.pairwise clContext workGroupSize let subtract = - ClArray.map <@ fun (fst, snd) -> snd - fst @> clContext workGroupSize + Backend.Common.Map.map <@ fun (fst, snd) -> snd - fst @> clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'b>) -> let pointerPairs = pairwise processor DeviceOnly matrix.RowPointers // since row pointers length in matrix always >= 2 @@ -418,6 +394,6 @@ module Matrix = let rowsLength = subtract processor allocationMode pointerPairs - pointerPairs.Free processor + pointerPairs.Free() rowsLength diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Merge.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Merge.fs index 8376053e..373cbceb 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSR/Merge.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSR/Merge.fs @@ -161,7 +161,7 @@ module Merge = let kernel = clContext.Compile(merge) - fun (processor: MailboxProcessor<_>) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> let firstLength = leftMatrix.Columns.Length let secondLength = rightMatrix.Columns.Length @@ -194,25 +194,21 @@ module Merge = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - leftMatrix.RowPointers - leftMatrix.Columns - leftMatrix.Values - rightMatrix.RowPointers - rightMatrix.Columns - rightMatrix.Values - allRows - allColumns - leftMergedValues - rightMergedValues - isEndOfRow - isLeft) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + leftMatrix.RowPointers + leftMatrix.Columns + leftMatrix.Values + rightMatrix.RowPointers + rightMatrix.Columns + rightMatrix.Values + allRows + allColumns + leftMergedValues + rightMergedValues + isEndOfRow + isLeft + + processor.RunKernel kernel allRows, allColumns, leftMergedValues, rightMergedValues, isEndOfRow, isLeft diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs index e13b889e..f77cd6bc 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Common.fs @@ -19,7 +19,7 @@ module internal Common = let sum = Common.PrefixSum.standardExcludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (allRows: ClArray) (allColumns: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> + fun (processor: RawCommandQueue) allocationMode (allRows: ClArray) (allColumns: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> let resultLength = (sum processor positions).ToHostAndFree(processor) @@ -54,7 +54,7 @@ module internal Common = let sum = Common.PrefixSum.standardExcludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (allRows: ClArray) (allColumns: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> + fun (processor: RawCommandQueue) allocationMode (allRows: ClArray) (allColumns: ClArray) (allValues: ClArray<'a>) (positions: ClArray) -> let resultLength = (sum processor positions).ToHostAndFree(processor) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs index 838fdead..5435a6d8 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/LIL/Matrix.fs @@ -2,6 +2,7 @@ namespace GraphBLAS.FSharp.Backend.Matrix.LIL open Brahma.FSharp open GraphBLAS.FSharp +open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClMatrix open GraphBLAS.FSharp.Objects.ClContextExtensions @@ -12,7 +13,7 @@ module Matrix = let concatValues = ClArray.concat clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: LIL<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: LIL<'a>) -> let rowsPointers = matrix.Rows @@ -43,3 +44,9 @@ module Matrix = RowPointers = rowsPointers Columns = columnsIndices Values = values } + + let ofVectors (clContext: ClContext) rowCount columnCount (vectors: ClVector.Sparse<_> option list) = + { Context = clContext + RowCount = rowCount + ColumnCount = columnCount + Rows = vectors } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index c56ec5ea..3af45c69 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -1,7 +1,6 @@ namespace GraphBLAS.FSharp open Brahma.FSharp -open Microsoft.FSharp.Quotations open GraphBLAS.FSharp open GraphBLAS.FSharp.Backend.Matrix open GraphBLAS.FSharp.Backend.Vector @@ -25,32 +24,32 @@ module Matrix = let vectorCopy = Sparse.Vector.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO m -> ClMatrix.COO { Context = clContext RowCount = m.RowCount ColumnCount = m.ColumnCount - Rows = copy processor allocationMode m.Rows - Columns = copy processor allocationMode m.Columns - Values = copyData processor allocationMode m.Values } + Rows = copy processor allocationMode m.Rows m.Rows.Length + Columns = copy processor allocationMode m.Columns m.Columns.Length + Values = copyData processor allocationMode m.Values m.Values.Length } | ClMatrix.CSR m -> ClMatrix.CSR { Context = clContext RowCount = m.RowCount ColumnCount = m.ColumnCount - RowPointers = copy processor allocationMode m.RowPointers - Columns = copy processor allocationMode m.Columns - Values = copyData processor allocationMode m.Values } + RowPointers = copy processor allocationMode m.RowPointers m.RowPointers.Length + Columns = copy processor allocationMode m.Columns m.Columns.Length + Values = copyData processor allocationMode m.Values m.Values.Length } | ClMatrix.CSC m -> ClMatrix.CSC { Context = clContext RowCount = m.RowCount ColumnCount = m.ColumnCount - Rows = copy processor allocationMode m.Rows - ColumnPointers = copy processor allocationMode m.ColumnPointers - Values = copyData processor allocationMode m.Values } + Rows = copy processor allocationMode m.Rows m.Rows.Length + ColumnPointers = copy processor allocationMode m.ColumnPointers m.ColumnPointers.Length + Values = copyData processor allocationMode m.Values m.Values.Length } | ClMatrix.LIL matrix -> matrix.Rows |> List.map (Option.map (vectorCopy processor allocationMode)) @@ -58,10 +57,53 @@ module Matrix = { Context = clContext RowCount = matrix.RowCount ColumnCount = matrix.ColumnCount - Rows = rows - NNZ = matrix.NNZ } + Rows = rows } |> ClMatrix.LIL + /// + /// Creates new matrix with the values from the given one. + /// New matrix represented in the format of the given one. + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let copyTo (clContext: ClContext) workGroupSize = + + let copyTo = ClArray.copyTo clContext workGroupSize + + let copyDataTo = ClArray.copyTo clContext workGroupSize + + let vectorCopyTo = + Sparse.Vector.copyTo clContext workGroupSize + + fun (processor: RawCommandQueue) (source: ClMatrix<'a>) (destination: ClMatrix<'a>) -> + if source.NNZ <> destination.NNZ + || source.RowCount <> destination.RowCount + || source.ColumnCount <> destination.ColumnCount then + failwith "Two matrices are not of the same size or they have different number of non-zero elements" + + match source, destination with + | ClMatrix.COO s, ClMatrix.COO d -> + copyTo processor s.Rows d.Rows + copyTo processor s.Columns d.Columns + copyDataTo processor s.Values d.Values + | ClMatrix.CSR s, ClMatrix.CSR d -> + copyTo processor s.RowPointers d.RowPointers + copyTo processor s.Columns d.Columns + copyDataTo processor s.Values d.Values + | ClMatrix.CSC s, ClMatrix.CSC d -> + copyTo processor s.Rows d.Rows + copyTo processor s.ColumnPointers d.ColumnPointers + copyDataTo processor s.Values d.Values + | ClMatrix.LIL s, ClMatrix.LIL d -> + List.iter2 + (fun sourceVector destinationVector -> + match sourceVector, destinationVector with + | Some sv, Some dv -> vectorCopyTo processor sv dv + | _ -> failwith "Vectors of LIL matrix are not of the same size") + s.Rows + d.Rows + | _ -> failwith "Matrix formats are not matching" + /// /// Creates a new matrix, represented in CSR format, that is equal to the given one. /// @@ -77,7 +119,7 @@ module Matrix = let rowsToCSR = LIL.Matrix.toCSR clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO m -> toCSR processor allocationMode m |> ClMatrix.CSR | ClMatrix.CSR _ -> copy processor allocationMode matrix @@ -102,7 +144,7 @@ module Matrix = let transposeInPlace = CSR.Matrix.transposeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO m -> toCSRInPlace processor allocationMode m @@ -129,7 +171,7 @@ module Matrix = let rowsToCSR = LIL.Matrix.toCSR clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO _ -> copy processor allocationMode matrix | ClMatrix.CSR m -> toCOO processor allocationMode m |> ClMatrix.COO @@ -156,7 +198,7 @@ module Matrix = let transposeInPlace = COO.Matrix.transposeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.COO _ -> matrix | ClMatrix.CSR m -> @@ -187,7 +229,7 @@ module Matrix = let rowsToCSR = LIL.Matrix.toCSR clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.CSC _ -> copy processor allocationMode matrix | ClMatrix.CSR m -> @@ -220,7 +262,7 @@ module Matrix = let transposeCOOInPlace = COO.Matrix.transposeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.CSC _ -> matrix | ClMatrix.CSR m -> @@ -250,7 +292,7 @@ module Matrix = let CSRToLIL = CSR.Matrix.toLIL clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (matrix: ClMatrix<'a>) -> + fun (processor: RawCommandQueue) allocationMode (matrix: ClMatrix<'a>) -> match matrix with | ClMatrix.CSC m -> m.ToCSR @@ -273,9 +315,9 @@ module Matrix = /// /// /// The format changes according to the following: - /// * COO -> COO - /// * CSR -> CSC - /// * CSC -> CSR + /// * COO -> COO
+ /// * CSR -> CSC
+ /// * CSC -> CSR
/// ///OpenCL context. ///Should be a power of 2 and greater than 1. @@ -283,7 +325,7 @@ module Matrix = let COOTransposeInPlace = COO.Matrix.transposeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) matrix -> + fun (processor: RawCommandQueue) matrix -> match matrix with | ClMatrix.COO m -> COOTransposeInPlace processor m |> ClMatrix.COO | ClMatrix.CSR m -> ClMatrix.CSC m.ToCSC @@ -296,12 +338,12 @@ module Matrix = /// /// /// The format changes according to the following: - /// * COO -> COO - /// * CSR -> CSC - /// * CSC -> CSR + /// * COO -> COO
+ /// * CSR -> CSC
+ /// * CSC -> CSR
/// - ///OpenCL context. - ///Should be a power of 2 and greater than 1. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. let transpose (clContext: ClContext) workGroupSize = let COOTranspose = COO.Matrix.transpose clContext workGroupSize @@ -310,7 +352,7 @@ module Matrix = let copyData = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode matrix -> + fun (processor: RawCommandQueue) allocationMode matrix -> match matrix with | ClMatrix.COO m -> COOTranspose processor allocationMode m @@ -319,16 +361,23 @@ module Matrix = { Context = m.Context RowCount = m.ColumnCount ColumnCount = m.RowCount - Rows = copy processor allocationMode m.Columns - ColumnPointers = copy processor allocationMode m.RowPointers - Values = copyData processor allocationMode m.Values } + Rows = copy processor allocationMode m.Columns m.Columns.Length + ColumnPointers = copy processor allocationMode m.RowPointers m.RowPointers.Length + Values = copyData processor allocationMode m.Values m.Values.Length } |> ClMatrix.CSC | ClMatrix.CSC m -> { Context = m.Context RowCount = m.ColumnCount ColumnCount = m.RowCount - RowPointers = copy processor allocationMode m.ColumnPointers - Columns = copy processor allocationMode m.Rows - Values = copyData processor allocationMode m.Values } + RowPointers = copy processor allocationMode m.ColumnPointers m.ColumnPointers.Length + Columns = copy processor allocationMode m.Rows m.Rows.Length + Values = copyData processor allocationMode m.Values m.Values.Length } |> ClMatrix.CSR | ClMatrix.LIL _ -> failwith "Not yet implemented" + + let ofList (clContext: ClContext) allocationMode format rowCount columnCount (elements: (int * int * 'a) list) = + match format with + | COO -> + COO.Matrix.ofList clContext allocationMode rowCount columnCount elements + |> ClMatrix.COO + | _ -> failwith "Not implemented" diff --git a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs index 5f5da3ae..bc628250 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ArraysExtentions.fs @@ -4,19 +4,20 @@ open Brahma.FSharp module ArraysExtensions = type ClArray<'a> with - member this.FreeAndWait(q: MailboxProcessor) = - q.Post(Msg.CreateFreeMsg this) - q.PostAndReply(Msg.MsgNotifyMe) + member this.FreeAndWait(q: RawCommandQueue) = + this.Dispose() + q.Synchronize() - member this.ToHost(q: MailboxProcessor) = + member this.ToHost(q: RawCommandQueue) = let dst = Array.zeroCreate this.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(this, dst, ch)) + q.ToHost(this, dst, true) + dst - member this.Free(q: MailboxProcessor<_>) = q.Post <| Msg.CreateFreeMsg this + member this.Free() = this.Dispose() - member this.ToHostAndFree(q: MailboxProcessor<_>) = + member this.ToHostAndFree(q: RawCommandQueue) = let result = this.ToHost q - this.Free q + this.Free() result diff --git a/src/GraphBLAS-sharp.Backend/Objects/ClCellExtensions.fs b/src/GraphBLAS-sharp.Backend/Objects/ClCellExtensions.fs index 20334aae..f6d44184 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/ClCellExtensions.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/ClCellExtensions.fs @@ -4,14 +4,15 @@ open Brahma.FSharp module ClCellExtensions = type ClCell<'a> with - member this.ToHost(processor: MailboxProcessor<_>) = - processor.PostAndReply(fun ch -> Msg.CreateToHostMsg<_>(this, (Array.zeroCreate<'a> 1), ch)).[0] + member this.ToHost(processor: RawCommandQueue) = + let res = Array.zeroCreate<'a> 1 + processor.ToHost(this, res, true) + res.[0] - member this.Free(processor: MailboxProcessor<_>) = - processor.Post(Msg.CreateFreeMsg<_>(this)) + member this.Free() = this.Dispose() - member this.ToHostAndFree(processor: MailboxProcessor<_>) = + member this.ToHostAndFree(processor: RawCommandQueue) = let result = this.ToHost processor - this.Free processor + this.Dispose() result diff --git a/src/GraphBLAS-sharp.Backend/Objects/Common.fs b/src/GraphBLAS-sharp.Backend/Objects/Common.fs index 9efb172a..8c722ee0 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Common.fs @@ -3,4 +3,4 @@ open Brahma.FSharp type IDeviceMemObject = - abstract Dispose : MailboxProcessor -> unit + abstract Dispose : unit -> unit diff --git a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs index 9a0af0c6..24062848 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Matrix.fs @@ -19,13 +19,12 @@ module ClMatrix = Values: ClArray<'elem> } interface IDeviceMemObject with - member this.Dispose q = - q.Post(Msg.CreateFreeMsg<_>(this.Values)) - q.Post(Msg.CreateFreeMsg<_>(this.Columns)) - q.Post(Msg.CreateFreeMsg<_>(this.RowPointers)) - q.PostAndReply(Msg.MsgNotifyMe) + member this.Dispose() = + this.Values.Dispose() + this.Columns.Dispose() + this.RowPointers.Dispose() - member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.Dispose() = (this :> IDeviceMemObject).Dispose() member this.NNZ = this.Values.Length @@ -46,13 +45,12 @@ module ClMatrix = Values: ClArray<'elem> } interface IDeviceMemObject with - member this.Dispose q = - q.Post(Msg.CreateFreeMsg<_>(this.Values)) - q.Post(Msg.CreateFreeMsg<_>(this.Rows)) - q.Post(Msg.CreateFreeMsg<_>(this.ColumnPointers)) - q.PostAndReply(Msg.MsgNotifyMe) + member this.Dispose() = + this.Values.Dispose() + this.Rows.Dispose() + this.ColumnPointers.Dispose() - member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.Dispose() = (this :> IDeviceMemObject).Dispose() member this.NNZ = this.Values.Length @@ -73,13 +71,12 @@ module ClMatrix = Values: ClArray<'elem> } interface IDeviceMemObject with - member this.Dispose q = - q.Post(Msg.CreateFreeMsg<_>(this.Values)) - q.Post(Msg.CreateFreeMsg<_>(this.Columns)) - q.Post(Msg.CreateFreeMsg<_>(this.Rows)) - q.PostAndReply(Msg.MsgNotifyMe) + member this.Dispose() = + this.Values.Dispose() + this.Columns.Dispose() + this.Rows.Dispose() - member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.Dispose() = (this :> IDeviceMemObject).Dispose() member this.NNZ = this.Values.Length @@ -87,14 +84,22 @@ module ClMatrix = { Context: ClContext RowCount: int ColumnCount: int - Rows: ClVector.Sparse<'elem> option list - NNZ: int } + Rows: ClVector.Sparse<'elem> option list } interface IDeviceMemObject with - member this.Dispose q = + member this.Dispose() = this.Rows |> Seq.choose id - |> Seq.iter (fun vector -> vector.Dispose q) + |> Seq.iter (fun vector -> vector.Dispose()) + + member this.NNZ = + this.Rows + |> List.fold + (fun acc row -> + match row with + | Some r -> acc + r.NNZ + | None -> acc) + 0 type Tuple<'elem when 'elem: struct> = { Context: ClContext @@ -103,13 +108,12 @@ module ClMatrix = Values: ClArray<'elem> } interface IDeviceMemObject with - member this.Dispose q = - q.Post(Msg.CreateFreeMsg<_>(this.RowIndices)) - q.Post(Msg.CreateFreeMsg<_>(this.ColumnIndices)) - q.Post(Msg.CreateFreeMsg<_>(this.Values)) - q.PostAndReply(Msg.MsgNotifyMe) + member this.Dispose() = + this.RowIndices.Dispose() + this.ColumnIndices.Dispose() + this.Values.Dispose() - member this.Dispose q = (this :> IDeviceMemObject).Dispose q + member this.Dispose() = (this :> IDeviceMemObject).Dispose() member this.NNZ = this.Values.Length @@ -158,12 +162,12 @@ type ClMatrix<'a when 'a: struct> = /// /// Release device resources allocated for the matrix. /// - member this.Dispose q = + member this.Dispose() = match this with - | ClMatrix.CSR matrix -> (matrix :> IDeviceMemObject).Dispose q - | ClMatrix.COO matrix -> (matrix :> IDeviceMemObject).Dispose q - | ClMatrix.CSC matrix -> (matrix :> IDeviceMemObject).Dispose q - | ClMatrix.LIL matrix -> (matrix :> IDeviceMemObject).Dispose q + | ClMatrix.CSR matrix -> (matrix :> IDeviceMemObject).Dispose() + | ClMatrix.COO matrix -> (matrix :> IDeviceMemObject).Dispose() + | ClMatrix.CSC matrix -> (matrix :> IDeviceMemObject).Dispose() + | ClMatrix.LIL matrix -> (matrix :> IDeviceMemObject).Dispose() /// /// Gets the number of non-zero elements in matrix. diff --git a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs index 82e25d8d..4d100afa 100644 --- a/src/GraphBLAS-sharp.Backend/Objects/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Objects/Vector.fs @@ -15,12 +15,11 @@ module ClVector = Size: int } interface IDeviceMemObject with - member this.Dispose(q) = - q.Post(Msg.CreateFreeMsg<_>(this.Values)) - q.Post(Msg.CreateFreeMsg<_>(this.Indices)) - q.PostAndReply(Msg.MsgNotifyMe) + member this.Dispose() = + this.Values.Dispose() + this.Indices.Dispose() - member this.Dispose(q) = (this :> IDeviceMemObject).Dispose(q) + member this.Dispose() = (this :> IDeviceMemObject).Dispose() member this.NNZ = this.Values.Length @@ -49,7 +48,7 @@ type ClVector<'a when 'a: struct> = /// /// Release device resources allocated for the vector. /// - member this.Dispose(q) = + member this.Dispose() = match this with - | Sparse vector -> vector.Dispose(q) - | Dense vector -> vector.FreeAndWait(q) + | Sparse vector -> vector.Dispose() + | Dense vector -> vector.Free() diff --git a/src/GraphBLAS-sharp.Backend/Operations/Kronecker.fs b/src/GraphBLAS-sharp.Backend/Operations/Kronecker.fs index 9ff810bf..aa1469df 100644 --- a/src/GraphBLAS-sharp.Backend/Operations/Kronecker.fs +++ b/src/GraphBLAS-sharp.Backend/Operations/Kronecker.fs @@ -41,7 +41,7 @@ module internal Kronecker = let updateBitmap = clContext.Compile <| updateBitmap op - fun (processor: MailboxProcessor<_>) (operand: ClCell<'a>) (matrixRight: CSR<'b>) (bitmap: ClArray) -> + fun (processor: RawCommandQueue) (operand: ClCell<'a>) (matrixRight: CSR<'b>) (bitmap: ClArray) -> let resultLength = matrixRight.NNZ + 1 @@ -54,13 +54,9 @@ module internal Kronecker = matrixRight.ColumnCount * matrixRight.RowCount - matrixRight.NNZ - processor.Post( - Msg.MsgSetArguments - (fun () -> - updateBitmap.KernelFunc ndRange operand matrixRight.NNZ numberOfZeros matrixRight.Values bitmap) - ) + updateBitmap.KernelFunc ndRange operand matrixRight.NNZ numberOfZeros matrixRight.Values bitmap - processor.Post(Msg.CreateRunMsg<_, _> updateBitmap) + processor.RunKernel(updateBitmap) let private getAllocationSize (clContext: ClContext) workGroupSize op = @@ -76,7 +72,7 @@ module internal Kronecker = let opOnHost = op.Evaluate() - fun (queue: MailboxProcessor<_>) (matrixZero: COO<'c> option) (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> + fun (queue: RawCommandQueue) (matrixZero: COO<'c> option) (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> let nnz = match opOnHost None None with @@ -100,11 +96,11 @@ module internal Kronecker = updateBitmap queue value matrixRight bitmap - value.Free queue + value.Free() let bitmapSum = sum queue bitmap - bitmap.Free queue + bitmap.Free() let leftZeroCount = matrixLeft.ColumnCount * matrixLeft.RowCount @@ -142,7 +138,7 @@ module internal Kronecker = let kernel = clContext.Compile <| preparePositions op - fun (processor: MailboxProcessor<_>) (operand: ClCell<'a>) (matrix: CSR<'b>) (resultDenseMatrix: ClArray<'c>) (resultBitmap: ClArray) -> + fun (processor: RawCommandQueue) (operand: ClCell<'a>) (matrix: CSR<'b>) (resultDenseMatrix: ClArray<'c>) (resultBitmap: ClArray) -> let resultLength = matrix.RowCount * matrix.ColumnCount @@ -151,22 +147,19 @@ module internal Kronecker = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - operand - matrix.RowCount - matrix.ColumnCount - matrix.Values - matrix.RowPointers - matrix.Columns - resultBitmap - resultDenseMatrix) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + + kernel.KernelFunc + ndRange + operand + matrix.RowCount + matrix.ColumnCount + matrix.Values + matrix.RowPointers + matrix.Columns + resultBitmap + resultDenseMatrix + + processor.RunKernel kernel let private setPositions<'c when 'c: struct> (clContext: ClContext) workGroupSize = @@ -193,7 +186,7 @@ module internal Kronecker = let scan = Common.PrefixSum.standardIncludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) rowCount columnCount (rowOffset: int) (columnOffset: int) (startIndex: int) (resultMatrix: COO<'c>) (values: ClArray<'c>) (bitmap: ClArray) -> + fun (processor: RawCommandQueue) rowCount columnCount (rowOffset: int) (columnOffset: int) (startIndex: int) (resultMatrix: COO<'c>) (values: ClArray<'c>) (bitmap: ClArray) -> let sum = scan processor bitmap @@ -205,27 +198,23 @@ module internal Kronecker = let rowOffset = rowOffset |> clContext.CreateClCell let columnOffset = columnOffset |> clContext.CreateClCell - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - rowCount - columnCount - startIndex - rowOffset - columnOffset - bitmap - values - resultMatrix.Rows - resultMatrix.Columns - resultMatrix.Values) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) - - rowOffset.Free processor - columnOffset.Free processor + kernel.KernelFunc + ndRange + rowCount + columnCount + startIndex + rowOffset + columnOffset + bitmap + values + resultMatrix.Rows + resultMatrix.Columns + resultMatrix.Values + + processor.RunKernel kernel + + rowOffset.Free() + columnOffset.Free() (sum.ToHostAndFree processor) + startIndex @@ -245,7 +234,7 @@ module internal Kronecker = let kernel = clContext.Compile <| copyToResult - fun (processor: MailboxProcessor<_>) startIndex (rowOffset: int) (columnOffset: int) (resultMatrix: COO<'c>) (sourceMatrix: COO<'c>) -> + fun (processor: RawCommandQueue) startIndex (rowOffset: int) (columnOffset: int) (resultMatrix: COO<'c>) (sourceMatrix: COO<'c>) -> let ndRange = Range1D.CreateValid(sourceMatrix.NNZ, workGroupSize) @@ -255,27 +244,23 @@ module internal Kronecker = let rowOffset = rowOffset |> clContext.CreateClCell let columnOffset = columnOffset |> clContext.CreateClCell - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - startIndex - sourceMatrix.NNZ - rowOffset - columnOffset - sourceMatrix.Rows - sourceMatrix.Columns - sourceMatrix.Values - resultMatrix.Rows - resultMatrix.Columns - resultMatrix.Values) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) - - rowOffset.Free processor - columnOffset.Free processor + kernel.KernelFunc + ndRange + startIndex + sourceMatrix.NNZ + rowOffset + columnOffset + sourceMatrix.Rows + sourceMatrix.Columns + sourceMatrix.Values + resultMatrix.Rows + resultMatrix.Columns + resultMatrix.Values + + processor.RunKernel kernel + + rowOffset.Free() + columnOffset.Free() let private insertZero (clContext: ClContext) workGroupSize = @@ -348,12 +333,12 @@ module internal Kronecker = preparePositions queue value matrixRight mappedMatrix bitmap - value.Free queue + value.Free() startIndex <- setPositions rowOffset columnOffset startIndex resultMatrix mappedMatrix bitmap - bitmap.Free queue - mappedMatrix.Free queue + bitmap.Free() + mappedMatrix.Free() startIndex @@ -367,7 +352,7 @@ module internal Kronecker = let insertZero = insertZero clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (resultNNZ: int) (matrixZero: COO<'c> option) (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> + fun (queue: RawCommandQueue) allocationMode (resultNNZ: int) (matrixZero: COO<'c> option) (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> let resultRows = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, resultNNZ) @@ -436,9 +421,9 @@ module internal Kronecker = let mapAll = mapAll clContext workGroupSize op let bitonic = - Common.Sort.Bitonic.sortKeyValuesInplace clContext workGroupSize + Common.Sort.Bitonic.sortRowsColumnsValuesInplace clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> + fun (queue: RawCommandQueue) allocationMode (matrixLeft: CSR<'a>) (matrixRight: CSR<'b>) -> let matrixZero = mapWithValue queue allocationMode None matrixRight @@ -447,16 +432,14 @@ module internal Kronecker = getSize queue matrixZero matrixLeft matrixRight if size = 0 then - matrixZero - |> Option.iter (fun m -> m.Dispose queue) + matrixZero |> Option.iter (fun m -> m.Dispose()) None else let result = mapAll queue allocationMode size matrixZero matrixLeft matrixRight - matrixZero - |> Option.iter (fun m -> m.Dispose queue) + matrixZero |> Option.iter (fun m -> m.Dispose()) bitonic queue result.Rows result.Columns result.Values diff --git a/src/GraphBLAS-sharp.Backend/Operations/Operations.fs b/src/GraphBLAS-sharp.Backend/Operations/Operations.fs index cb67d09c..bc0f2c1d 100644 --- a/src/GraphBLAS-sharp.Backend/Operations/Operations.fs +++ b/src/GraphBLAS-sharp.Backend/Operations/Operations.fs @@ -1,6 +1,7 @@ namespace GraphBLAS.FSharp open Brahma.FSharp +open Microsoft.FSharp.Core open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClContextExtensions @@ -28,7 +29,7 @@ module Operations = let mapDense = Dense.Vector.map op clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode matrix -> + fun (processor: RawCommandQueue) allocationMode matrix -> match matrix with | ClVector.Sparse v -> mapSparse processor allocationMode v @@ -57,14 +58,14 @@ module Operations = let map2Sparse = Sparse.Vector.map2 op clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with | ClVector.Dense left, ClVector.Dense right -> - ClVector.Dense - <| map2Dense processor allocationMode left right + map2Dense processor allocationMode left right + |> ClVector.Dense + |> Some | ClVector.Sparse left, ClVector.Sparse right -> - ClVector.Sparse - <| map2Sparse processor allocationMode left right + Option.map ClVector.Sparse (map2Sparse processor allocationMode left right) | _ -> failwith "Vector formats are not matching." /// @@ -87,16 +88,99 @@ module Operations = let map2Dense = Dense.Vector.map2AtLeastOne op clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> match leftVector, rightVector with | ClVector.Sparse left, ClVector.Sparse right -> - ClVector.Sparse - <| map2Sparse processor allocationMode left right + Option.map ClVector.Sparse (map2Sparse processor allocationMode left right) | ClVector.Dense left, ClVector.Dense right -> - ClVector.Dense - <| map2Dense processor allocationMode left right + map2Dense processor allocationMode left right + |> ClVector.Dense + |> Some | _ -> failwith "Vector formats are not matching." + /// + /// Applying the given function to the corresponding elements of the two given arrays pairwise. + /// Stores the result in the left vector. + /// + /// + /// The two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2InPlace (map: Expr<'a option -> 'b option -> 'a option>) (clContext: ClContext) workGroupSize = + let map2Dense = + Dense.Vector.map2InPlace map clContext workGroupSize + + fun (processor: RawCommandQueue) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + match leftVector, rightVector with + | ClVector.Dense left, ClVector.Dense right -> map2Dense processor left right left + | _ -> failwith "Unsupported vector format" + + /// + /// Applying the given function to the corresponding elements of the two given arrays pairwise. + /// Stores the result in the given vector. + /// + /// + /// The two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2To (map: Expr<'a option -> 'b option -> 'c option>) (clContext: ClContext) workGroupSize = + let map2Dense = + Dense.Vector.map2InPlace map clContext workGroupSize + + fun (processor: RawCommandQueue) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) (resultVector: ClVector<'c>) -> + match leftVector, rightVector, resultVector with + | ClVector.Dense left, ClVector.Dense right, ClVector.Dense result -> + map2Dense processor left right result + | _ -> failwith "Unsupported vector format" + + /// + /// Applying the given function to the corresponding elements of the two given arrays pairwise. + /// Returns new vector. + /// + /// + /// The two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2Dense (map: Expr<'a option -> 'b option -> 'a option>) (clContext: ClContext) workGroupSize = + let map2Dense = + Dense.Vector.map2 map clContext workGroupSize + + fun (processor: RawCommandQueue) allocationFlag (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + match leftVector, rightVector with + | ClVector.Dense left, ClVector.Dense right -> map2Dense processor allocationFlag left right + | _ -> failwith "Unsupported vector format" + + /// + /// Applying the given function to the corresponding elements of the two given arrays pairwise. + /// Returns new vector as option. + /// + /// + /// The two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2Sparse (map: Expr<'a option -> 'b option -> 'a option>) (clContext: ClContext) workGroupSize = + let map2Sparse = + Sparse.Map2.run map clContext workGroupSize + + let map2SparseDense = + Sparse.Map2.runSparseDense map clContext workGroupSize + + fun (processor: RawCommandQueue) allocationFlag (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + match leftVector, rightVector with + | ClVector.Sparse left, ClVector.Sparse right -> + Option.map ClVector.Sparse (map2Sparse processor allocationFlag left right) + | ClVector.Sparse left, ClVector.Dense right -> + Option.map ClVector.Sparse (map2SparseDense processor allocationFlag left right) + | _ -> failwith "Unsupported vector format" + module Matrix = /// /// Builds a new matrix whose elements are the results of applying the given function @@ -118,7 +202,7 @@ module Operations = let transposeCOO = COO.Matrix.transposeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode matrix -> + fun (processor: RawCommandQueue) allocationMode matrix -> match matrix with | ClMatrix.COO m -> mapCOO processor allocationMode m |> ClMatrix.COO | ClMatrix.CSR m -> mapCSR processor allocationMode m |> ClMatrix.COO @@ -151,7 +235,7 @@ module Operations = let transposeCOO = COO.Matrix.transposeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> + fun (processor: RawCommandQueue) allocationMode matrix1 matrix2 -> match matrix1, matrix2 with | ClMatrix.COO m1, ClMatrix.COO m2 -> map2COO processor allocationMode m1 m2 @@ -188,7 +272,7 @@ module Operations = let COOTranspose = COO.Matrix.transposeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode matrix1 matrix2 -> + fun (processor: RawCommandQueue) allocationMode matrix1 matrix2 -> match matrix1, matrix2 with | ClMatrix.COO m1, ClMatrix.COO m2 -> COOMap2 processor allocationMode m1 m2 @@ -210,7 +294,7 @@ module Operations = /// Type of binary function to combine entries. /// OpenCL context. /// Should be a power of 2 and greater than 1. - let SpMVInplace + let SpMVInPlace (add: Expr<'c option -> 'c option -> 'c option>) (mul: Expr<'a option -> 'b option -> 'c option>) (clContext: ClContext) @@ -220,15 +304,119 @@ module Operations = let runTo = SpMV.runTo add mul clContext workGroupSize - fun (queue: MailboxProcessor<_>) (matrix: ClMatrix<'a>) (vector: ClVector<'b>) (result: ClVector<'c>) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix<'a>) (vector: ClVector<'b>) (result: ClVector<'c>) -> match matrix, vector, result with | ClMatrix.CSR m, ClVector.Dense v, ClVector.Dense r -> runTo queue m v r | _ -> failwith "Not implemented yet" /// - /// Matrix-vector multiplication. + /// CSR Matrix - dense vector multiplication. /// - let SpMV = SpMV.run + /// Type of binary function to reduce entries. + /// Type of binary function to combine entries. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let SpMV + (add: Expr<'c option -> 'c option -> 'c option>) + (mul: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) + workGroupSize + = + + let run = SpMV.run add mul clContext workGroupSize + + fun (queue: RawCommandQueue) allocationFlag (matrix: ClMatrix<'a>) (vector: ClVector<'b>) -> + match matrix, vector with + | ClMatrix.CSR m, ClVector.Dense v -> run queue allocationFlag m v |> ClVector.Dense + | _ -> failwith "Not implemented yet" + + /// + /// CSR Matrix - sparse vector multiplication. Optimized for bool OR and AND operations by skipping reduction stage. + /// + /// Type of binary function to reduce entries. + /// Type of binary function to combine entries. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let SpMSpVBool + (add: Expr bool option -> bool option>) + (mul: Expr bool option -> bool option>) + (clContext: ClContext) + workGroupSize + = + + let run = + SpMSpV.runBoolStandard add mul clContext workGroupSize + + fun (queue: RawCommandQueue) (matrix: ClMatrix) (vector: ClVector) -> + match matrix, vector with + | ClMatrix.CSR m, ClVector.Sparse v -> Option.map ClVector.Sparse (run queue m v) + | _ -> failwith "Not implemented yet" + + /// + /// CSR Matrix - sparse vector multiplication with mask. Mask is complemented. + /// + /// Type of binary function to reduce entries. + /// Type of binary function to combine entries. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let SpMSpVMasked + (add: Expr<'c option -> 'c option -> 'c option>) + (mul: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) + workGroupSize + = + + let run = + SpMSpV.Masked.runMasked add mul clContext workGroupSize + + fun (queue: RawCommandQueue) (matrix: ClMatrix<'a>) (vector: ClVector<'b>) (mask: ClVector<'d>) -> + match matrix, vector, mask with + | ClMatrix.CSR m, ClVector.Sparse v, ClVector.Dense mask -> Option.map ClVector.Sparse (run queue m v mask) + | _ -> failwith "Not implemented yet" + + /// + /// CSR Matrix - sparse vector multiplication with mask. Mask is complemented. Optimized for bool OR and AND operations by skipping reduction stage. + /// + /// Type of binary function to reduce entries. + /// Type of binary function to combine entries. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let SpMSpVMaskedBool + (add: Expr bool option -> bool option>) + (mul: Expr bool option -> bool option>) + (clContext: ClContext) + workGroupSize + = + + let run = + SpMSpV.Masked.runMaskedBoolStandard add mul clContext workGroupSize + + fun (queue: RawCommandQueue) (matrix: ClMatrix<'a>) (vector: ClVector<'b>) (mask: ClVector<'d>) -> + match matrix, vector, mask with + | ClMatrix.CSR m, ClVector.Sparse v, ClVector.Dense mask -> Option.map ClVector.Sparse (run queue m v mask) + | _ -> failwith "Not implemented yet" + + /// + /// CSR Matrix - sparse vector multiplication. + /// + /// Type of binary function to reduce entries. + /// Type of binary function to combine entries. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let SpMSpV + (add: Expr<'c option -> 'c option -> 'c option>) + (mul: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) + workGroupSize + = + + let run = + SpMSpV.run add mul clContext workGroupSize + + fun (queue: RawCommandQueue) (matrix: ClMatrix<'a>) (vector: ClVector<'b>) -> + match matrix, vector with + | ClMatrix.CSR m, ClVector.Sparse v -> Option.map ClVector.Sparse (run queue m v) + | _ -> failwith "Not implemented yet" /// /// Kronecker product for matrices. @@ -242,7 +430,7 @@ module Operations = let kronecker (op: Expr<'a option -> 'b option -> 'c option>) (clContext: ClContext) workGroupSize = let run = Kronecker.run clContext workGroupSize op - fun (queue: MailboxProcessor<_>) allocationFlag (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) -> + fun (queue: RawCommandQueue) allocationFlag (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) -> match matrix1, matrix2 with | ClMatrix.CSR m1, ClMatrix.CSR m2 -> let result = run queue allocationFlag m1 m2 @@ -270,7 +458,7 @@ module Operations = let runCSRnCSC = SpGeMM.Masked.run opAdd opMul clContext workGroupSize - fun (queue: MailboxProcessor<_>) (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) (mask: ClMatrix<_>) -> + fun (queue: RawCommandQueue) (matrix1: ClMatrix<'a>) (matrix2: ClMatrix<'b>) (mask: ClMatrix<_>) -> match matrix1, matrix2, mask with | ClMatrix.CSR m1, ClMatrix.CSC m2, ClMatrix.COO mask -> runCSRnCSC queue m1 m2 mask |> ClMatrix.COO | _ -> failwith "Matrix formats are not matching" @@ -292,7 +480,7 @@ module Operations = let run = SpGeMM.Expand.run opAdd opMul clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> match leftMatrix, rightMatrix with | ClMatrix.CSR leftMatrix, ClMatrix.CSR rightMatrix -> let allocCapacity = @@ -313,3 +501,43 @@ module Operations = run processor allocationMode resultCapacity leftMatrix rightMatrix | _ -> failwith "Matrix formats are not matching" + + module COO = + /// + /// Generalized matrix-matrix multiplication. Left matrix should be in COO format. + /// + /// Type of binary function to reduce entries. + /// Type of binary function to combine entries. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let expand + (opAdd: Expr<'c -> 'c -> 'c option>) + (opMul: Expr<'a -> 'b -> 'c option>) + (clContext: ClContext) + workGroupSize + = + + let run = + SpGeMM.Expand.COO.run opAdd opMul clContext workGroupSize + + fun (processor: RawCommandQueue) allocationMode (leftMatrix: ClMatrix<'a>) (rightMatrix: ClMatrix<'b>) -> + match leftMatrix, rightMatrix with + | ClMatrix.COO leftMatrix, ClMatrix.CSR rightMatrix -> + let allocCapacity = + List.max [ sizeof<'a> + sizeof<'c> + sizeof<'b> ] + |> uint64 + |> (*) 1UL + + let resultCapacity = + (clContext.MaxMemAllocSize / allocCapacity) / 3UL + + let resultCapacity = + (min + <| uint64 System.Int32.MaxValue + <| resultCapacity) + |> int + + run processor allocationMode resultCapacity leftMatrix rightMatrix + | _ -> failwith "Matrix formats are not matching" diff --git a/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Expand.fs b/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Expand.fs index 09f04bb7..6980c017 100644 --- a/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Expand.fs +++ b/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Expand.fs @@ -1,9 +1,8 @@ -namespace GraphBLAS.FSharp.Backend.Operations.SpGeMM +namespace GraphBLAS.FSharp.Backend.Operations.SpGeMM open Brahma.FSharp open FSharp.Quotations open GraphBLAS.FSharp -open GraphBLAS.FSharp open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClMatrix open GraphBLAS.FSharp.Objects.ClCellExtensions @@ -21,7 +20,7 @@ module internal Expand = let prefixSum = Common.PrefixSum.standardExcludeInPlace clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftMatrixColumns: ClArray) (rightMatrixRowsLengths: ClArray) -> + fun (processor: RawCommandQueue) (leftMatrixColumns: ClArray) (rightMatrixRowsLengths: ClArray) -> let segmentsLengths = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrixColumns.Length) @@ -32,13 +31,13 @@ module internal Expand = // compute pointers let length = (prefixSum processor segmentsLengths) - .ToHostAndFree processor + .ToHostAndFree(processor) length, segmentsLengths let multiply (predicate: Expr<'a -> 'b -> 'c option>) (clContext: ClContext) workGroupSize = let getBitmap = - ClArray.map2<'a, 'b, int> (Map.choose2Bitmap predicate) clContext workGroupSize + Backend.Common.Map.map2<'a, 'b, int> (Map.choose2Bitmap predicate) clContext workGroupSize let prefixSum = Common.PrefixSum.standardExcludeInPlace clContext workGroupSize @@ -49,7 +48,7 @@ module internal Expand = let scatter = Common.Scatter.lastOccurrence clContext workGroupSize - fun (processor: MailboxProcessor<_>) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (columns: ClArray) (rows: ClArray) -> + fun (processor: RawCommandQueue) (firstValues: ClArray<'a>) (secondValues: ClArray<'b>) (columns: ClArray) (rows: ClArray) -> let positions = getBitmap processor DeviceOnly firstValues secondValues @@ -59,7 +58,7 @@ module internal Expand = .ToHostAndFree(processor) if resultLength = 0 then - positions.Free processor + positions.Free() None else @@ -78,7 +77,7 @@ module internal Expand = assignValues processor firstValues secondValues positions resultValues - positions.Free processor + positions.Free() Some(resultValues, resultColumns, resultRows) @@ -113,14 +112,14 @@ module internal Expand = let rightMatrixGather = Common.Gather.run clContext workGroupSize - fun (processor: MailboxProcessor<_>) (lengths: int) (segmentsPointers: ClArray) (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) (lengths: int) (segmentsPointers: ClArray) (leftMatrix: ClMatrix.COO<'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 + .Free() // Compute right matrix positions let rightMatrixPositions = create processor DeviceOnly lengths 1 @@ -132,7 +131,7 @@ module internal Expand = scatter processor segmentsPointers requiredRightMatrixPointers rightMatrixPositions - requiredRightMatrixPointers.Free processor + requiredRightMatrixPointers.Free() // another way to get offsets ??? let offsets = @@ -140,7 +139,7 @@ module internal Expand = segmentPrefixSum processor offsets.Length rightMatrixPositions leftMatrixPositions offsets - offsets.Free processor + offsets.Free() // compute columns let columns = @@ -159,7 +158,7 @@ module internal Expand = leftMatrixGather processor leftMatrixPositions leftMatrix.Values leftMatrixValues - leftMatrixPositions.Free processor + leftMatrixPositions.Free() // compute right matrix values let rightMatrixValues = @@ -167,7 +166,7 @@ module internal Expand = rightMatrixGather processor rightMatrixPositions rightMatrix.Values rightMatrixValues - rightMatrixPositions.Free processor + rightMatrixPositions.Free() // left, right matrix values, columns and rows indices leftMatrixValues, rightMatrixValues, columns, rows @@ -175,15 +174,15 @@ module internal Expand = let sortByColumnsAndRows (clContext: ClContext) workGroupSize = let sortByKeyIndices = - Common.Sort.Radix.runByKeysStandard clContext workGroupSize + Common.Sort.Radix.runByKeysStandardValuesOnly clContext workGroupSize let sortByKeyValues = - Common.Sort.Radix.runByKeysStandard clContext workGroupSize + Common.Sort.Radix.runByKeysStandardValuesOnly clContext workGroupSize let sortKeys = Common.Sort.Radix.standardRunKeysOnly clContext workGroupSize - fun (processor: MailboxProcessor<_>) (values: ClArray<'a>) (columns: ClArray) (rows: ClArray) -> + fun (processor: RawCommandQueue) (values: ClArray<'a>) (columns: ClArray) (rows: ClArray) -> // sort by columns let valuesSortedByColumns = sortByKeyValues processor DeviceOnly columns values @@ -202,9 +201,9 @@ module internal Expand = let sortedRows = sortKeys processor rowsSortedByColumns - valuesSortedByColumns.Free processor - rowsSortedByColumns.Free processor - sortedColumns.Free processor + valuesSortedByColumns.Free() + rowsSortedByColumns.Free() + sortedColumns.Free() valuesSortedByRows, columnsSortedByRows, sortedRows @@ -214,7 +213,7 @@ module internal Expand = Common.Reduce.ByKey2D.Option.segmentSequential opAdd clContext workGroupSize let getUniqueBitmap = - ClArray.Bitmap.lastOccurrence2 clContext workGroupSize + Backend.Common.Bitmap.lastOccurrence2 clContext workGroupSize let prefixSum = Common.PrefixSum.standardExcludeInPlace clContext workGroupSize @@ -222,26 +221,26 @@ module internal Expand = let idScatter = Common.Scatter.initFirstOccurrence Map.id clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (values: ClArray<'a>) (columns: ClArray) (rows: ClArray) -> + fun (processor: RawCommandQueue) allocationMode (values: ClArray<'a>) (columns: ClArray) (rows: ClArray) -> let bitmap = getUniqueBitmap processor DeviceOnly columns rows let uniqueKeysCount = (prefixSum processor bitmap) - .ToHostAndFree processor + .ToHostAndFree(processor) let offsets = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, uniqueKeysCount) idScatter processor bitmap offsets - bitmap.Free processor + bitmap.Free() let reduceResult = reduce processor allocationMode uniqueKeysCount offsets columns rows values - offsets.Free processor + offsets.Free() // reducedValues, reducedColumns, reducedRows option reduceResult @@ -260,13 +259,13 @@ module internal Expand = let reduce = reduce opAdd clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (rightMatrixRowsNNZ: ClArray) (rightMatrix: ClMatrix.CSR<'b>) (leftMatrix: ClMatrix.COO<'a>) -> + fun (processor: RawCommandQueue) allocationMode (rightMatrixRowsNNZ: ClArray) (rightMatrix: ClMatrix.CSR<'b>) (leftMatrix: ClMatrix.COO<'a>) -> let length, segmentPointers = getSegmentPointers processor leftMatrix.Columns rightMatrixRowsNNZ if length = 0 then - segmentPointers.Free processor + segmentPointers.Free() length, None else @@ -274,16 +273,16 @@ module internal Expand = let leftMatrixValues, rightMatrixValues, columns, rows = expand processor length segmentPointers leftMatrix rightMatrix - segmentPointers.Free processor + segmentPointers.Free() // multiply let mulResult = multiply processor leftMatrixValues rightMatrixValues columns rows - leftMatrixValues.Free processor - rightMatrixValues.Free processor - columns.Free processor - rows.Free processor + leftMatrixValues.Free() + rightMatrixValues.Free() + columns.Free() + rows.Free() let result = mulResult @@ -293,17 +292,17 @@ module internal Expand = let sortedValues, sortedColumns, sortedRows = sort processor resultValues resultColumns resultRows - resultValues.Free processor - resultColumns.Free processor - resultRows.Free processor + resultValues.Free() + resultColumns.Free() + resultRows.Free() // addition let reduceResult = reduce processor allocationMode sortedValues sortedColumns sortedRows - sortedValues.Free processor - sortedColumns.Free processor - sortedRows.Free processor + sortedValues.Free() + sortedColumns.Free() + sortedRows.Free() reduceResult) @@ -317,7 +316,7 @@ module internal Expand = let expandRowPointers = CSR.Matrix.expandRowPointers clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftMatrix: ClMatrix.CSR<'a>) rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> let rows = expandRowPointers processor DeviceOnly leftMatrix @@ -333,7 +332,7 @@ module internal Expand = let _, result = runCOO processor allocationMode rightMatrixRowsNNZ rightMatrix leftMatrixCOO - rows.Free processor + rows.Free() result |> Option.map @@ -361,7 +360,7 @@ module internal Expand = let runCOO = runCOO opAdd opMul clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode maxAllocSize generalLength (leftMatrix: ClMatrix.CSR<'a>) segmentLengths rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) allocationMode maxAllocSize generalLength (leftMatrix: ClMatrix.CSR<'a>) segmentLengths rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> // extract segment lengths by left matrix rows pointers let segmentPointersByLeftMatrixRows = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftMatrix.RowPointers.Length) @@ -387,11 +386,11 @@ module internal Expand = // find largest row that fit into maxAllocSize let upperBound = - (upperBound currentBound).ToHostAndFree processor + (upperBound currentBound).ToHostAndFree(processor) let endRow = upperBound - 2 - currentBound.Free processor + currentBound.Free() // TODO(handle largest rows) // (we can split row, multiply and merge them but merge path needed) @@ -417,7 +416,7 @@ module internal Expand = let result = helper 0 0 [] |> List.rev - segmentPointersByLeftMatrixRows.Free processor + segmentPointersByLeftMatrixRows.Free() result @@ -439,7 +438,7 @@ module internal Expand = let runManySteps = runManySteps opAdd opMul clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode maxAllocSize (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + fun (processor: RawCommandQueue) allocationMode maxAllocSize (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> let rightMatrixRowsNNZ = getNNZInRows processor DeviceOnly rightMatrix @@ -450,7 +449,7 @@ module internal Expand = if generalLength = 0 then None elif generalLength < maxAllocSize then - segmentLengths.Free processor + segmentLengths.Free() runOneStep processor allocationMode leftMatrix rightMatrixRowsNNZ rightMatrix else @@ -465,8 +464,8 @@ module internal Expand = rightMatrixRowsNNZ rightMatrix - rightMatrixRowsNNZ.Free processor - segmentLengths.Free processor + rightMatrixRowsNNZ.Free() + segmentLengths.Free() match result with | _ :: _ -> @@ -483,13 +482,12 @@ module internal Expand = // TODO(overhead: compute result length 3 time) // release resources valuesList - |> List.iter (fun array -> array.Free processor) + |> List.iter (fun array -> array.Free()) columnsList - |> List.iter (fun array -> array.Free processor) + |> List.iter (fun array -> array.Free()) - rowsList - |> List.iter (fun array -> array.Free processor) + rowsList |> List.iter (fun array -> array.Free()) { Context = clContext RowCount = leftMatrix.RowCount @@ -499,3 +497,185 @@ module internal Expand = Values = values } |> Some | _ -> None + + module COO = + let runOneStep opAdd opMul (clContext: ClContext) workGroupSize = + + let runCOO = + runCOO opAdd opMul clContext workGroupSize + + fun (processor: RawCommandQueue) allocationMode (leftMatrix: ClMatrix.COO<'a>) rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> + + let _, result = + runCOO processor allocationMode rightMatrixRowsNNZ rightMatrix leftMatrix + + result + |> Option.map + (fun (values, columns, rows) -> + { Context = clContext + RowCount = leftMatrix.RowCount + ColumnCount = rightMatrix.ColumnCount + Rows = rows + Columns = columns + Values = values }) + + let runManySteps opAdd opMul (clContext: ClContext) workGroupSize = + + let compress = + COO.Matrix.compressRows clContext workGroupSize + + let gather = + Common.Gather.run clContext workGroupSize + + let upperBound = + ClArray.upperBound clContext workGroupSize + + let set = ClArray.set clContext workGroupSize + + let subMatrix = + COO.Matrix.subRows clContext workGroupSize + + let runCOO = + runCOO opAdd opMul clContext workGroupSize + + fun (processor: RawCommandQueue) allocationMode maxAllocSize generalLength (leftMatrix: ClMatrix.COO<'a>) segmentLengths rightMatrixRowsNNZ (rightMatrix: ClMatrix.CSR<'b>) -> + + let leftRowPointers = + compress processor allocationMode leftMatrix.Rows leftMatrix.RowCount + + // extract segment lengths by left matrix rows pointers + let segmentPointersByLeftMatrixRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, leftRowPointers.Length) + + gather processor leftRowPointers segmentLengths segmentPointersByLeftMatrixRows + + // set last element to one step length + set processor segmentPointersByLeftMatrixRows (leftRowPointers.Length - 1) generalLength + + // curring + let upperBound = + upperBound processor segmentPointersByLeftMatrixRows + + let subMatrix = subMatrix processor DeviceOnly + + let runCOO = + runCOO processor allocationMode rightMatrixRowsNNZ rightMatrix + + let rec helper beginRow workOffset previousResult = + if beginRow < leftMatrix.RowCount then + let currentBound = + clContext.CreateClCell(workOffset + maxAllocSize: int) + + // find largest row that fit into maxAllocSize + let upperBound = + (upperBound currentBound).ToHostAndFree(processor) + + let endRow = upperBound - 2 + + currentBound.Free() + + // TODO(handle largest rows) + // (we can split row, multiply and merge them but merge path needed) + if endRow = beginRow then + failwith "It is impossible to multiply such a long row" + + // extract matrix TODO(Transfer overhead) + let subMatrix = + subMatrix beginRow (endRow - beginRow) leftMatrix + + // compute sub result + let length, result = runCOO subMatrix + // increase workOffset according to previous expand + let workOffset = workOffset + length + + match result with + | Some result -> + helper endRow workOffset + <| result :: previousResult + | None -> helper endRow workOffset previousResult + else + previousResult + + let result = helper 0 0 [] |> List.rev + + segmentPointersByLeftMatrixRows.Free() + + result + + let run opAdd opMul (clContext: ClContext) workGroupSize = + + let getNNZInRows = + CSR.Matrix.NNZInRows clContext workGroupSize + + let getSegmentPointers = + getSegmentPointers clContext workGroupSize + + let runOneStep = + runOneStep opAdd opMul clContext workGroupSize + + let concat = ClArray.concat clContext workGroupSize + + let concatData = ClArray.concat clContext workGroupSize + + let runManySteps = + runManySteps opAdd opMul clContext workGroupSize + + fun (processor: RawCommandQueue) allocationMode maxAllocSize (leftMatrix: ClMatrix.COO<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> + + let rightMatrixRowsNNZ = + getNNZInRows processor DeviceOnly rightMatrix + + let generalLength, segmentLengths = + getSegmentPointers processor leftMatrix.Columns rightMatrixRowsNNZ + + if generalLength = 0 then + None + elif generalLength < maxAllocSize then + segmentLengths.Free() + + runOneStep processor allocationMode leftMatrix rightMatrixRowsNNZ rightMatrix + else + let result = + runManySteps + processor + allocationMode + maxAllocSize + generalLength + leftMatrix + segmentLengths + rightMatrixRowsNNZ + rightMatrix + + rightMatrixRowsNNZ.Free() + segmentLengths.Free() + + match result with + | _ :: _ -> + let valuesList, columnsList, rowsList = result |> List.unzip3 + + let values = + concatData processor allocationMode valuesList + + let columns = + concat processor allocationMode columnsList + + let rows = concat processor allocationMode rowsList + + // TODO(overhead: compute result length 3 time) + // release resources + valuesList + |> List.iter (fun array -> array.Free()) + + columnsList + |> List.iter (fun array -> array.Free()) + + rowsList |> List.iter (fun array -> array.Free()) + + { Context = clContext + RowCount = leftMatrix.RowCount + ColumnCount = rightMatrix.ColumnCount + Rows = rows + Columns = columns + Values = values } + |> Some + | _ -> None diff --git a/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Masked.fs b/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Masked.fs index 8c4e600a..ab825f7f 100644 --- a/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Masked.fs +++ b/src/GraphBLAS-sharp.Backend/Operations/SpGeMM/Masked.fs @@ -7,6 +7,7 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClMatrix open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Objects.ClCellExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions module internal Masked = let private calculate @@ -107,7 +108,7 @@ module internal Masked = let program = context.Compile(run) - fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> + fun (queue: RawCommandQueue) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> let values = context.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, mask.NNZ) @@ -120,24 +121,20 @@ module internal Masked = let ndRange = Range1D.CreateValid(workGroupSize * mask.NNZ, workGroupSize) - queue.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - matrixLeft.RowPointers - matrixLeft.Columns - matrixLeft.Values - matrixRight.Rows - matrixRight.ColumnPointers - matrixRight.Values - mask.Rows - mask.Columns - values - bitmap) - ) - - queue.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + matrixLeft.RowPointers + matrixLeft.Columns + matrixLeft.Values + matrixRight.Rows + matrixRight.ColumnPointers + matrixRight.Values + mask.Rows + mask.Columns + values + bitmap + + queue.RunKernel(kernel) values, bitmap @@ -160,7 +157,7 @@ module internal Masked = let scanInPlace = Common.PrefixSum.standardExcludeInPlace context workGroupSize - fun (queue: MailboxProcessor<_>) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> + fun (queue: RawCommandQueue) (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSC<'b>) (mask: ClMatrix.COO<_>) -> let values, positions = calculate queue matrixLeft matrixRight mask @@ -176,8 +173,8 @@ module internal Masked = scatter queue positions mask.Columns resultColumns scatterData queue positions values resultValues - queue.Post(Msg.CreateFreeMsg<_>(values)) - queue.Post(Msg.CreateFreeMsg<_>(positions)) + values.Free() + positions.Free() { Context = context RowCount = matrixLeft.RowCount diff --git a/src/GraphBLAS-sharp.Backend/Operations/SpMSpV.fs b/src/GraphBLAS-sharp.Backend/Operations/SpMSpV.fs new file mode 100644 index 00000000..3f6f0908 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Operations/SpMSpV.fs @@ -0,0 +1,507 @@ +namespace GraphBLAS.FSharp.Backend.Operations + +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Quotes +open Microsoft.FSharp.Quotations +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.ClVector +open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.ClCellExtensions + +module SpMSpV = + + //For v in vectorIndices collect R[v] and R[v + 1] + let private collectRows (clContext: ClContext) workGroupSize = + + let collectRows = + <@ fun (ndRange: Range1D) inputSize (vectorIndices: ClArray) (rowOffsets: ClArray) (resultArray: ClArray) -> + + let i = ndRange.GlobalID0 + + //resultArray is twice vector size + if i < (inputSize * 2) then + let columnIndex = vectorIndices.[i / 2] + + if i % 2 = 0 then + resultArray.[i] <- rowOffsets.[columnIndex] + else + resultArray.[i] <- rowOffsets.[columnIndex + 1] + elif i = inputSize * 2 then + resultArray.[i] <- 0 @> + + let collectRows = clContext.Compile collectRows + + fun (queue: RawCommandQueue) size (vectorIndices: ClArray) (rowOffsets: ClArray) -> + + let ndRange = + Range1D.CreateValid(size * 2 + 1, workGroupSize) + + // Last element will contain length of array for gather + let resultRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, size * 2 + 1) + + let collectRows = collectRows.GetKernel() + + collectRows.KernelFunc ndRange size vectorIndices rowOffsets resultRows + + queue.RunKernel(collectRows) + + resultRows + + //For above array compute result offsets + let private computeOffsetsInplace (clContext: ClContext) workGroupSize = + + let prepareOffsets = + <@ fun (ndRange: Range1D) inputSize (inputArray: ClArray) -> + + let i = ndRange.GlobalID0 + + if i < inputSize && i % 2 = 0 then + inputArray.[i + 1] <- inputArray.[i + 1] - inputArray.[i] + inputArray.[i] <- 0 @> + + let sum = + ScanInternal.standardExcludeInPlace clContext workGroupSize + + let prepareOffsets = clContext.Compile prepareOffsets + + fun (queue: RawCommandQueue) size (input: ClArray) -> + + let ndRange = Range1D.CreateValid(size, workGroupSize) + + let prepareOffsets = prepareOffsets.GetKernel() + + prepareOffsets.KernelFunc ndRange size input + + queue.RunKernel(prepareOffsets) + + let resSize = (sum queue input).ToHostAndFree queue + + resSize + + //Gather rows from the matrix that will be used in multiplication + let private gather (clContext: ClContext) workGroupSize = + + let gather = + <@ fun (ndRange: Range1D) vectorNNZ (rowOffsets: ClArray) (matrixRowPointers: ClArray) (matrixColumns: ClArray) (matrixValues: ClArray<'a>) (vectorIndices: ClArray) (resultRowsArray: ClArray) (resultIndicesArray: ClArray) (resultValuesArray: ClArray<'a>) -> + + //Serial number of row to gather + let row = ndRange.GlobalID0 + + if row < vectorNNZ then + let offsetIndex = row * 2 + 1 + let rowOffset = rowOffsets.[offsetIndex] + + //vectorIndices.[row] --- actual number of row in matrix + let actualRow = vectorIndices.[row] + let matrixIndexOffset = matrixRowPointers.[actualRow] + + if rowOffset <> rowOffsets.[offsetIndex + 1] then + let rowSize = rowOffsets.[offsetIndex + 1] - rowOffset + + for i in 0 .. rowSize - 1 do + resultRowsArray.[i + rowOffset] <- actualRow + resultIndicesArray.[i + rowOffset] <- matrixColumns.[matrixIndexOffset + i] + resultValuesArray.[i + rowOffset] <- matrixValues.[matrixIndexOffset + i] @> + + let collectRows = collectRows clContext workGroupSize + + let computeOffsetsInplace = + computeOffsetsInplace clContext workGroupSize + + let gather = clContext.Compile gather + + fun (queue: RawCommandQueue) (matrix: ClMatrix.CSR<'a>) (vector: ClVector.Sparse<'b>) -> + + //Collect R[v] and R[v + 1] for each v in vector + let collectedRows = + collectRows queue vector.NNZ vector.Indices matrix.RowPointers + + //Place R[v + 1] - R[v] in previous array and do prefix sum, computing offsets for gather array + let gatherArraySize = + computeOffsetsInplace queue (vector.NNZ * 2 + 1) collectedRows + + if gatherArraySize = 0 then + collectedRows.Free() + None + else + let ndRange = + Range1D.CreateValid(vector.NNZ, workGroupSize) + + let gather = gather.GetKernel() + + let resultRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, gatherArraySize) + + let resultIndices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, gatherArraySize) + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, gatherArraySize) + + if gatherArraySize > 0 then + gather.KernelFunc + ndRange + vector.NNZ + collectedRows + matrix.RowPointers + matrix.Columns + matrix.Values + vector.Indices + resultRows + resultIndices + resultValues + + queue.RunKernel gather + + collectedRows.Free() + + Some(resultRows, resultIndices, resultValues) + + + let private multiplyScalar (clContext: ClContext) (mul: Expr<'a option -> 'b option -> 'c option>) workGroupSize = + + let multiply = + <@ fun (ndRange: Range1D) resultLength vectorLength (rowIndices: ClArray) (matrixValues: ClArray<'a>) (vectorIndices: ClArray) (vectorValues: ClArray<'b>) (resultValues: ClArray<'c option>) -> + let i = ndRange.GlobalID0 + + if i < resultLength then + let index = rowIndices.[i] + let matrixValue = matrixValues.[i] + + let vectorValue = + (%Search.Bin.byKey) vectorLength index vectorIndices vectorValues + + let res = (%mul) (Some matrixValue) vectorValue + resultValues.[i] <- res @> + + let multiply = clContext.Compile multiply + + fun (queue: RawCommandQueue) (columnIndices: ClArray) (matrixValues: ClArray<'a>) (vector: Sparse<'b>) -> + + let resultLength = columnIndices.Length + + let result = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let multiply = multiply.GetKernel() + + multiply.KernelFunc + ndRange + resultLength + vector.NNZ + columnIndices + matrixValues + vector.Indices + vector.Values + result + + queue.RunKernel(multiply) + + result + + let run + (add: Expr<'c option -> 'c option -> 'c option>) + (mul: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) + workGroupSize + = + + //TODO: Common.Gather? + let gather = gather clContext workGroupSize + + let sort = + Sort.Bitonic.sortRowsColumnsValuesInplace clContext workGroupSize + + let multiplyScalar = + multiplyScalar clContext mul workGroupSize + + let segReduce = + Reduce.ByKey.Option.segmentSequential add clContext workGroupSize + + fun (queue: RawCommandQueue) (matrix: ClMatrix.CSR<'a>) (vector: ClVector.Sparse<'b>) -> + gather queue matrix vector + |> Option.map + (fun (gatherRows, gatherIndices, gatherValues) -> + sort queue gatherIndices gatherRows gatherValues + + let sortedRows, sortedIndices, sortedValues = gatherRows, gatherIndices, gatherValues + + let multipliedValues = + multiplyScalar queue sortedRows sortedValues vector + + sortedValues.Free() + sortedRows.Free() + + let result = + segReduce queue DeviceOnly sortedIndices multipliedValues + |> Option.map + (fun (reducedValues, reducedKeys) -> + + { Context = clContext + Indices = reducedKeys + Values = reducedValues + Size = matrix.ColumnCount }) + + multipliedValues.Free() + sortedIndices.Free() + + result) + |> Option.bind id + + + let runBoolStandard + (add: Expr<'c option -> 'c option -> 'c option>) + (mul: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) + workGroupSize + = + + let gather = gather clContext workGroupSize + + let sort = + Sort.Bitonic.sortRowsColumnsValuesInplace clContext workGroupSize + + let removeDuplicates = + GraphBLAS.FSharp.ClArray.removeDuplications clContext workGroupSize + + let create = + GraphBLAS.FSharp.ClArray.create clContext workGroupSize + + fun (queue: RawCommandQueue) (matrix: ClMatrix.CSR<'a>) (vector: ClVector.Sparse<'b>) -> + + gather queue matrix vector + |> Option.map + (fun (gatherRows, gatherIndices, gatherValues) -> + sort queue gatherIndices gatherRows gatherValues + + let resultIndices = removeDuplicates queue gatherIndices + + gatherIndices.Free() + gatherRows.Free() + gatherValues.Free() + + { Context = clContext + Indices = resultIndices + Values = create queue DeviceOnly resultIndices.Length true + Size = matrix.ColumnCount }) + + module Masked = + + let private count (clContext: ClContext) workGroupSize = + + let count = + <@ fun (ndRange: Range1D) vectorLength (vectorIndices: ClArray) (vectorMask: ClArray<'d option>) (matrixRowPointers: ClArray) (matrixColumns: ClArray) (result: ClCell) -> + let gid = ndRange.GlobalID0 + let step = ndRange.GlobalWorkSize + + let mutable idx = gid + + while idx < vectorLength do + let vectorIndex = vectorIndices.[idx] + + let rowStart = matrixRowPointers.[vectorIndex] + let rowEnd = matrixRowPointers.[vectorIndex + 1] + + let mutable count = 0 + + for i in rowStart .. rowEnd - 1 do + match vectorMask.[matrixColumns.[i]] with + | None -> count <- count + 1 + | Some _ -> () + + atomic (+) result.Value count |> ignore + + idx <- idx + step @> + + let count = clContext.Compile count + + fun (queue: RawCommandQueue) (matrix: ClMatrix.CSR<'a>) (vector: ClVector.Sparse<'b>) (vectorMask: ClArray<'d option>) -> + + let length = vector.NNZ + + let numberOfGroups = + Utils.divUpClamp length workGroupSize 1 1024 + + let result = clContext.CreateClCell(0) + + let ndRange = + Range1D.CreateValid(numberOfGroups * workGroupSize, workGroupSize) + + let count = count.GetKernel() + + count.KernelFunc ndRange length vector.Indices vectorMask matrix.RowPointers matrix.Columns result + + queue.RunKernel count + + result.ToHostAndFree queue + + let private multiplyValues + (clContext: ClContext) + (mul: Expr<'a option -> 'b option -> 'c option>) + workGroupSize + = + + let multiply = + <@ fun (ndRange: Range1D) resultLength (vectorIndices: ClArray) (vectorValues: ClArray<'b>) (vectorMask: ClArray<'d option>) (matrixRowPointers: ClArray) (matrixColumns: ClArray) (matrixValues: ClArray<'a>) (resultOffset: ClCell) (resultIndices: ClArray) (resultValues: ClArray<'c option>) -> + let gid = ndRange.GlobalID0 + let step = ndRange.GlobalWorkSize + + let mutable i = gid + + while i < resultLength do + let vectorIndex = vectorIndices.[i] + let vectorValue = vectorValues.[i] + + let rowStart = matrixRowPointers.[vectorIndex] + let rowEnd = matrixRowPointers.[vectorIndex + 1] + + let mutable count = 0 + + for i in rowStart .. rowEnd - 1 do + match vectorMask.[matrixColumns.[i]] with + | None -> count <- count + 1 + | Some _ -> () + + let mutable offset = atomic (+) resultOffset.Value count + + for i in rowStart .. rowEnd - 1 do + let columnIndex = matrixColumns.[i] + + // TODO: Pass mask operation + match vectorMask.[columnIndex] with + | None -> + resultIndices.[offset] <- columnIndex + resultValues.[offset] <- (%mul) (Some matrixValues.[i]) (Some vectorValue) + offset <- offset + 1 + | Some _ -> () + + i <- i + step @> + + let kernel = clContext.Compile multiply + + fun (queue: RawCommandQueue) (matrix: ClMatrix.CSR<'a>) (vector: ClVector.Sparse<'b>) (vectorMask: ClArray<'d option>) (resultSize: int) -> + + let multipliedIndices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultSize) + + let multipliedValues = + clContext.CreateClArrayWithSpecificAllocationMode<'c option>(DeviceOnly, resultSize) + + let offset = clContext.CreateClCell 0 + + let numberOfGroups = + Utils.divUpClamp vector.NNZ workGroupSize 1 1024 + + let ndRange = + Range1D.CreateValid(numberOfGroups * workGroupSize, workGroupSize) + + let kernel = kernel.GetKernel() + + kernel.KernelFunc + ndRange + vector.NNZ + vector.Indices + vector.Values + vectorMask + matrix.RowPointers + matrix.Columns + matrix.Values + offset + multipliedIndices + multipliedValues + + queue.RunKernel kernel + + offset.Free() + + multipliedIndices, multipliedValues + + let runMasked + (add: Expr<'c option -> 'c option -> 'c option>) + (mul: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) + workGroupSize + = + + let count = count clContext workGroupSize + + let multiplyValues = + multiplyValues clContext mul workGroupSize + + let sort = + Sort.Bitonic.sortKeyValuesInplace clContext workGroupSize + + let segReduce = + Reduce.ByKey.Option.segmentSequential add clContext workGroupSize + + fun (queue: RawCommandQueue) (matrix: ClMatrix.CSR<'a>) (vector: ClVector.Sparse<'b>) (mask: ClArray<'d option>) -> + + match count queue matrix vector mask with + | 0 -> None + | resultSize -> + let multipliedIndices, multipliedValues = + multiplyValues queue matrix vector mask resultSize + + sort queue multipliedIndices multipliedValues + + let result = + segReduce queue DeviceOnly multipliedIndices multipliedValues + |> Option.map + (fun (reducedValues, reducedKeys) -> + { Context = clContext + Indices = reducedKeys + Values = reducedValues + Size = matrix.ColumnCount }) + + multipliedIndices.Free() + multipliedValues.Free() + + result + + let runMaskedBoolStandard + (add: Expr<'c option -> 'c option -> 'c option>) + (mul: Expr<'a option -> 'b option -> 'c option>) + (clContext: ClContext) + workGroupSize + = + + let count = count clContext workGroupSize + + let multiplyValues = + multiplyValues clContext mul workGroupSize + + let sort = + Sort.Bitonic.sortKeyValuesInplace clContext workGroupSize + + let removeDuplicates = + GraphBLAS.FSharp.ClArray.removeDuplications clContext workGroupSize + + let create = + GraphBLAS.FSharp.ClArray.create clContext workGroupSize + + fun (queue: RawCommandQueue) (matrix: ClMatrix.CSR<'a>) (vector: ClVector.Sparse<'b>) (mask: ClArray<'d option>) -> + + match count queue matrix vector mask with + | 0 -> None + | resultSize -> + let multipliedIndices, multipliedValues = + multiplyValues queue matrix vector mask resultSize + + sort queue multipliedIndices multipliedValues + + let resultIndices = removeDuplicates queue multipliedIndices + + multipliedIndices.Free() + multipliedValues.Free() + + Some + <| { Context = clContext + Indices = resultIndices + Values = create queue DeviceOnly resultIndices.Length true + Size = matrix.ColumnCount } diff --git a/src/GraphBLAS-sharp.Backend/Operations/SpMV.fs b/src/GraphBLAS-sharp.Backend/Operations/SpMV.fs index 34b5f821..374a4f7a 100644 --- a/src/GraphBLAS-sharp.Backend/Operations/SpMV.fs +++ b/src/GraphBLAS-sharp.Backend/Operations/SpMV.fs @@ -5,6 +5,7 @@ open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions module internal SpMV = let runTo @@ -97,7 +98,7 @@ module internal SpMV = let multiplyValues = clContext.Compile multiplyValues let reduceValuesByRows = clContext.Compile reduceValuesByRows - fun (queue: MailboxProcessor<_>) (matrix: ClMatrix.CSR<'a>) (vector: ClArray<'b option>) (result: ClArray<'c option>) -> + fun (queue: RawCommandQueue) (matrix: ClMatrix.CSR<'a>) (vector: ClArray<'b option>) (result: ClArray<'c option>) -> let matrixLength = matrix.Values.Length @@ -112,36 +113,17 @@ module internal SpMV = let multiplyValues = multiplyValues.GetKernel() - queue.Post( - Msg.MsgSetArguments - (fun () -> - multiplyValues.KernelFunc - ndRange1 - matrixLength - matrix.Columns - matrix.Values - vector - intermediateArray) - ) + multiplyValues.KernelFunc ndRange1 matrixLength matrix.Columns matrix.Values vector intermediateArray - queue.Post(Msg.CreateRunMsg<_, _>(multiplyValues)) + queue.RunKernel multiplyValues let reduceValuesByRows = reduceValuesByRows.GetKernel() - queue.Post( - Msg.MsgSetArguments - (fun () -> - reduceValuesByRows.KernelFunc - ndRange2 - matrix.RowCount - intermediateArray - matrix.RowPointers - result) - ) + reduceValuesByRows.KernelFunc ndRange2 matrix.RowCount intermediateArray matrix.RowPointers result - queue.Post(Msg.CreateRunMsg<_, _>(reduceValuesByRows)) + queue.RunKernel reduceValuesByRows - queue.Post(Msg.CreateFreeMsg intermediateArray) + intermediateArray.Free() let run (add: Expr<'c option -> 'c option -> 'c option>) @@ -151,7 +133,7 @@ module internal SpMV = = let runTo = runTo add mul clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) (vector: ClArray<'b option>) -> + fun (queue: RawCommandQueue) allocationMode (matrix: ClMatrix.CSR<'a>) (vector: ClArray<'b option>) -> let result = clContext.CreateClArrayWithSpecificAllocationMode<'c option>(allocationMode, matrix.RowCount) diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index f79a2193..ec8ad537 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -1,6 +1,7 @@ -namespace GraphBLAS.FSharp.Backend.Quotes +namespace GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Objects +open Microsoft.FSharp.Quotations module ArithmeticOperations = let inline private mkUnaryOp zero unaryOp = @@ -36,6 +37,16 @@ module ArithmeticOperations = if res = zero then None else Some res @> + let inline private mkNumericSumAsMul zero = + <@ fun (x: 't option) (y: 't option) -> + let mutable res = None + + match x, y with + | Some f, Some s -> res <- Some(f + s) + | _ -> () + + res @> + let inline private mkNumericMul zero = <@ fun (x: 't option) (y: 't option) -> let mutable res = zero @@ -173,12 +184,16 @@ module ArithmeticOperations = let floatMulAtLeastOne = mkNumericMulAtLeastOne 0.0 let float32MulAtLeastOne = mkNumericMulAtLeastOne 0f + let intSumAsMul = mkNumericSumAsMul System.Int32.MaxValue + let notOption = <@ fun x -> match x with | Some true -> None | _ -> Some true @> + let intNotQ = <@ fun x -> if x = 0 then 1 else 0 @> + let inline private binOpQ zero op = <@ fun (left: 'a) (right: 'a) -> let result = (%op) left right @@ -216,3 +231,51 @@ module ArithmeticOperations = let floatMul = createPair 0.0 (*) <@ (*) @> let float32Mul = createPair 0.0f (*) <@ (*) @> + + // without zero + let intAddWithoutZero = <@ fun x y -> Some(x + y) @> + + let intMulWithoutZero = <@ fun x y -> Some(x * y) @> + + // other operations + let less<'a when 'a: comparison> = + <@ fun (x: 'a option) (y: 'a option) -> + match x, y with + | Some x, Some y -> if (x < y) then Some 1 else None + | Some x, None -> Some 1 + | _ -> None @> + + let minOption<'a when 'a: comparison> = + <@ fun (x: 'a option) (y: 'a option) -> + match x, y with + | Some x, Some y -> Some(min x y) + | Some x, None -> Some x + | None, Some y -> Some y + | _ -> None @> + + let min<'a when 'a: comparison> = + <@ fun (x: 'a) (y: 'a) -> Some(min x y) @> + + let fst<'a> = <@ fun (x: 'a) (_: 'a) -> Some x @> + + let ceilToPowerOfTwo = + <@ fun (x: int) -> + let mutable i = 1 + + while i < x do + i <- i * 2 + + i @> + + //PageRank specific + let squareOfDifference = + <@ fun (x: float32 option) (y: float32 option) -> + let mutable res = 0.0f + + match x, y with + | Some f, Some s -> res <- (f - s) * (f - s) + | Some f, None -> res <- f * f + | None, Some s -> res <- s * s + | None, None -> () + + if res = 0.0f then None else Some res @> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs index 2f74a7c5..9a518e40 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Map.fs @@ -28,6 +28,11 @@ module Map = | Some _ -> 1 | None -> 0 @> + let predicateBitmap<'a> (predicate: Expr<'a -> bool>) = + <@ fun (x: 'a) -> + let res = (%predicate) x + if res then 1 else 0 @> + let inc = <@ fun item -> item + 1 @> let subtraction = <@ fun first second -> first - second @> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Mask.fs b/src/GraphBLAS-sharp.Backend/Quotes/Mask.fs index 3a27b5d6..9b19b5b1 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Mask.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Mask.fs @@ -7,6 +7,12 @@ module Mask = | _, None -> left | _ -> right @> + let assignComplemented<'a when 'a: struct> = + <@ fun (left: 'a option) (right: 'a option) -> + match left, right with + | _, None -> right + | _ -> left @> + let op<'a, 'b when 'a: struct and 'b: struct> = <@ fun (left: 'a option) (right: 'b option) -> match right with diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs index c56bf6f7..27687645 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs @@ -96,10 +96,66 @@ module Search = result @> + /// + /// Searches value in array by two keys. + /// In case there is a value at the given keys position, it returns true. + /// + let existsByKey2D<'a> = + <@ fun length sourceIndex (rowIndices: ClArray) (columnIndices: ClArray) -> + + let mutable leftEdge = 0 + let mutable rightEdge = length - 1 + + let mutable result = false + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + + let currentIndex: uint64 = + ((uint64 rowIndices.[middleIdx]) <<< 32) + ||| (uint64 columnIndices.[middleIdx]) + + if sourceIndex = currentIndex then + result <- true + + rightEdge <- -1 // TODO() break + elif sourceIndex < currentIndex then + rightEdge <- middleIdx - 1 + else + leftEdge <- middleIdx + 1 + + result @> + /// /// Find lower position of item in array. /// let lowerPosition<'a when 'a: equality and 'a: comparison> = + <@ fun length sourceItem (keys: ClArray<'a>) -> + + let mutable leftEdge = 0 + let mutable rightEdge = length - 1 + let mutable resultPosition = None + + while leftEdge <= rightEdge do + let currentPosition = (leftEdge + rightEdge) / 2 + let currentKey = keys.[currentPosition] + + if sourceItem = currentKey then + // remember positions and move left + resultPosition <- Some currentPosition + + rightEdge <- currentPosition - 1 + elif sourceItem < currentKey then + rightEdge <- currentPosition - 1 + else + leftEdge <- currentPosition + 1 + + resultPosition @> + + /// + /// Find lower position of item in array. + /// + let lowerPositionLocal<'a when 'a: equality and 'a: comparison> = <@ fun length sourceItem (keys: 'a []) -> let mutable leftEdge = 0 diff --git a/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs index cbc515de..6d910afd 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Dense/Vector.fs @@ -3,10 +3,12 @@ namespace GraphBLAS.FSharp.Backend.Vector.Dense open Brahma.FSharp open Microsoft.FSharp.Quotations open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Objects.ClVector open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Objects.ClCellExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions module Vector = let map<'a, 'b when 'a: struct and 'b: struct> @@ -15,9 +17,9 @@ module Vector = workGroupSize = - let map = ClArray.map op clContext workGroupSize + let map = Map.map op clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClArray<'a option>) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClArray<'a option>) -> map processor allocationMode leftVector @@ -28,9 +30,9 @@ module Vector = = let map2InPlace = - ClArray.map2InPlace opAdd clContext workGroupSize + Map.map2InPlace opAdd clContext workGroupSize - fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> + fun (processor: RawCommandQueue) (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) (resultVector: ClArray<'c option>) -> map2InPlace processor leftVector rightVector resultVector @@ -40,10 +42,9 @@ module Vector = workGroupSize = - let map2 = - ClArray.map2 opAdd clContext workGroupSize + let map2 = Map.map2 opAdd clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClArray<'a option>) (rightVector: ClArray<'b option>) -> map2 processor allocationMode leftVector rightVector @@ -66,19 +67,20 @@ module Vector = let kernel = clContext.Compile(fillSubVectorKernel) - fun (processor: MailboxProcessor<_>) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: ClCell<'a>) (resultVector: ClArray<'a option>) -> + fun (processor: RawCommandQueue) (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: 'a) (resultVector: ClArray<'a option>) -> let ndRange = Range1D.CreateValid(leftVector.Length, workGroupSize) let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> kernel.KernelFunc ndRange leftVector.Length leftVector maskVector value resultVector) - ) + let valueCell = clContext.CreateClCell(value) - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc ndRange leftVector.Length leftVector maskVector valueCell resultVector + + processor.RunKernel kernel + + valueCell.Free() let assignByMask<'a, 'b when 'a: struct and 'b: struct> (maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>) @@ -89,7 +91,7 @@ module Vector = let assignByMask = assignByMaskInPlace maskOp clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: ClCell<'a>) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClArray<'a option>) (maskVector: ClArray<'b option>) (value: 'a) -> let resultVector = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, leftVector.Length) @@ -97,8 +99,49 @@ module Vector = resultVector - let toSparse<'a when 'a: struct> (clContext: ClContext) workGroupSize = + let assignBySparseMaskInPlace<'a, 'b when 'a: struct and 'b: struct> + (maskOp: Expr<'a option -> 'b option -> 'a -> 'a option>) + (clContext: ClContext) + workGroupSize + = + + let fillSubVectorKernel = + <@ fun (ndRange: Range1D) resultLength (leftVector: ClArray<'a option>) (maskVectorIndices: ClArray) (maskVectorValues: ClArray<'b>) (value: ClCell<'a>) (resultVector: ClArray<'a option>) -> + + let gid = ndRange.GlobalID0 + + if gid < resultLength then + let i = maskVectorIndices.[gid] + resultVector.[i] <- (%maskOp) leftVector.[i] (Some maskVectorValues.[gid]) value.Value @> + + let kernel = clContext.Compile(fillSubVectorKernel) + + fun (processor: RawCommandQueue) (leftVector: ClArray<'a option>) (maskVector: Sparse<'b>) (value: 'a) (resultVector: ClArray<'a option>) -> + + let ndRange = + Range1D.CreateValid(maskVector.NNZ, workGroupSize) + + let kernel = kernel.GetKernel() + + let valueCell = clContext.CreateClCell(value) + + kernel.KernelFunc + ndRange + maskVector.NNZ + leftVector + maskVector.Indices + maskVector.Values + valueCell + resultVector + + + processor.RunKernel kernel + + + valueCell.Free() + // TODO: toSparseUnsorted + bitonic probably would work faster + let toSparse<'a when 'a: struct> (clContext: ClContext) workGroupSize = let scatterValues = Common.Scatter.lastOccurrence clContext workGroupSize @@ -106,7 +149,7 @@ module Vector = Common.Scatter.lastOccurrence clContext workGroupSize let getBitmap = - ClArray.map (Map.option 1 0) clContext workGroupSize + Map.map (Map.option 1 0) clContext workGroupSize let prefixSum = Common.PrefixSum.standardExcludeInPlace clContext workGroupSize @@ -115,9 +158,9 @@ module Vector = ClArray.init Map.id clContext workGroupSize let allValues = - ClArray.map (Map.optionToValueOrZero Unchecked.defaultof<'a>) clContext workGroupSize + Map.map (Map.optionToValueOrZero Unchecked.defaultof<'a>) clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (vector: ClArray<'a option>) -> + fun (processor: RawCommandQueue) allocationMode (vector: ClArray<'a option>) -> let positions = getBitmap processor DeviceOnly vector @@ -134,7 +177,7 @@ module Vector = scatterIndices processor positions allIndices resultIndices - processor.Post <| Msg.CreateFreeMsg<_>(allIndices) + allIndices.Free() // compute result values let resultValues = @@ -144,9 +187,65 @@ module Vector = scatterValues processor positions allValues resultValues - processor.Post <| Msg.CreateFreeMsg<_>(allValues) + allValues.Free() + + positions.Free() + + { Context = clContext + Indices = resultIndices + Values = resultValues + Size = vector.Length } + + let toSparseUnsorted<'a when 'a: struct> (clContext: ClContext) workGroupSize = - processor.Post <| Msg.CreateFreeMsg<_>(positions) + let kernel = + <@ fun (ndRange: Range1D) (inputLength: int) (inputValues: ClArray<'a option>) (resultSize: ClCell) (resultIndices: ClArray) (resultValues: ClArray<'a>) -> + + let gid = ndRange.GlobalID0 + + if gid < inputLength then + match inputValues.[gid] with + | Some v -> + let offset = atomic (+) resultSize.Value 1 + resultIndices.[offset] <- gid + resultValues.[offset] <- v + | None -> () @> + + let kernel = clContext.Compile kernel + + let copy = ClArray.copy clContext workGroupSize + let copyValues = ClArray.copy clContext workGroupSize + + fun (processor: RawCommandQueue) allocationMode (vector: ClArray<'a option>) -> + + let tempIndices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vector.Length) + + let tempValues = + clContext.CreateClArrayWithSpecificAllocationMode<'a>(DeviceOnly, vector.Length) + + let resultLengthCell = clContext.CreateClCell(0) + + let ndRange = + Range1D.CreateValid(vector.Length, workGroupSize) + + let kernel = kernel.GetKernel() + + kernel.KernelFunc ndRange vector.Length vector resultLengthCell tempIndices tempValues + + processor.RunKernel kernel + + let resultLength = + resultLengthCell.ToHostAndFree(processor) + + let resultIndices = + copy processor allocationMode tempIndices resultLength + + let resultValues = + copyValues processor allocationMode tempValues resultLength + + tempIndices.Free() + tempValues.Free() { Context = clContext Indices = resultIndices @@ -161,13 +260,44 @@ module Vector = let reduce = Common.Reduce.reduce opAdd clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: ClArray<'a option>) -> + fun (processor: RawCommandQueue) (vector: ClArray<'a option>) -> choose processor DeviceOnly vector |> function | Some values -> let result = reduce processor values - processor.Post(Msg.CreateFreeMsg<_>(values)) + values.Free() result | None -> clContext.CreateClCell Unchecked.defaultof<'a> + + let ofList (clContext: ClContext) workGroupSize = + let scatter = + Common.Scatter.lastOccurrence clContext workGroupSize + + let zeroCreate = + ClArray.zeroCreate clContext workGroupSize + + let map = + Backend.Common.Map.map <@ Some @> clContext workGroupSize + + fun (processor: RawCommandQueue) allocationMode size (elements: (int * 'a) list) -> + let indices, values = elements |> Array.ofList |> Array.unzip + + let values = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, values) + + let indices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, indices) + + let mappedValues = map processor DeviceOnly values + + let result = zeroCreate processor allocationMode size + + scatter processor indices mappedValues result + + mappedValues.Free() + indices.Free() + values.Free() + + result diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs index 07e6e5e7..ab10edc8 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Common.fs @@ -3,6 +3,7 @@ namespace GraphBLAS.FSharp.Backend.Vector.Sparse open Brahma.FSharp open Microsoft.FSharp.Control open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Objects.ClVector open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Objects.ClCellExtensions @@ -11,7 +12,7 @@ module internal Common = let setPositions<'a when 'a: struct> (clContext: ClContext) workGroupSize = let sum = - Common.PrefixSum.standardExcludeInPlace clContext workGroupSize + Common.ScanInternal.standardExcludeInPlace clContext workGroupSize let valuesScatter = Common.Scatter.lastOccurrence clContext workGroupSize @@ -19,7 +20,7 @@ module internal Common = let indicesScatter = Common.Scatter.lastOccurrence clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> + fun (processor: RawCommandQueue) allocationMode (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> let resultLength = (sum processor positions).ToHostAndFree(processor) @@ -39,7 +40,7 @@ module internal Common = let setPositionsOption<'a when 'a: struct> (clContext: ClContext) workGroupSize = let sum = - Common.PrefixSum.standardExcludeInPlace clContext workGroupSize + Common.ScanInternal.standardExcludeInPlace clContext workGroupSize let valuesScatter = Common.Scatter.lastOccurrence clContext workGroupSize @@ -47,7 +48,7 @@ module internal Common = let indicesScatter = Common.Scatter.lastOccurrence clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> + fun (processor: RawCommandQueue) allocationMode (allValues: ClArray<'a>) (allIndices: ClArray) (positions: ClArray) -> let resultLength = (sum processor positions).ToHostAndFree(processor) @@ -74,9 +75,9 @@ module internal Common = let concatIndices = ClArray.concat clContext workGroupSize let mapIndices = - ClArray.mapWithValue clContext workGroupSize <@ fun x y -> x + y @> + Common.Map.mapWithValue clContext workGroupSize <@ fun x y -> x + y @> - fun (processor: MailboxProcessor<_>) allocationMode (vectors: Sparse<'a> seq) -> + fun (processor: RawCommandQueue) allocationMode (vectors: Sparse<'a> seq) -> let vectorIndices, _ = vectors diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs index 329e5484..82ba61fe 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map.fs @@ -37,7 +37,7 @@ module internal Map = let kernel = clContext.Compile <| preparePositions opAdd - fun (processor: MailboxProcessor<_>) (size: int) (values: ClArray<'a>) (indices: ClArray) -> + fun (processor: RawCommandQueue) (size: int) (values: ClArray<'a>) (indices: ClArray) -> let resultBitmap = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, size) @@ -52,21 +52,9 @@ module internal Map = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - size - values.Length - values - indices - resultBitmap - resultValues - resultIndices) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc ndRange size values.Length values indices resultBitmap resultValues resultIndices + + processor.RunKernel kernel resultBitmap, resultValues, resultIndices @@ -82,7 +70,7 @@ module internal Map = let setPositions = Common.setPositions<'b> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (vector: ClVector.Sparse<'a>) -> + fun (queue: RawCommandQueue) allocationMode (vector: ClVector.Sparse<'a>) -> let bitmap, values, indices = map queue vector.Size vector.Values vector.Indices @@ -90,12 +78,12 @@ module internal Map = let resultValues, resultIndices = setPositions queue allocationMode values indices bitmap - queue.Post(Msg.CreateFreeMsg<_>(bitmap)) - queue.Post(Msg.CreateFreeMsg<_>(values)) - queue.Post(Msg.CreateFreeMsg<_>(indices)) + bitmap.Free() + values.Free() + indices.Free() { Context = clContext - Indices = indices + Indices = resultIndices Values = resultValues Size = vector.Size } @@ -122,7 +110,7 @@ module internal Map = let kernel = clContext.Compile <| preparePositions opAdd - fun (processor: MailboxProcessor<_>) (value: ClCell<'a option>) (vector: Sparse<'b>) -> + fun (processor: RawCommandQueue) (value: ClCell<'a option>) (vector: Sparse<'b>) -> let resultBitmap = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vector.Size) @@ -138,22 +126,18 @@ module internal Map = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - value - vector.Size - vector.Values.Length - vector.Indices - vector.Values - resultIndices - resultValues - resultBitmap) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc + ndRange + value + vector.Size + vector.Values.Length + vector.Indices + vector.Values + resultIndices + resultValues + resultBitmap + + processor.RunKernel kernel resultIndices, resultValues, resultBitmap @@ -176,21 +160,21 @@ module internal Map = let init = ClArray.init <@ id @> clContext workGroupSize - fun (queue: MailboxProcessor<_>) allocationMode (value: 'a option) size -> + fun (queue: RawCommandQueue) allocationMode (value: 'a option) size -> function | Some vector -> let valueClCell = clContext.CreateClCell value let indices, values, bitmap = map queue valueClCell vector - valueClCell.Free queue + valueClCell.Free() let result = setPositions queue allocationMode values indices bitmap - indices.Free queue - values.Free queue - bitmap.Free queue + indices.Free() + values.Free() + bitmap.Free() result |> Option.map diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs index feb6e484..78fadbe9 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Map2.fs @@ -4,9 +4,12 @@ open Brahma.FSharp open FSharp.Quotations open Microsoft.FSharp.Control open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.ClCellExtensions open GraphBLAS.FSharp.Objects.ClVector open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Backend.Quotes +open Microsoft.FSharp.Core module internal Map2 = let private preparePositions<'a, 'b, 'c> opAdd (clContext: ClContext) workGroupSize = @@ -35,7 +38,7 @@ module internal Map2 = let kernel = clContext.Compile <| preparePositions opAdd - fun (processor: MailboxProcessor<_>) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) -> + fun (processor: RawCommandQueue) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) -> let resultBitmap = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) @@ -51,24 +54,20 @@ module internal Map2 = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - vectorLenght - leftValues.Length - rightValues.Length - leftValues - leftIndices - rightValues - rightIndices - resultBitmap - resultValues - resultIndices) - ) - - processor.Post(Msg.CreateRunMsg<_, _> kernel) + kernel.KernelFunc + ndRange + vectorLenght + leftValues.Length + rightValues.Length + leftValues + leftIndices + rightValues + rightIndices + resultBitmap + resultValues + resultIndices + + processor.RunKernel kernel resultBitmap, resultValues, resultIndices @@ -78,9 +77,9 @@ module internal Map2 = preparePositions<'a, 'b, 'c> op clContext workGroupSize let setPositions = - Common.setPositions clContext workGroupSize + Common.setPositionsOption clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> let bitmap, allValues, allIndices = prepare @@ -91,17 +90,110 @@ module internal Map2 = rightVector.Values rightVector.Indices - let resultValues, resultIndices = + let result = setPositions processor allocationMode allValues allIndices bitmap + |> Option.map + (fun (resultValues, resultIndices) -> + { Context = clContext + Values = resultValues + Indices = resultIndices + Size = leftVector.Size }) - processor.Post(Msg.CreateFreeMsg<_>(allIndices)) - processor.Post(Msg.CreateFreeMsg<_>(allValues)) - processor.Post(Msg.CreateFreeMsg<_>(bitmap)) + allIndices.Free() + allValues.Free() + bitmap.Free() - { Context = clContext - Values = resultValues - Indices = resultIndices - Size = max leftVector.Size rightVector.Size } + result + + let private preparePositionsSparseDense<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = + + let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = + <@ fun (ndRange: Range1D) length (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b option>) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultIndices: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < length then + + let i = leftIndices.[gid] + + let (leftValue: 'a option) = Some leftValues.[gid] + + let (rightValue: 'b option) = rightValues.[i] + + match (%op) leftValue rightValue with + | Some value -> + resultValues.[gid] <- value + resultIndices.[gid] <- i + + resultBitmap.[gid] <- 1 + | None -> resultBitmap.[gid] <- 0 @> + + let kernel = + clContext.Compile <| preparePositions opAdd + + fun (processor: RawCommandQueue) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b option>) -> + + let resultBitmap = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) + + let resultIndices = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, vectorLenght) + + let ndRange = + Range1D.CreateValid(vectorLenght, workGroupSize) + + let kernel = kernel.GetKernel() + + + kernel.KernelFunc + ndRange + vectorLenght + leftValues + leftIndices + rightValues + resultBitmap + resultValues + resultIndices + + processor.RunKernel kernel + + resultBitmap, resultValues, resultIndices + + //TODO: unify with sparseXsparse + let runSparseDense<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct> + op + (clContext: ClContext) + workGroupSize + = + + let prepare = + preparePositionsSparseDense<'a, 'b, 'c> clContext workGroupSize op + + let setPositions = + Common.setPositionsOption clContext workGroupSize + + fun (processor: RawCommandQueue) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClArray<'b option>) -> + + let bitmap, allValues, allIndices = + prepare processor leftVector.NNZ leftVector.Values leftVector.Indices rightVector + + let result = + setPositions processor allocationMode allValues allIndices bitmap + |> Option.map + (fun (resultValues, resultIndices) -> + { Context = clContext + Values = resultValues + Indices = resultIndices + Size = leftVector.Size }) + + allIndices.Free() + allValues.Free() + bitmap.Free() + + result let private preparePositionsAssignByMask<'a, 'b when 'a: struct and 'b: struct> op @@ -134,7 +226,7 @@ module internal Map2 = let kernel = clContext.Compile <| assign op - fun (processor: MailboxProcessor<_>) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) (value: ClCell<'a>) -> + fun (processor: RawCommandQueue) (vectorLenght: int) (leftValues: ClArray<'a>) (leftIndices: ClArray) (rightValues: ClArray<'b>) (rightIndices: ClArray) (value: ClCell<'a>) -> let resultBitmap = clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, vectorLenght) @@ -150,25 +242,22 @@ module internal Map2 = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - vectorLenght - leftValues.Length - rightValues.Length - leftValues - leftIndices - rightValues - rightIndices - value - resultBitmap - resultValues - resultIndices) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + + kernel.KernelFunc + ndRange + vectorLenght + leftValues.Length + rightValues.Length + leftValues + leftIndices + rightValues + rightIndices + value + resultBitmap + resultValues + resultIndices + + processor.RunKernel kernel resultBitmap, resultValues, resultIndices @@ -183,7 +272,9 @@ module internal Map2 = let setPositions = Common.setPositions clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) (value: ClCell<'a>) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) (value: 'a) -> + + let valueCell = clContext.CreateClCell(value) let bitmap, values, indices = prepare @@ -193,14 +284,15 @@ module internal Map2 = leftVector.Indices rightVector.Values rightVector.Indices - value + valueCell let resultValues, resultIndices = setPositions processor allocationMode values indices bitmap - processor.Post(Msg.CreateFreeMsg<_>(indices)) - processor.Post(Msg.CreateFreeMsg<_>(values)) - processor.Post(Msg.CreateFreeMsg<_>(bitmap)) + valueCell.Free() + indices.Free() + values.Free() + bitmap.Free() { Context = clContext Values = resultValues @@ -236,7 +328,7 @@ module internal Map2 = let kernel = clContext.Compile <| preparePositions op - fun (processor: MailboxProcessor<_>) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> + fun (processor: RawCommandQueue) (allIndices: ClArray) (leftValues: ClArray<'a>) (rightValues: ClArray<'b>) (isLeft: ClArray) -> let length = allIndices.Length @@ -251,21 +343,9 @@ module internal Map2 = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - length - allIndices - leftValues - rightValues - isLeft - allValues - positions) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc ndRange length allIndices leftValues rightValues isLeft allValues positions + + processor.RunKernel kernel allValues, positions @@ -280,27 +360,30 @@ module internal Map2 = preparePositions<'a, 'b, 'c> op clContext workGroupSize let setPositions = - Common.setPositions clContext workGroupSize + Common.setPositionsOption clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> + fun (processor: RawCommandQueue) allocationMode (leftVector: ClVector.Sparse<'a>) (rightVector: ClVector.Sparse<'b>) -> let allIndices, leftValues, rightValues, isLeft = merge processor leftVector rightVector let allValues, positions = prepare processor allIndices leftValues rightValues isLeft - processor.Post(Msg.CreateFreeMsg<_>(leftValues)) - processor.Post(Msg.CreateFreeMsg<_>(rightValues)) - processor.Post(Msg.CreateFreeMsg<_>(isLeft)) + leftValues.Free() + rightValues.Free() + isLeft.Free() - let resultValues, resultIndices = + let result = setPositions processor allocationMode allValues allIndices positions - - processor.Post(Msg.CreateFreeMsg<_>(allIndices)) - processor.Post(Msg.CreateFreeMsg<_>(allValues)) - processor.Post(Msg.CreateFreeMsg<_>(positions)) - - { Context = clContext - Values = resultValues - Indices = resultIndices - Size = max leftVector.Size rightVector.Size } + |> Option.map + (fun (resultValues, resultIndices) -> + { Context = clContext + Values = resultValues + Indices = resultIndices + Size = max leftVector.Size rightVector.Size }) + + allIndices.Free() + allValues.Free() + positions.Free() + + result diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Merge.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Merge.fs index 4c310edf..32e560c3 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Merge.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Merge.fs @@ -119,7 +119,7 @@ module internal Merge = let kernel = clContext.Compile merge - fun (processor: MailboxProcessor<_>) (firstVector: ClVector.Sparse<'a>) (secondVector: ClVector.Sparse<'b>) -> + fun (processor: RawCommandQueue) (firstVector: ClVector.Sparse<'a>) (secondVector: ClVector.Sparse<'b>) -> let firstSide = firstVector.Indices.Length @@ -144,24 +144,20 @@ module internal Merge = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc - ndRange - firstSide - secondSide - sumOfSides - firstVector.Indices - firstVector.Values - secondVector.Indices - secondVector.Values - allIndices - firstValues - secondValues - isLeftBitmap) - ) - - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + kernel.KernelFunc + ndRange + firstSide + secondSide + sumOfSides + firstVector.Indices + firstVector.Values + secondVector.Indices + secondVector.Values + allIndices + firstValues + secondValues + isLeftBitmap + + processor.RunKernel kernel allIndices, firstValues, secondValues, isLeftBitmap diff --git a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs index fed8bad6..e6463634 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Sparse/Vector.fs @@ -6,6 +6,7 @@ open Microsoft.FSharp.Quotations open GraphBLAS.FSharp open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVector +open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Backend.Quotes module Vector = @@ -14,18 +15,29 @@ module Vector = let copyData = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (vector: Sparse<'a>) -> + fun (processor: RawCommandQueue) allocationMode (vector: Sparse<'a>) -> { Context = clContext - Indices = copy processor allocationMode vector.Indices - Values = copyData processor allocationMode vector.Values + Indices = copy processor allocationMode vector.Indices vector.Indices.Length + Values = copyData processor allocationMode vector.Values vector.Values.Length Size = vector.Size } + let copyTo (clContext: ClContext) workGroupSize = + let copyTo = ClArray.copyTo clContext workGroupSize + + let copyDataTo = ClArray.copyTo clContext workGroupSize + + fun (processor: RawCommandQueue) (source: Sparse<'a>) (destination: Sparse<'a>) -> + copyTo processor source.Indices destination.Indices + copyDataTo processor source.Values destination.Values + let map = Map.run let mapWithValue = Map.WithValueOption.run let map2 = Map2.run + let map2SparseDense = Map2.runSparseDense + let map2AtLeastOne opAdd (clContext: ClContext) workGroupSize allocationMode = Map2.AtLeastOne.run (Convert.atLeastOneToOption opAdd) clContext workGroupSize allocationMode @@ -47,7 +59,7 @@ module Vector = let create = ClArray.zeroCreate clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector.Sparse<'a>) -> + fun (processor: RawCommandQueue) allocationMode (vector: ClVector.Sparse<'a>) -> let resultVector = create processor allocationMode vector.Size @@ -56,13 +68,9 @@ module Vector = let kernel = kernel.GetKernel() - processor.Post( - Msg.MsgSetArguments - (fun () -> - kernel.KernelFunc ndRange vector.Indices.Length vector.Values vector.Indices resultVector) - ) + kernel.KernelFunc ndRange vector.Indices.Length vector.Values vector.Indices resultVector - processor.Post(Msg.CreateRunMsg<_, _>(kernel)) + processor.RunKernel(kernel) resultVector @@ -71,4 +79,16 @@ module Vector = let reduce = Common.Reduce.reduce opAdd clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: ClVector.Sparse<'a>) -> reduce processor vector.Values + fun (processor: RawCommandQueue) (vector: ClVector.Sparse<'a>) -> reduce processor vector.Values + + let ofList (clContext: ClContext) allocationMode size (elements: (int * 'a) list) = + let indices, values = + elements + |> Array.ofList + |> Array.sortBy fst + |> Array.unzip + + { Context = clContext + Indices = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, indices) + Values = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, values) + Size = size } diff --git a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs index a9192eff..1c9f05c4 100644 --- a/src/GraphBLAS-sharp.Backend/Vector/Vector.fs +++ b/src/GraphBLAS-sharp.Backend/Vector/Vector.fs @@ -2,8 +2,10 @@ namespace GraphBLAS.FSharp open Brahma.FSharp open Microsoft.FSharp.Control +open Microsoft.FSharp.Core open Microsoft.FSharp.Quotations open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Objects.ClVector @@ -13,29 +15,29 @@ open GraphBLAS.FSharp.Backend.Vector [] module Vector = /// - /// Builds vector of given format with fixed size and fills it with the default values of desired type. + /// Builds vector of given format with fixed size and fills it with the given value. /// /// OpenCL context. /// Should be a power of 2 and greater than 1. - let zeroCreate (clContext: ClContext) workGroupSize = - let zeroCreate = - ClArray.zeroCreate clContext workGroupSize + let create (clContext: ClContext) workGroupSize = + let create = ClArray.create clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode size format -> + fun (processor: RawCommandQueue) allocationMode size format value -> match format with - | Sparse -> - ClVector.Sparse - { Context = clContext - Indices = clContext.CreateClArrayWithSpecificAllocationMode(allocationMode, [| 0 |]) - Values = - clContext.CreateClArrayWithSpecificAllocationMode( - allocationMode, - [| Unchecked.defaultof<'a> |] - ) // TODO empty vector - Size = size } + | Sparse -> failwith "Attempting to create full sparse vector" | Dense -> ClVector.Dense - <| zeroCreate processor allocationMode size + <| create processor allocationMode size value + + /// + /// Builds vector of given format with fixed size and fills it with the default values of desired type. + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let zeroCreate (clContext: ClContext) workGroupSize = + let create = create clContext workGroupSize + + fun (processor: RawCommandQueue) allocationMode size format -> create processor allocationMode size format None /// /// Builds vector of given format with fixed size and fills it with the values from the given list. @@ -50,9 +52,9 @@ module Vector = ClArray.zeroCreate clContext workGroupSize let map = - ClArray.map <@ Some @> clContext workGroupSize + Common.Map.map <@ Some @> clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode format size (elements: (int * 'a) list) -> + fun (processor: RawCommandQueue) allocationMode format size (elements: (int * 'a) list) -> match format with | Sparse -> let indices, values = @@ -81,9 +83,9 @@ module Vector = scatter processor indices mappedValues result - processor.Post(Msg.CreateFreeMsg(mappedValues)) - processor.Post(Msg.CreateFreeMsg(indices)) - processor.Post(Msg.CreateFreeMsg(values)) + mappedValues.Dispose() + indices.Dispose() + values.Dispose() ClVector.Dense result @@ -99,14 +101,14 @@ module Vector = let copyOptionData = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) -> + fun (processor: RawCommandQueue) allocationMode (vector: ClVector<'a>) -> match vector with | ClVector.Sparse vector -> ClVector.Sparse <| sparseCopy processor allocationMode vector | ClVector.Dense vector -> ClVector.Dense - <| copyOptionData processor allocationMode vector + <| copyOptionData processor allocationMode vector vector.Length /// /// Sparsifies the given vector if it is in a dense format. @@ -120,7 +122,27 @@ module Vector = let copy = copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) -> + fun (processor: RawCommandQueue) allocationMode (vector: ClVector<'a>) -> + match vector with + | ClVector.Dense vector -> + ClVector.Sparse + <| toSparse processor allocationMode vector + | ClVector.Sparse _ -> copy processor allocationMode vector + + /// + /// Sparsifies the given vector if it is in a dense format. + /// If the given vector is already sparse, copies it. + /// Works faster than regular version, but indices of the sparse vector are unsorted. + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let toSparseUnsorted (clContext: ClContext) workGroupSize = + let toSparse = + Dense.Vector.toSparseUnsorted clContext workGroupSize + + let copy = copy clContext workGroupSize + + fun (processor: RawCommandQueue) allocationMode (vector: ClVector<'a>) -> match vector with | ClVector.Dense vector -> ClVector.Sparse @@ -139,11 +161,11 @@ module Vector = let copy = ClArray.copy clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) -> + fun (processor: RawCommandQueue) allocationMode (vector: ClVector<'a>) -> match vector with | ClVector.Dense vector -> ClVector.Dense - <| copy processor allocationMode vector + <| copy processor allocationMode vector vector.Length | ClVector.Sparse vector -> ClVector.Dense <| toDense processor allocationMode vector @@ -156,7 +178,7 @@ module Vector = let denseFillVector = Dense.Vector.assignByMask op clContext workGroupSize - fun (processor: MailboxProcessor<_>) allocationMode (vector: ClVector<'a>) (mask: ClVector<'b>) (value: ClCell<'a>) -> + fun (processor: RawCommandQueue) allocationMode (vector: ClVector<'a>) (mask: ClVector<'b>) (value: 'a) -> match vector, mask with | ClVector.Sparse vector, ClVector.Sparse mask -> ClVector.Sparse @@ -166,12 +188,150 @@ module Vector = <| denseFillVector processor allocationMode vector mask value | _ -> failwith "Vector formats are not matching." + /// + /// Assign given value to all entries covered by mask. + /// + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. let assignByMask<'a, 'b when 'a: struct and 'b: struct> op clContext workGroupSize = assignByMaskGeneral<'a, 'b> (Convert.assignToOption op) clContext workGroupSize + /// + /// Assign given value to all entries NOT covered by mask. + /// + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. let assignByMaskComplemented<'a, 'b when 'a: struct and 'b: struct> op clContext workGroupSize = assignByMaskGeneral<'a, 'b> (Convert.assignComplementedToOption op) clContext workGroupSize + let private assignByMaskInPlaceGeneral<'a, 'b when 'a: struct and 'b: struct> + op + (clContext: ClContext) + workGroupSize + = + + let assignByDense = + Dense.Vector.assignByMaskInPlace op clContext workGroupSize + + let assignBySparse = + Dense.Vector.assignBySparseMaskInPlace op clContext workGroupSize + + fun (processor: RawCommandQueue) (vector: ClVector<'a>) (mask: ClVector<'b>) (value: 'a) -> + match vector, mask with + | ClVector.Dense vector, ClVector.Dense mask -> assignByDense processor vector mask value vector + | ClVector.Dense vector, ClVector.Sparse mask -> assignBySparse processor vector mask value vector + | _ -> failwith "Unsupported format" + + /// + /// Assign given value to all entries covered by mask. + /// Does it in-place. + /// + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let assignByMaskInPlace<'a, 'b when 'a: struct and 'b: struct> op clContext workGroupSize = + assignByMaskInPlaceGeneral<'a, 'b> (Convert.assignToOption op) clContext workGroupSize + + /// + /// Applying the given function to the corresponding elements of the two given arrays pairwise. + /// Stores the result in the left vector. + /// + /// + /// The two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2InPlace (map: Expr<'a option -> 'b option -> 'a option>) (clContext: ClContext) workGroupSize = + let map2Dense = + Dense.Vector.map2InPlace map clContext workGroupSize + + fun (processor: RawCommandQueue) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + match leftVector, rightVector with + | ClVector.Dense left, ClVector.Dense right -> map2Dense processor left right left + | _ -> failwith "Unsupported vector format" + + /// + /// Applying the given function to the corresponding elements of the two given arrays pairwise. + /// Stores the result in the given vector. + /// + /// + /// The two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2To (map: Expr<'a option -> 'b option -> 'c option>) (clContext: ClContext) workGroupSize = + let map2Dense = + Dense.Vector.map2InPlace map clContext workGroupSize + + fun (processor: RawCommandQueue) (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) (resultVector: ClVector<'c>) -> + match leftVector, rightVector, resultVector with + | ClVector.Dense left, ClVector.Dense right, ClVector.Dense result -> map2Dense processor left right result + | _ -> failwith "Unsupported vector format" + + /// + /// Applying the given function to the corresponding elements of the two given arrays pairwise. + /// Returns new vector. + /// + /// + /// The two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2Dense (map: Expr<'a option -> 'b option -> 'a option>) (clContext: ClContext) workGroupSize = + let map2Dense = + Dense.Vector.map2 map clContext workGroupSize + + fun (processor: RawCommandQueue) allocationFlag (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + match leftVector, rightVector with + | ClVector.Dense left, ClVector.Dense right -> map2Dense processor allocationFlag left right + | _ -> failwith "Unsupported vector format" + + /// + /// Applying the given function to the corresponding elements of the two given arrays pairwise. + /// Returns new vector as option. + /// + /// + /// The two input arrays must have the same lengths. + /// + /// The function to transform the pairs of the input elements. + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let map2Sparse (map: Expr<'a option -> 'b option -> 'a option>) (clContext: ClContext) workGroupSize = + let map2Sparse = + Sparse.Map2.run map clContext workGroupSize + + let map2SparseDense = + Sparse.Map2.runSparseDense map clContext workGroupSize + + fun (processor: RawCommandQueue) allocationFlag (leftVector: ClVector<'a>) (rightVector: ClVector<'b>) -> + match leftVector, rightVector with + | ClVector.Sparse left, ClVector.Sparse right -> + Option.map ClVector.Sparse (map2Sparse processor allocationFlag left right) + | ClVector.Sparse left, ClVector.Dense right -> + Option.map ClVector.Sparse (map2SparseDense processor allocationFlag left right) + | _ -> failwith "Unsupported vector format" + + /// + /// Check if vector contains such element that satisfies the predicate. + /// + /// + /// OpenCL context. + /// Should be a power of 2 and greater than 1. + let exists (predicate: Expr<'a option -> bool>) (clContext: ClContext) workGroupSize = + + let existsDense = + ClArray.exists predicate clContext workGroupSize + + fun (processor: RawCommandQueue) (vector: ClVector<'a>) -> + match vector with + | ClVector.Dense vector -> existsDense processor vector + | _ -> failwith "Unsupported format" + /// /// Applies a function to each value of the vector, threading an accumulator argument through the computation. /// Begin by applying the function to the first two values. @@ -191,7 +351,7 @@ module Vector = let denseReduce = Dense.Vector.reduce opAdd clContext workGroupSize - fun (processor: MailboxProcessor<_>) (vector: ClVector<'a>) -> + fun (processor: RawCommandQueue) (vector: ClVector<'a>) -> match vector with | ClVector.Sparse vector -> sparseReduce processor vector | ClVector.Dense vector -> denseReduce processor vector diff --git a/src/GraphBLAS-sharp/IO/MtxReader.fs b/src/GraphBLAS-sharp/IO/MtxReader.fs index f25ce8c0..fc68be31 100644 --- a/src/GraphBLAS-sharp/IO/MtxReader.fs +++ b/src/GraphBLAS-sharp/IO/MtxReader.fs @@ -68,40 +68,46 @@ type MtxReader(pathToFile: string) = let sortedData = match this.Symmetry with | General -> - [ 0 .. nnz - 1 ] - |> List.map (fun _ -> streamReader.ReadLine().Split(' ')) - |> Array.ofList - |> Array.Parallel.map - (fun line -> - let i = int line.[0] - let j = int line.[1] - - let v = - converter - <| if line.Length > 2 then line.[2] else "" - - struct (pack i j, v)) - |> Array.sortBy (fun struct (packedIndex, _) -> packedIndex) + let result = + [| 0 .. nnz - 1 |] + |> Array.map + (fun _ -> + let line = streamReader.ReadLine().Split(' ') + + let i = int line.[0] + let j = int line.[1] + + let v = + converter + <| if line.Length > 2 then line.[2] else "" + + struct (pack i j, v)) + + Array.sortInPlaceBy (fun struct (packedIndex, _) -> packedIndex) result + result | Symmetric -> - [ 0 .. nnz - 1 ] - |> List.map (fun _ -> streamReader.ReadLine().Split(' ')) - |> Array.ofList - |> Array.Parallel.map - (fun line -> - let i = int line.[0] - let j = int line.[1] - - let v = - converter - <| if line.Length > 2 then line.[2] else "" - - if i = j then - [| struct (pack i j, v) |] - else - [| struct (pack i j, v) - struct (pack j i, v) |]) - |> Array.concat - |> Array.sortBy (fun struct (packedIndex, _) -> packedIndex) + let result = + [| 0 .. nnz - 1 |] + |> Array.map + (fun _ -> + let line = streamReader.ReadLine().Split(' ') + + let i = int line.[0] + let j = int line.[1] + + let v = + converter + <| if line.Length > 2 then line.[2] else "" + + if i = j then + [| struct (pack i j, v) |] + else + [| struct (pack i j, v) + struct (pack j i, v) |]) + |> Array.concat + + Array.sortInPlaceBy (fun struct (packedIndex, _) -> packedIndex) result + result | _ -> failwith <| sprintf "This symmetry processing is not implemented: %A" this.Symmetry diff --git a/src/GraphBLAS-sharp/Objects/Matrix.fs b/src/GraphBLAS-sharp/Objects/Matrix.fs index e74e9153..84004b1a 100644 --- a/src/GraphBLAS-sharp/Objects/Matrix.fs +++ b/src/GraphBLAS-sharp/Objects/Matrix.fs @@ -187,8 +187,7 @@ module Matrix = { Context = context RowCount = this.RowCount ColumnCount = this.ColumnCount - Rows = rows - NNZ = this.NNZ } + Rows = rows } type Tuples<'a> = { RowIndices: int [] diff --git a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs index a0e8332a..a34c7c29 100644 --- a/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/MatrixExtensions.fs @@ -9,68 +9,68 @@ open GraphBLAS.FSharp.Objects.ClVectorExtensions module MatrixExtensions = // Matrix.Free type ClMatrix.COO<'a when 'a: struct> with - member this.Free(q: MailboxProcessor<_>) = - this.Columns.Free q - this.Values.Free q - this.Rows.Free q + member this.Free(q: RawCommandQueue) = + this.Columns.Free() + this.Values.Free() + this.Rows.Free() - member this.ToHost(q: MailboxProcessor<_>) = + member this.ToHost(q: RawCommandQueue) = { RowCount = this.RowCount ColumnCount = this.ColumnCount Rows = this.Rows.ToHost q Columns = this.Columns.ToHost q Values = this.Values.ToHost q } - member this.ToHostAndFree(q: MailboxProcessor<_>) = + member this.ToHostAndFree(q: RawCommandQueue) = let result = this.ToHost q this.Free q result type ClMatrix.CSR<'a when 'a: struct> with - member this.Free(q: MailboxProcessor<_>) = - this.Values.Free q - this.Columns.Free q - this.RowPointers.Free q + member this.Free(q: RawCommandQueue) = + this.Values.Free() + this.Columns.Free() + this.RowPointers.Free() - member this.ToHost(q: MailboxProcessor<_>) = + member this.ToHost(q: RawCommandQueue) = { RowCount = this.RowCount ColumnCount = this.ColumnCount RowPointers = this.RowPointers.ToHost q ColumnIndices = this.Columns.ToHost q Values = this.Values.ToHost q } - member this.ToHostAndFree(q: MailboxProcessor<_>) = + member this.ToHostAndFree(q: RawCommandQueue) = let result = this.ToHost q this.Free q result type ClMatrix.CSC<'a when 'a: struct> with - member this.Free(q: MailboxProcessor<_>) = - this.Values.Free q - this.Rows.Free q - this.ColumnPointers.Free q + member this.Free(q: RawCommandQueue) = + this.Values.Free() + this.Rows.Free() + this.ColumnPointers.Free() - member this.ToHost(q: MailboxProcessor<_>) = + member this.ToHost(q: RawCommandQueue) = { RowCount = this.RowCount ColumnCount = this.ColumnCount RowIndices = this.Rows.ToHost q ColumnPointers = this.ColumnPointers.ToHost q Values = this.Values.ToHost q } - member this.ToHostAndFree(q: MailboxProcessor<_>) = + member this.ToHostAndFree(q: RawCommandQueue) = let result = this.ToHost q this.Free q result type ClMatrix.LIL<'a when 'a: struct> with - member this.Free(q: MailboxProcessor<_>) = + member this.Free(q: RawCommandQueue) = this.Rows - |> List.iter (Option.iter (fun row -> row.Dispose q)) + |> List.iter (Option.iter (fun row -> row.Dispose())) - member this.ToHost(q: MailboxProcessor<_>) = + member this.ToHost(q: RawCommandQueue) = { RowCount = this.RowCount ColumnCount = this.ColumnCount Rows = @@ -78,32 +78,32 @@ module MatrixExtensions = |> List.map (Option.map (fun row -> row.ToHost q)) NNZ = this.NNZ } - member this.ToHostAndFree(q: MailboxProcessor<_>) = + member this.ToHostAndFree(q: RawCommandQueue) = let result = this.ToHost q this.Free q result type ClMatrix<'a when 'a: struct> with - member this.ToHost(q: MailboxProcessor<_>) = + member this.ToHost(q: RawCommandQueue) = match this with | ClMatrix.COO m -> m.ToHost q |> Matrix.COO | ClMatrix.CSR m -> m.ToHost q |> Matrix.CSR | ClMatrix.CSC m -> m.ToHost q |> Matrix.CSC | ClMatrix.LIL m -> m.ToHost q |> Matrix.LIL - member this.Free(q: MailboxProcessor<_>) = + member this.Free(q: RawCommandQueue) = match this with | ClMatrix.COO m -> m.Free q | ClMatrix.CSR m -> m.Free q | ClMatrix.CSC m -> m.Free q | ClMatrix.LIL m -> m.Free q - member this.FreeAndWait(processor: MailboxProcessor<_>) = + member this.FreeAndWait(processor: RawCommandQueue) = this.Free processor - processor.PostAndReply(MsgNotifyMe) + processor.Synchronize() - member this.ToHostAndFree(processor: MailboxProcessor<_>) = + member this.ToHostAndFree(processor: RawCommandQueue) = let result = this.ToHost processor this.Free processor diff --git a/src/GraphBLAS-sharp/Objects/VectorExtensions.fs b/src/GraphBLAS-sharp/Objects/VectorExtensions.fs index cfe098e7..bd69f8bb 100644 --- a/src/GraphBLAS-sharp/Objects/VectorExtensions.fs +++ b/src/GraphBLAS-sharp/Objects/VectorExtensions.fs @@ -6,13 +6,13 @@ open GraphBLAS.FSharp.Objects.ArraysExtensions module ClVectorExtensions = type ClVector.Sparse<'a> with - member this.ToHost(q: MailboxProcessor<_>) = + member this.ToHost(q: Brahma.FSharp.RawCommandQueue) = { 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<_>) = + member this.ToHost(q: Brahma.FSharp.RawCommandQueue) = match this with | ClVector.Sparse vector -> Vector.Sparse <| vector.ToHost q | ClVector.Dense vector -> Vector.Dense <| vector.ToHost q diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/BFS.fs b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/BFS.fs index edf40fea..8575af21 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/BFS.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/BFS.fs @@ -14,21 +14,37 @@ let testFixtures (testContext: TestContext) = [ let config = Utils.undirectedAlgoConfig let context = testContext.ClContext let queue = testContext.Queue - let workGroupSize = Utils.defaultWorkGroupSize + let workGroupSize = Constants.Common.defaultWorkGroupSize let testName = sprintf "Test on %A" testContext.ClContext let bfs = Algorithms.BFS.singleSource - ArithmeticOperations.intSumOption - ArithmeticOperations.intMulOption + ArithmeticOperations.boolSumOption + ArithmeticOperations.boolMulOption + context + workGroupSize + + let bfsSparse = + Algorithms.BFS.singleSourceSparse + ArithmeticOperations.boolSumOption + ArithmeticOperations.boolMulOption + context + workGroupSize + + let bfsPushPull = + Algorithms.BFS.singleSourcePushPull + ArithmeticOperations.boolSumOption + ArithmeticOperations.boolMulOption context workGroupSize testPropertyWithConfig config testName <| fun (matrix: int [,]) -> + let matrixBool = Array2D.map (fun x -> x <> 0) matrix + let graph = undirectedFromArray2D matrix 0 let largestComponent = @@ -42,26 +58,43 @@ let testFixtures (testContext: TestContext) = |> Utils.createArrayFromDictionary (Array2D.length1 matrix) 0 let matrixHost = - Utils.createMatrixFromArray2D CSR matrix ((=) 0) + Utils.createMatrixFromArray2D CSR matrixBool ((=) false) + + let matrixHostBool = + Utils.createMatrixFromArray2D CSR (Array2D.map (fun x -> x <> 0) matrix) ((=) false) let matrix = matrixHost.ToDevice context + let matrixBool = matrixHostBool.ToDevice context + + let res = bfs queue matrix source + + let resSparse = bfsSparse queue matrixBool source + + let resPushPull = bfsPushPull queue matrixBool source + + let resHost = res.ToHost queue + let resHostSparse = resSparse.ToHost queue + let resHostPushPull = resPushPull.ToHost queue - match matrix with - | ClMatrix.CSR mtx -> - let res = - bfs queue matrix source |> ClVector.Dense + matrix.Dispose() + matrixBool.Dispose() + res.Dispose() + resSparse.Dispose() + resPushPull.Dispose() - let resHost = res.ToHost queue + match resHost, resHostSparse, resHostPushPull with + | Vector.Dense resHost, Vector.Dense resHostSparse, Vector.Dense resHostPushPull -> + let actual = resHost |> Utils.unwrapOptionArray 0 - (mtx :> IDeviceMemObject).Dispose queue - res.Dispose queue + let actualSparse = + resHostSparse |> Utils.unwrapOptionArray 0 - match resHost with - | Vector.Dense resHost -> - let actual = resHost |> Utils.unwrapOptionArray 0 + let actualPushPull = + resHostPushPull |> Utils.unwrapOptionArray 0 - Expect.sequenceEqual actual expected "Sequences must be equal" - | _ -> failwith "Not implemented" + Expect.sequenceEqual actual expected "Dense bfs is not as expected" + Expect.sequenceEqual actualSparse expected "Sparse bfs is not as expected" + Expect.sequenceEqual actualPushPull expected "Push-pull bfs is not as expected" | _ -> failwith "Not implemented" ] let tests = diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/MSBFS.fs b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/MSBFS.fs new file mode 100644 index 00000000..af94bbe0 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/MSBFS.fs @@ -0,0 +1,127 @@ +module GraphBLAS.FSharp.Tests.Backend.Algorithms.MSBFS + +open Expecto +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Context +open GraphBLAS.FSharp.Tests.Backend.QuickGraph.Algorithms +open GraphBLAS.FSharp.Tests.Backend.QuickGraph.CreateGraph +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.MatrixExtensions + +let config = Utils.undirectedAlgoConfig + +let workGroupSize = Constants.Common.defaultWorkGroupSize + +let makeLevelsTest context queue bfs (matrix: int [,]) = + let graph = undirectedFromArray2D matrix 0 + + let largestComponent = + ConnectedComponents.largestComponent graph + + Array.sortInPlace largestComponent + + if largestComponent.Length > 1 then + let sourceVertexCount = max 2 (largestComponent.Length / 10) + + let source = + largestComponent.[0..sourceVertexCount - 1] + |> Array.sort + |> Array.toList + + let matrixHost = + Utils.createMatrixFromArray2D CSR matrix ((=) 0) + + let matrixDevice = matrixHost.ToDevice context + + let expectedArray2D: int [,] = + Array2D.zeroCreate sourceVertexCount (Array2D.length1 matrix) + + source + |> List.iteri + (fun i vertex -> + (snd (BFS.runUndirected graph vertex)) + |> Utils.createArrayFromDictionary (Array2D.length1 matrix) 0 + |> Array.iteri (fun col value -> expectedArray2D.[i, col] <- value)) + + let expected = + Utils.createMatrixFromArray2D COO expectedArray2D ((=) 0) + + let actual: ClMatrix = bfs queue matrixDevice source + let actual = actual.ToHostAndFree queue + + matrixDevice.Dispose() + + match actual, expected with + | Matrix.COO a, Matrix.COO e -> Utils.compareCOOMatrix (=) a e + | _ -> failwith "Not implemented" + +let createLevelsTest<'a> context queue testFun = + testFun + |> makeLevelsTest context queue + |> testPropertyWithConfig config $"test on %A{typeof<'a>}, %A{context}" + +let levelsTestFixtures (testContext: TestContext) = + [ let context = testContext.ClContext + let queue = testContext.Queue + + let bfsLevels = + Algorithms.MSBFS.runLevels + ArithmeticOperations.intAddWithoutZero + ArithmeticOperations.intMulWithoutZero + context + workGroupSize + + createLevelsTest context queue bfsLevels ] + +let levelsTests = + TestCases.gpuTests "MSBFS Levels tests" levelsTestFixtures + +let makeParentsTest context queue bfs (matrix: int [,]) = + + let graph = undirectedFromArray2D matrix 0 + + let largestComponent = + ConnectedComponents.largestComponent graph + + if largestComponent.Length > 1 then + let sourceVertexCount = max 2 (largestComponent.Length / 10) + + let source = largestComponent.[0..sourceVertexCount] + source |> Array.sortInPlace + let source = source |> Array.toList + + let matrixHost = + Utils.createMatrixFromArray2D CSR matrix ((=) 0) + + let matrixDevice = matrixHost.ToDevice context + + let expected = + HostPrimitives.MSBFSParents matrix source + + let actual: ClMatrix = bfs queue matrixDevice source + let actual = actual.ToHostAndFree queue + + matrixDevice.Dispose() + + match actual, expected with + | Matrix.COO a, Matrix.COO e -> Utils.compareCOOMatrix (=) a e + | _ -> failwith "Not implemented" + +let createParentsTest<'a> context queue testFun = + testFun + |> makeParentsTest context queue + |> testPropertyWithConfig config $"test on %A{typeof<'a>}, %A{context}" + +let parentsTestFixtures (testContext: TestContext) = + [ let context = testContext.ClContext + let queue = testContext.Queue + + let bfsParents = + Algorithms.MSBFS.runParents context workGroupSize + + createParentsTest context queue bfsParents ] + +let parentsTests = + TestCases.gpuTests "MSBFS Parents tests" parentsTestFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/PageRank.fs b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/PageRank.fs new file mode 100644 index 00000000..6495407a --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/PageRank.fs @@ -0,0 +1,121 @@ +module GraphBLAS.FSharp.Tests.Backend.Algorithms.PageRank + +open Expecto +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Context +open GraphBLAS.FSharp.Objects.ClVectorExtensions +open GraphBLAS.FSharp.Objects + +let prepareNaive (matrix: float32 [,]) = + let result = Array2D.copy matrix + let rowCount = Array2D.length1 matrix + let outDegrees = Array.zeroCreate rowCount + + //Count degree + Array2D.iteri (fun r c v -> outDegrees.[r] <- outDegrees.[r] + (if v <> 0f then 1f else 0f)) matrix + + //Set value + Array2D.iteri + (fun r c v -> + result.[r, c] <- + if v <> 0f then + Constants.PageRank.alpha / outDegrees.[r] + else + 0f) + matrix + + //Transpose + Array2D.iteri + (fun r c _ -> + if r > c then + let temp = result.[r, c] + result.[r, c] <- result.[c, r] + result.[c, r] <- temp) + matrix + + result + +let pageRankNaive (matrix: float32 [,]) = + let rowCount = Array2D.length1 matrix + let mutable result = Array.zeroCreate rowCount + + let mutable prev = + Array.create rowCount (1f / (float32 rowCount)) + + let mutable error = Constants.PageRank.accuracy + 1f + + let addConst = + (1f - Constants.PageRank.alpha) + / (float32 rowCount) + + while (error > Constants.PageRank.accuracy) do + for r in 0 .. rowCount - 1 do + result.[r] <- 0f + + for c in 0 .. rowCount - 1 do + result.[r] <- result.[r] + matrix.[r, c] * prev.[c] + + result.[r] <- result.[r] + addConst + + error <- + sqrt + <| Array.fold2 (fun e x1 x2 -> e + (x1 - x2) * (x1 - x2)) 0f result prev + + let temp = result + result <- prev + prev <- temp + + prev + +let testFixtures (testContext: TestContext) = + [ let config = Utils.undirectedAlgoConfig + let context = testContext.ClContext + let queue = testContext.Queue + + let workGroupSize = + GraphBLAS.FSharp.Constants.Common.defaultWorkGroupSize + + let testName = + sprintf "Test on %A" testContext.ClContext + + let pageRank = + Algorithms.PageRank.run context workGroupSize + + testPropertyWithConfig config testName + <| fun (matrix: float32 [,]) -> + let matrixHost = + Utils.createMatrixFromArray2D CSR matrix ((=) 0f) + + if matrixHost.NNZ > 0 then + let preparedMatrixExpected = prepareNaive matrix + + let expected = pageRankNaive preparedMatrixExpected + + let matrix = matrixHost.ToDevice context + + let preparedMatrix = + Algorithms.PageRank.prepareMatrix context workGroupSize queue matrix + + let res = + pageRank queue preparedMatrix Constants.PageRank.accuracy + + let resHost = res.ToHost queue + + preparedMatrix.Dispose() + matrix.Dispose() + res.Dispose() + + match resHost with + | Vector.Dense resHost -> + let actual = resHost |> Utils.unwrapOptionArray 0f + + for i in 0 .. actual.Length - 1 do + Expect.isTrue + (Utils.float32IsEqualLowAccuracy actual.[i] expected.[i]) + (sprintf "Values should be equal. Expected %A, actual %A" expected.[i] actual.[i]) + + | _ -> failwith "Not implemented" ] + +let tests = + TestCases.gpuTests "PageRank tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/SSSP.fs b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/SSSP.fs new file mode 100644 index 00000000..4c3f312d --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Algorithms/SSSP.fs @@ -0,0 +1,65 @@ +module GraphBLAS.FSharp.Tests.Backend.Algorithms.SSSP + +open Expecto +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Context +open GraphBLAS.FSharp.Tests.Backend.QuickGraph.Algorithms +open GraphBLAS.FSharp.Tests.Backend.QuickGraph.CreateGraph +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.ClVectorExtensions + +let testFixtures (testContext: TestContext) = + [ let config = Utils.undirectedAlgoConfig + let context = testContext.ClContext + let queue = testContext.Queue + + let workGroupSize = + GraphBLAS.FSharp.Constants.Common.defaultWorkGroupSize + + let testName = + sprintf "Test on %A" testContext.ClContext + + let ssspDense = + Algorithms.SSSP.run context workGroupSize + + testPropertyWithConfig config testName + <| fun (matrix: int [,]) -> + + let matrix = Array2D.map (fun x -> abs x) matrix + + let graph = undirectedFromArray2D matrix 0 + + let largestComponent = + ConnectedComponents.largestComponent graph + + if largestComponent.Length > 0 then + let source = largestComponent.[0] + + let expected = + SSSP.runUndirected matrix (directedFromArray2D matrix 0) source + |> Array.map (Option.map int) + + let matrixHost = + Utils.createMatrixFromArray2D CSR matrix ((=) 0) + + let matrix = matrixHost.ToDevice context + + let resDense = ssspDense queue matrix source + + let resHost = resDense.ToHost queue + + matrix.Dispose() + resDense.Dispose() + + match resHost with + | Vector.Dense resHost -> + let actual = resHost + + Expect.sequenceEqual actual expected "Sequences must be equal" + | _ -> failwith "Not implemented" ] + +let tests = + TestCases.gpuTests "SSSP tests" testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Blit.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Blit.fs index 8387bdcc..bc026886 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Blit.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Blit.fs @@ -24,7 +24,7 @@ let makeTest<'a> isEqual testFun (source: 'a [], sourceIndex, target: 'a [], tar testFun processor clSource sourceIndex clTarget targetIndex count - clSource.Free processor + clSource.Free() let actual = clTarget.ToHostAndFree processor // write to target --- target expected @@ -34,7 +34,7 @@ let makeTest<'a> isEqual testFun (source: 'a [], sourceIndex, target: 'a [], tar |> Utils.compareArrays isEqual actual target let createTest<'a when 'a: equality> isEqual = - ClArray.blit context Utils.defaultWorkGroupSize + ClArray.blit context Constants.Common.defaultWorkGroupSize |> makeTest<'a> isEqual |> testPropertyWithConfig config $"test on %A{typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs index 3fd89e84..83f55a79 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Choose.fs @@ -9,7 +9,7 @@ open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Objects.ArraysExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions -let workGroupSize = Utils.defaultWorkGroupSize +let workGroupSize = Constants.Common.defaultWorkGroupSize let config = Utils.defaultConfig @@ -73,14 +73,14 @@ let makeTest2 testContext isEqual opMap testFun (firstArray: 'a [], secondArray: testFun processor HostInterop clFirstArray clSecondArray let actual = clActual.ToHostAndFree processor - clFirstArray.Free processor - clSecondArray.Free processor + clFirstArray.Free() + clSecondArray.Free() "Results must be the same" |> Utils.compareArrays isEqual actual expected let createTest2 testsContext (isEqual: 'a -> 'a -> bool) (opMapQ, opMap) testFun = - testFun opMapQ testsContext.ClContext Utils.defaultWorkGroupSize + testFun opMapQ testsContext.ClContext Constants.Common.defaultWorkGroupSize |> makeTest2 testsContext isEqual opMap |> testPropertyWithConfig config $"test on %A{typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ChunkBySize.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ChunkBySize.fs index 2cc3133e..315aa12f 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ChunkBySize.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ChunkBySize.fs @@ -25,14 +25,14 @@ let makeTestGetChunk<'a when 'a: equality> testFun (array: 'a [], startPosition, let (clActual: ClArray<'a>) = testFun processor HostInterop clArray startPosition count - clArray.Free processor + clArray.Free() 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 + ClArray.sub context Constants.Common.defaultWorkGroupSize |> makeTestGetChunk<'a> |> testPropertyWithConfig config $"test on %A{typeof<'a>}" @@ -56,7 +56,7 @@ let makeTestChunkBySize<'a when 'a: equality> isEqual testFun (array: 'a [], chu let clActual: ClArray<'a> [] = (testFun processor HostInterop chunkSize clArray) - clArray.Free processor + clArray.Free() let actual = clActual @@ -72,7 +72,7 @@ let chunkBySizeConfig = arbitrary = [ typeof ] } let creatTestChunkBySize<'a when 'a: equality> isEqual = - ClArray.chunkBySize context Utils.defaultWorkGroupSize + ClArray.chunkBySize context Constants.Common.defaultWorkGroupSize |> makeTestChunkBySize<'a> isEqual |> testPropertyWithConfig chunkBySizeConfig $"test on %A{typeof<'a>}" @@ -89,7 +89,7 @@ let chunkBySizeTests = let creatTestChunkBySizeLazy<'a when 'a: equality> isEqual = (fun processor allocationMode chunkSize array -> - ClArray.lazyChunkBySize context Utils.defaultWorkGroupSize processor allocationMode chunkSize array + ClArray.lazyChunkBySize context Constants.Common.defaultWorkGroupSize processor allocationMode chunkSize array |> Seq.map (fun lazyValue -> lazyValue.Value) |> Seq.toArray) |> makeTestChunkBySize<'a> isEqual diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Concat.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Concat.fs index 48dcb77c..526a85f2 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Concat.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Concat.fs @@ -26,8 +26,7 @@ let makeTest<'a> isEqual testFun (arrays: 'a [] []) = // release let actual = clActual.ToHostAndFree processor - clArrays - |> Seq.iter (fun array -> array.Free processor) + clArrays |> Seq.iter (fun array -> array.Free()) let expected = Seq.concat arrays |> Seq.toArray @@ -35,7 +34,7 @@ let makeTest<'a> isEqual testFun (arrays: 'a [] []) = |> Utils.compareArrays isEqual actual expected let createTest<'a> isEqual = - ClArray.concat context Utils.defaultWorkGroupSize + ClArray.concat context Constants.Common.defaultWorkGroupSize |> makeTest<'a> isEqual |> testPropertyWithConfig config $"test on %A{typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Copy.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Copy.fs index c36475a0..68f3adff 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Copy.fs @@ -13,21 +13,24 @@ let logger = Log.create "ClArray.Copy.Tests" let context = Context.defaultContext.ClContext -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let q = Context.defaultContext.Queue let config = Utils.defaultConfig -let makeTest<'a when 'a: equality> copyFun (array: array<'a>) = +let makeTest<'a when 'a: equality> + (copyFun: RawCommandQueue -> AllocationFlag -> ClArray<'a> -> int -> ClArray<'a>) + (array: array<'a>) + = if array.Length > 0 then - let clArray = context.CreateClArray array + let clArray: ClArray<'a> = context.CreateClArray array let actual = - (copyFun q HostInterop clArray: ClArray<_>) + (copyFun q DeviceOnly clArray clArray.Length) .ToHostAndFree q - clArray.Free q + clArray.Free() logger.debug ( eventX "Actual is {actual}" @@ -43,7 +46,7 @@ let creatTest<'a when 'a: equality> = |> testPropertyWithConfig config $"Correctness test on random %A{typeof<'a>} arrays" let testCases = - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ creatTest creatTest diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ExcludeElements.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ExcludeElements.fs new file mode 100644 index 00000000..c5817d45 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/ExcludeElements.fs @@ -0,0 +1,63 @@ +module GraphBLAS.FSharp.Tests.Backend.Common.ClArray.ExcludeElements + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.ClContextExtensions + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let makeTest<'a> isEqual (zero: 'a) testFun ((array, bitmap): 'a array * int array) = + if array.Length > 0 && (Array.exists ((=) 1) bitmap) then + + let arrayCl = context.CreateClArray array + let bitmapCl = context.CreateClArray bitmap + + let actual: ClArray<'a> option = + testFun processor HostInterop bitmapCl arrayCl + + let actual = + actual + |> Option.map (fun a -> a.ToHostAndFree processor) + + arrayCl.Free() + bitmapCl.Free() + + let expected = + (bitmap, array) + ||> Array.zip + |> Array.filter (fun (bit, _) -> bit <> 1) + |> Array.unzip + |> snd + + match actual with + | Some actual -> + "Results must be the same" + |> Utils.compareArrays isEqual actual expected + | None -> + "Expected should be empty" + |> Expect.isEmpty expected + +let createTest<'a> (zero: 'a) isEqual = + ClArray.excludeElements context Constants.Common.defaultWorkGroupSize + |> makeTest<'a> isEqual zero + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest 0 (=) + + if Utils.isFloat64Available context.ClDevice then + createTest 0.0 (=) + + createTest 0.0f (=) + createTest false (=) ] + |> testList "ExcludeElements tests" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Exists.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Exists.fs index ac991951..80c735da 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Exists.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Exists.fs @@ -19,7 +19,7 @@ let q = defaultContext.Queue let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let correctnessGenericTest<'a when 'a: struct and 'a: equality> isZero exists (array: 'a []) = diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Fill.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Fill.fs index 8a285a2f..7ec14be2 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Fill.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Fill.fs @@ -33,7 +33,7 @@ let makeTest<'a> isEqual testFun (value: 'a, targetPosition, count, target: 'a [ |> Utils.compareArrays isEqual actual target let createTest<'a> isEqual = - ClArray.fill context Utils.defaultWorkGroupSize + ClArray.fill context Constants.Common.defaultWorkGroupSize |> makeTest<'a> isEqual |> testPropertyWithConfig config $"test on %A{typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs index a3786832..638ecd75 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Item.fs @@ -24,7 +24,7 @@ let makeTest<'a when 'a: equality> testFun (array: 'a [], position) = let result: ClCell<'a> = testFun processor position clArray - clArray.Free processor + clArray.Free() let actual = result.ToHost processor let expected = Array.item position array @@ -33,7 +33,7 @@ let makeTest<'a when 'a: equality> testFun (array: 'a [], position) = |> Expect.equal actual expected let createTest<'a when 'a: equality> = - ClArray.item context Utils.defaultWorkGroupSize + ClArray.item context Constants.Common.defaultWorkGroupSize |> makeTest<'a> |> testPropertyWithConfig config $"test on %A{typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map.fs index 1cb85d29..b5e3712a 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map.fs @@ -4,13 +4,15 @@ open Expecto open Brahma.FSharp open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Context -open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions let context = defaultContext.Queue -let wgSize = Utils.defaultWorkGroupSize +let wgSize = + GraphBLAS.FSharp.Constants.Common.defaultWorkGroupSize let config = Utils.defaultConfig @@ -29,10 +31,7 @@ let makeTest (testContext: TestContext) mapFun zero isEqual (array: 'a option [] let (actualDevice: ClArray<_>) = mapFun q HostInterop clArray - let actualHost = Array.zeroCreate actualDevice.Length - - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(actualDevice, actualHost, ch)) - |> ignore + let actualHost = actualDevice.ToHostAndFree q let expected = Array.map (mapOptionToValue zero) array @@ -44,7 +43,7 @@ let createTest<'a when 'a: equality> (testContext: TestContext) (zero: 'a) isEqu let context = testContext.ClContext let map = - ClArray.map (Map.optionToValueOrZero zero) context wgSize + Map.map (Map.optionToValueOrZero zero) context wgSize makeTest testContext map zero isEqual |> testPropertyWithConfig config $"Correctness on {typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map2.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map2.fs index 0b5ab49b..b2903f04 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Map2.fs @@ -4,13 +4,15 @@ open Expecto open Brahma.FSharp open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Context -open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend.Common open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.ArraysExtensions let context = defaultContext.Queue -let wgSize = Utils.defaultWorkGroupSize +let wgSize = + GraphBLAS.FSharp.Constants.Common.defaultWorkGroupSize let config = Utils.defaultConfig @@ -28,10 +30,7 @@ let makeTest<'a when 'a: equality> testContext clMapFun hostMapFun isEqual (left let (actualDevice: ClArray<'a>) = clMapFun q HostInterop leftClArray rightClArray - let actualHost = Array.zeroCreate actualDevice.Length - - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(actualDevice, actualHost, ch)) - |> ignore + let actualHost = actualDevice.ToHostAndFree q let expected = Array.map2 hostMapFun leftArray rightArray @@ -43,7 +42,7 @@ let createTest<'a when 'a: equality> (testContext: TestContext) isEqual hostMapF let context = testContext.ClContext - let map = ClArray.map2 mapFunQ context wgSize + let map = Map.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 index 12db7aa8..00a8daa2 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Pairwise.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Pairwise.fs @@ -34,7 +34,7 @@ let makeTest<'a> isEqual testFun (array: 'a []) = |> Expect.isTrue (array.Size <= 1) let createTest<'a> isEqual = - ClArray.pairwise context Utils.defaultWorkGroupSize + ClArray.pairwise context Constants.Common.defaultWorkGroupSize |> makeTest<'a> isEqual |> testPropertyWithConfig config $"test on %A{typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/RemoveDuplicates.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/RemoveDuplicates.fs index 276cf286..6b08b6cd 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/RemoveDuplicates.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/RemoveDuplicates.fs @@ -6,6 +6,7 @@ open Expecto.Logging.Message open Brahma.FSharp open GraphBLAS.FSharp open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Objects.ArraysExtensions let logger = Log.create "RemoveDuplicates.Tests" @@ -15,7 +16,7 @@ let testCases = let removeDuplicates_wg_2 = ClArray.removeDuplications context 2 let removeDuplicates_wg_32 = ClArray.removeDuplications context 32 let q = Context.defaultContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ testCase "Simple correctness test" <| fun () -> @@ -26,8 +27,7 @@ let testCases = let actual = let clActual = removeDuplicates_wg_2 q clArray - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + clActual.ToHostAndFree q logger.debug ( eventX "Actual is {actual}" @@ -55,8 +55,7 @@ let testCases = let actual = let clActual = removeDuplicates q clArray - let actual = Array.zeroCreate clActual.Length - q.PostAndReply(fun ch -> Msg.CreateToHostMsg(clActual, actual, ch)) + clActual.ToHostAndFree q logger.debug ( eventX "Actual is {actual}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Replicate.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Replicate.fs index 2d6ecc6b..b6d11d3c 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Replicate.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Replicate.fs @@ -15,7 +15,7 @@ let context = Context.defaultContext.ClContext let q = Context.defaultContext.Queue -let workGroupSize = Utils.defaultWorkGroupSize +let workGroupSize = Constants.Common.defaultWorkGroupSize let config = Utils.defaultConfig @@ -27,7 +27,7 @@ let makeTest<'a when 'a: equality> replicateFun (array: array<'a>) i = (replicateFun q HostInterop clArray i: ClArray<'a>) .ToHostAndFree q - clArray.Free q + clArray.Free() logger.debug ( eventX $"Actual is {actual}" @@ -46,7 +46,7 @@ let createTest<'a when 'a: equality> = |> testPropertyWithConfig config $"Correctness test on random %A{typeof<'a>} arrays" let testCases = - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ createTest createTest diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Set.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Set.fs index cf1d09e5..c5a76404 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Set.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/Set.fs @@ -30,7 +30,7 @@ let makeTest<'a when 'a: equality> testFun (array: 'a [], position, value: 'a) = |> Utils.compareArrays (=) actual array let createTest<'a when 'a: equality> = - ClArray.set context Utils.defaultWorkGroupSize + ClArray.set context Constants.Common.defaultWorkGroupSize |> makeTest<'a> |> testPropertyWithConfig config $"test on %A{typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs index 7f1f2c81..492e98b6 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/ClArray/UpperBound.fs @@ -45,7 +45,7 @@ let makeTest testFun (array: 'a [], value: 'a) = |> Expect.equal actual expected let createTest<'a when 'a: equality and 'a: comparison> = - ClArray.upperBound<'a> context Utils.defaultWorkGroupSize + ClArray.upperBound<'a> context Constants.Common.defaultWorkGroupSize |> makeTest |> testPropertyWithConfig config $"test on %A{typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Gather.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Gather.fs index b82b65d6..ab68213b 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Gather.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Gather.fs @@ -39,8 +39,8 @@ let makeTest isEqual testFun (array: (uint * 'a * 'a) []) = testFun processor clPositions clValues clTarget - clPositions.Free processor - clValues.Free processor + clPositions.Free() + clValues.Free() let actual = clTarget.ToHostAndFree processor @@ -49,7 +49,7 @@ let makeTest isEqual testFun (array: (uint * 'a * 'a) []) = let createTest<'a> (isEqual: 'a -> 'a -> bool) testFun = let testFun = - testFun context Utils.defaultWorkGroupSize + testFun context Constants.Common.defaultWorkGroupSize makeTest isEqual testFun |> testPropertyWithConfig Utils.defaultConfig $"test on %A{typeof<'a>}" @@ -81,7 +81,7 @@ let makeTestInit isEqual testFun indexMap (array: ('a * 'a) []) = testFun processor clValues clTarget - clValues.Free processor + clValues.Free() let actual = clTarget.ToHostAndFree processor @@ -90,7 +90,7 @@ let makeTestInit isEqual testFun indexMap (array: ('a * 'a) []) = let createTestInit<'a> (isEqual: 'a -> 'a -> bool) testFun indexMapQ indexMap = let testFun = - testFun indexMapQ context Utils.defaultWorkGroupSize + testFun indexMapQ context Constants.Common.defaultWorkGroupSize makeTestInit isEqual testFun indexMap |> testPropertyWithConfig Utils.defaultConfig $"test on {typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Reduce.fs index 54dfee30..8f6457ad 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Reduce.fs @@ -15,11 +15,11 @@ let context = Context.defaultContext.ClContext let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let q = Context.defaultContext.Queue -let makeTest (reduce: MailboxProcessor<_> -> ClArray<'a> -> ClCell<'a>) plus zero (array: 'a []) = +let makeTest (reduce: RawCommandQueue -> ClArray<'a> -> ClCell<'a>) plus zero (array: 'a []) = if array.Length > 0 then let reduce = reduce q @@ -33,7 +33,7 @@ let makeTest (reduce: MailboxProcessor<_> -> ClArray<'a> -> ClCell<'a>) plus zer let clArray = context.CreateClArray array let total = reduce clArray - clArray.Free q + clArray.Free() total.ToHostAndFree q logger.debug ( @@ -59,7 +59,7 @@ let testFixtures plus plusQ zero name = |> testPropertyWithConfig config $"Correctness on %s{name}" let tests = - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ testFixtures (+) <@ (+) @> 0 "int add" testFixtures (+) <@ (+) @> 0uy "byte add" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/ReduceByKey.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/ReduceByKey.fs index 0e58f323..18abe5c8 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/ReduceByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/ReduceByKey.fs @@ -52,8 +52,8 @@ let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = let clActualValues, clActualKeys: ClArray<'a> * ClArray = reduce processor HostInterop resultLength clKeys clValues - clValues.Free processor - clKeys.Free processor + clValues.Free() + clKeys.Free() let actualValues = clActualValues.ToHostAndFree processor let actualKeys = clActualKeys.ToHostAndFree processor @@ -63,7 +63,7 @@ let makeTest isEqual reduce reduceOp (arrayAndKeys: (int * 'a) []) = let createTestSequential<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = - Common.Reduce.ByKey.sequential reduceOpQ context Utils.defaultWorkGroupSize + Common.Reduce.ByKey.sequential reduceOpQ context Constants.Common.defaultWorkGroupSize makeTest isEqual reduce reduceOp |> testPropertyWithConfig config $"test on {typeof<'a>}" @@ -97,12 +97,12 @@ let sequentialTest = let createTestOneWorkGroup<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = - Common.Reduce.ByKey.oneWorkGroupSegments reduceOpQ context Utils.defaultWorkGroupSize + Common.Reduce.ByKey.oneWorkGroupSegments reduceOpQ context Constants.Common.defaultWorkGroupSize makeTest isEqual reduce reduceOp |> testPropertyWithConfig { config with - endSize = Utils.defaultWorkGroupSize } + endSize = Constants.Common.defaultWorkGroupSize } $"test on {typeof<'a>}" let oneWorkGroupTest = @@ -166,7 +166,7 @@ let makeTestSequentialSegments isEqual reduce reduceOp (valuesAndKeys: (int * 'a let createTestSequentialSegments<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = - Common.Reduce.ByKey.segmentSequential reduceOpQ context Utils.defaultWorkGroupSize + Common.Reduce.ByKey.segmentSequential reduceOpQ context Constants.Common.defaultWorkGroupSize makeTestSequentialSegments isEqual reduce reduceOp |> testPropertyWithConfig { config with startSize = 1000 } $"test on {typeof<'a>}" @@ -235,9 +235,9 @@ let makeTest2D isEqual reduce reduceOp (array: (int * int * 'a) []) = let clActualValues, clFirstActualKeys, clSecondActualKeys: ClArray<'a> * ClArray * ClArray = reduce processor HostInterop resultLength clFirstKeys clSecondKeys clValues - clValues.Free processor - clFirstKeys.Free processor - clSecondKeys.Free processor + clValues.Free() + clFirstKeys.Free() + clSecondKeys.Free() let actualValues = clActualValues.ToHostAndFree processor @@ -252,7 +252,7 @@ let makeTest2D isEqual reduce reduceOp (array: (int * int * 'a) []) = let createTestSequential2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = - Common.Reduce.ByKey2D.sequential reduceOpQ context Utils.defaultWorkGroupSize + Common.Reduce.ByKey2D.sequential reduceOpQ context Constants.Common.defaultWorkGroupSize makeTest2D isEqual reduce reduceOp |> testPropertyWithConfig @@ -331,7 +331,7 @@ let makeTestSequentialSegments2D isEqual reduce reduceOp (array: (int * int * 'a let createTestSequentialSegments2D<'a> (isEqual: 'a -> 'a -> bool) reduceOp reduceOpQ = let reduce = - Common.Reduce.ByKey2D.segmentSequential reduceOpQ context Utils.defaultWorkGroupSize + Common.Reduce.ByKey2D.segmentSequential reduceOpQ context Constants.Common.defaultWorkGroupSize makeTestSequentialSegments2D isEqual reduce reduceOp |> testPropertyWithConfig @@ -430,7 +430,7 @@ let testOption<'a> isEqual reduceOp testFun (array: (int * 'a) []) = |> checkResultOption isEqual keys values reduceOp let createTestOption (isEqual: 'a -> 'a -> bool) (reduceOpQ, reduceOp) = - Common.Reduce.ByKey.Option.segmentSequential reduceOpQ context Utils.defaultWorkGroupSize + Common.Reduce.ByKey.Option.segmentSequentialByOffsets reduceOpQ context Constants.Common.defaultWorkGroupSize |> testOption<'a> isEqual reduceOp |> testPropertyWithConfig { config with @@ -518,7 +518,7 @@ let test2DOption<'a> isEqual reduceOp reduce (array: (int * int * 'a) []) = |> checkResult2DOption isEqual firstKeys secondKeys values reduceOp let createTest2DOption (isEqual: 'a -> 'a -> bool) (reduceOpQ, reduceOp) = - Common.Reduce.ByKey2D.Option.segmentSequential reduceOpQ context Utils.defaultWorkGroupSize + Common.Reduce.ByKey2D.Option.segmentSequential reduceOpQ context Constants.Common.defaultWorkGroupSize |> test2DOption<'a> isEqual reduceOp |> testPropertyWithConfig { config with diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Sum.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Sum.fs index 3953c3c0..a05a7165 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Sum.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Reduce/Sum.fs @@ -32,7 +32,7 @@ let makeTest plus zero sum (array: 'a []) = let clArray = context.CreateClArray array let (total: ClCell<_>) = sum q clArray - clArray.Free q + clArray.Free() total.ToHostAndFree q logger.debug ( @@ -57,7 +57,7 @@ let testFixtures plus (plusQ: Expr<'a -> 'a -> 'a>) zero name = let tests = - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ testFixtures (+) <@ (+) @> 0 "int add" testFixtures (+) <@ (+) @> 0uy "byte add" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/ByKey.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/ByKey.fs index 1cea79dd..9da27c2b 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/ByKey.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/ByKey.fs @@ -41,8 +41,8 @@ let makeTestSequentialSegments isEqual scanHost scanDevice (keysAndValues: (int scanDevice processor uniqueKeysCount clValues clKeys clOffsets let actual = clValues.ToHostAndFree processor - clKeys.Free processor - clOffsets.Free processor + clKeys.Free() + clOffsets.Free() let keysAndValues = Array.zip keys values @@ -53,7 +53,7 @@ let createTest (zero: 'a) opAddQ opAdd isEqual deviceScan hostScan = let hostScan = hostScan zero opAdd let deviceScan = - deviceScan opAddQ zero context Utils.defaultWorkGroupSize + deviceScan opAddQ zero context Constants.Common.defaultWorkGroupSize makeTestSequentialSegments isEqual hostScan deviceScan |> testPropertyWithConfig Utils.defaultConfig $"test on {typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/PrefixSum.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/PrefixSum.fs index f94b0564..d7379ac9 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/PrefixSum.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scan/PrefixSum.fs @@ -13,33 +13,51 @@ let logger = Log.create "ClArray.PrefixSum.Tests" let context = defaultContext.ClContext -let config = Tests.Utils.defaultConfig +let config = + { Tests.Utils.defaultConfig with + maxTest = 20 + startSize = 1 + endSize = 1000000 } let wgSize = 128 let q = defaultContext.Queue -let makeTest plus zero isEqual scan (array: 'a []) = +let makeTest plus zero isEqual scanInclude scanExclude (array: 'a []) = if array.Length > 0 then + // Exclude + let actual, actualSum = + let clArray = context.CreateClArray array + let (total: ClCell<_>) = scanExclude q clArray + + let actual = clArray.ToHostAndFree q + let actualSum = total.ToHostAndFree q + + actual, actualSum + + let expected, expectedSum = + array + |> Array.mapFold + (fun s t -> + let a = plus s t + s, a) + zero + + "Arrays for exclude should be the same" + |> Tests.Utils.compareArrays isEqual actual expected - logger.debug ( - eventX $"Array is %A{array}\n" - >> setField "array" (sprintf "%A" array) - ) + "Total sums for exclude should be equal" + |> Expect.equal actualSum expectedSum + // Include let actual, actualSum = let clArray = context.CreateClArray array - let (total: ClCell<_>) = scan q clArray zero + let (total: ClCell<_>) = scanInclude q clArray zero let actual = clArray.ToHostAndFree q let actualSum = total.ToHostAndFree q actual, actualSum - logger.debug ( - eventX "Actual is {actual}\n" - >> setField "actual" (sprintf "%A" actual) - ) - let expected, expectedSum = array |> Array.mapFold @@ -48,25 +66,18 @@ let makeTest plus zero isEqual scan (array: 'a []) = a, a) zero - logger.debug ( - eventX "Expected is {expected}\n" - >> setField "expected" (sprintf "%A" expected) - ) - - "Total sums should be equal" + "Total sums for include should be equal" |> Expect.equal actualSum expectedSum - "Arrays should be the same" + "Arrays for include should be the same" |> Tests.Utils.compareArrays isEqual actual expected let testFixtures plus plusQ zero isEqual name = - Common.PrefixSum.runIncludeInPlace plusQ context wgSize - |> makeTest plus zero isEqual + (PrefixSum.runIncludeInPlace plusQ context wgSize, PrefixSum.runExcludeInPlace plusQ zero context wgSize) + ||> makeTest plus zero isEqual |> testPropertyWithConfig config $"Correctness on %s{name}" let tests = - q.Error.Add(fun e -> failwithf "%A" e) - [ testFixtures (+) <@ (+) @> 0 (=) "int add" testFixtures (+) <@ (+) @> 0uy (=) "byte add" testFixtures max <@ max @> 0 (=) "int max" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Scatter.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scatter.fs index c1d71dca..a9e337dd 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Scatter.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Scatter.fs @@ -15,7 +15,7 @@ let context = defaultContext.ClContext let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let q = defaultContext.Queue @@ -33,8 +33,8 @@ let makeTest<'a when 'a: equality> hostScatter scatter (array: (int * 'a) []) (r scatter q clPositions clValues clResult - clValues.Free q - clPositions.Free q + clValues.Free() + clPositions.Free() clResult.ToHostAndFree q $"Arrays should be equal." @@ -51,7 +51,7 @@ let testFixturesFirst<'a when 'a: equality> = |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" let tests = - q.Error.Add(fun e -> failwithf $"%A{e}") + //q.Error.Add(fun e -> failwithf $"%A{e}") let last = [ testFixturesLast @@ -81,7 +81,7 @@ let makeTestInit<'a when 'a: equality> hostScatter valueMap scatter (positions: scatter q clPositions clResult - clPositions.Free q + clPositions.Free() let actual = clResult.ToHostAndFree q $"Arrays should be equal." @@ -89,13 +89,13 @@ let makeTestInit<'a when 'a: equality> hostScatter valueMap scatter (positions: let createInitTest clScatter hostScatter name valuesMap valuesMapQ = let scatter = - clScatter valuesMapQ context Utils.defaultWorkGroupSize + clScatter valuesMapQ context Constants.Common.defaultWorkGroupSize makeTestInit<'a> hostScatter valuesMap scatter |> testPropertyWithConfig config name let initTests = - q.Error.Add(fun e -> failwithf $"%A{e}") + //sq.Error.Add(fun e -> failwithf $"%A{e}") let inc = ((+) 1) diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Bitonic.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Bitonic.fs index 6297fe13..f1533586 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Bitonic.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Bitonic.fs @@ -17,11 +17,12 @@ module Bitonic = { Utils.defaultConfig with endSize = 1000000 } - let wgSize = Utils.defaultWorkGroupSize + let wgSize = + GraphBLAS.FSharp.Constants.Common.defaultWorkGroupSize let q = defaultContext.Queue - let makeTest sort (array: ('n * 'n * 'a) []) = + let makeTest sort (array: (int * int * 'a) []) = if array.Length > 0 then let projection (row: 'n) (col: 'n) (_: 'a) = row, col @@ -31,6 +32,8 @@ module Bitonic = ) let rows, cols, vals = Array.unzip3 array + let rows = Array.map abs rows + let cols = Array.map abs cols let clRows = context.CreateClArray rows let clColumns = context.CreateClArray cols @@ -57,16 +60,47 @@ module Bitonic = $"Column arrays should be equal. Actual is \n%A{actualCols}, expected \n%A{expectedCols}, input is \n%A{cols}" |> Utils.compareArrays (=) actualCols expectedCols - $"Value arrays should be equal. Actual is \n%A{actualValues}, expected \n%A{expectedValues}, input is \n%A{vals}" - |> Utils.compareArrays (=) actualValues expectedValues + // Check that for each pair of equal keys values are the same + let mutable i = 1 + + let expected, actual = + new ResizeArray<'a>(), new ResizeArray<'a>() + + expected.Add expectedValues.[0] + actual.Add actualValues.[0] + + while i < expectedValues.Size do + if + not + ( + actualRows.[i - 1] = actualRows.[i] + && actualCols.[i - 1] = actualCols.[i] + ) + then + Expect.sequenceEqual + (actual |> Seq.countBy id) + (actual |> Seq.countBy id) + $"Values for keys %A{actualRows.[i - 1]}, %A{actualCols.[i - 1]} are not the same" + + expected.Clear() + actual.Clear() + + expected.Add expectedValues.[i] + actual.Add actualValues.[i] + i <- i + 1 + + Expect.sequenceEqual + actual + expected + $"Values for keys %A{actualRows.[i - 1]}, %A{actualCols.[i - 1]} are not the same" let testFixtures<'a when 'a: equality> = - Sort.Bitonic.sortKeyValuesInplace context wgSize + Sort.Bitonic.sortRowsColumnsValuesInplace<'a> context wgSize |> makeTest |> testPropertyWithConfig config $"Correctness on %A{typeof<'a>}" let tests = - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ testFixtures diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Radix.fs b/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Radix.fs index 9de0e054..13f4e9fb 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Radix.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Common/Sort/Radix.fs @@ -10,14 +10,20 @@ let config = { Utils.defaultConfig with startSize = 1000000 } -let workGroupSize = Utils.defaultWorkGroupSize +let workGroupSize = + GraphBLAS.FSharp.Constants.Common.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 +let checkResultByKeys (inputArray: (int * 'a) []) (actualKeys: int []) (actualValues: 'a []) = + let expected = Seq.sortBy fst inputArray + let expectedKeys = expected |> Seq.map fst + let expectedValues = expected |> Seq.map snd + + "Keys must be the same" + |> Expect.sequenceEqual expectedKeys actualKeys "Values must be the same" |> Expect.sequenceEqual expectedValues actualValues @@ -31,12 +37,13 @@ let makeTestByKeys<'a when 'a: equality> sortFun (array: (int * 'a) []) = let clKeys = keys.ToDevice context let clValues = values.ToDevice context - let clActualValues: ClArray<'a> = + let clActualKeys, clActualValues: ClArray * ClArray<'a> = sortFun processor HostInterop clKeys clValues + let actualKeys = clActualKeys.ToHostAndFree processor let actualValues = clActualValues.ToHostAndFree processor - checkResultByKeys array actualValues + checkResultByKeys array actualKeys actualValues let createTestByKeys<'a when 'a: equality and 'a: struct> = let sort = diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ByRows.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ByRows.fs index caa86e58..8635f07e 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ByRows.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ByRows.fs @@ -45,7 +45,7 @@ let makeTest<'a when 'a: struct> isEqual zero testFun (array: 'a [,]) = |> Expect.isFalse (Array.exists ((<<) not <| isEqual zero) array.[index, *])) let createTest isEqual (zero: 'a) = - CSR.Matrix.byRows context Utils.defaultWorkGroupSize + CSR.Matrix.byRows context Constants.Common.defaultWorkGroupSize |> makeTest<'a> isEqual zero |> testPropertyWithConfig config $"test on %A{typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Convert.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Convert.fs index 8e88e216..a34300d5 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Convert.fs @@ -10,18 +10,19 @@ open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions +open Brahma.FSharp let logger = Log.create "Convert.Tests" let config = Utils.defaultConfig -let workGroupSize = Utils.defaultWorkGroupSize +let workGroupSize = Constants.Common.defaultWorkGroupSize let context = defaultContext.ClContext let q = defaultContext.Queue -q.Error.Add(fun e -> failwithf "%A" e) +//q.Error.Add(fun e -> failwithf "%A" e) let makeTest context q formatFrom formatTo convertFun isZero (array: 'a [,]) = let mtx = @@ -32,8 +33,8 @@ let makeTest context q formatFrom formatTo convertFun isZero (array: 'a [,]) = let mBefore = mtx.ToDevice context let mAfter: ClMatrix<'a> = convertFun q HostInterop mBefore let res = mAfter.ToHost q - mBefore.Dispose q - mAfter.Dispose q + mBefore.Dispose() + mAfter.Dispose() res logger.debug ( @@ -55,7 +56,7 @@ let makeTest context q formatFrom formatTo convertFun isZero (array: 'a [,]) = let createTest<'a when 'a: struct and 'a: equality> convertFun formatTo (isZero: 'a -> bool) = let convertFun = - convertFun context Utils.defaultWorkGroupSize + convertFun context Constants.Common.defaultWorkGroupSize Utils.listOfUnionCases |> List.map diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ExpandRows.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ExpandRows.fs index 63cd8bee..a85d0e46 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ExpandRows.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/ExpandRows.fs @@ -34,7 +34,7 @@ let makeTest isZero testFun (array: 'a [,]) = |> Expect.sequenceEqual actual expected let createTest (isZero: 'a -> bool) = - CSR.Matrix.expandRowPointers context Utils.defaultWorkGroupSize + CSR.Matrix.expandRowPointers context GraphBLAS.FSharp.Constants.Common.defaultWorkGroupSize |> makeTest isZero |> testPropertyWithConfig config $"test on {typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Intersect.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Intersect.fs new file mode 100644 index 00000000..d4def956 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Intersect.fs @@ -0,0 +1,78 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.Intersect + +open Expecto +open Brahma.FSharp +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Context +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.ArraysExtensions + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let workGroupSize = Constants.Common.defaultWorkGroupSize + +let context = defaultContext.ClContext +let processor = defaultContext.Queue + +let makeTest<'a when 'a: struct> isZero testFun (leftMatrix: 'a [,], rightMatrix: 'a [,]) = + + let m1 = + Matrix.COO.FromArray2D(leftMatrix, isZero) + + let m2 = + Matrix.COO.FromArray2D(rightMatrix, isZero) + + if m1.NNZ > 0 && m2.NNZ > 0 then + + let expected = + let mutable index = 0 + let bitmap = Array.zeroCreate m1.NNZ + + leftMatrix + |> Array2D.iteri + (fun row col value -> + if row < m2.RowCount + && col < m2.ColumnCount + && not <| isZero rightMatrix.[row, col] + && not <| isZero value then + bitmap.[index] <- 1 + + if not <| isZero value then + index <- index + 1) + + bitmap + + let m1 = m1.ToDevice context + let m2 = m2.ToDevice context + + let actual: ClArray = + testFun processor ClContextExtensions.HostInterop m1 m2 + + let actual = actual.ToHostAndFree processor + + m1.Dispose() + m2.Dispose() + + // Check result + "Matrices should be equal" + |> Expect.equal actual expected + +let inline createTest<'a when 'a: struct> (isZero: 'a -> bool) = + Matrix.COO.Matrix.findKeysIntersection context workGroupSize + |> makeTest<'a> isZero + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let tests = + [ createTest ((=) false) + createTest ((=) 0) + createTest ((=) 0uy) + createTest (Utils.float32IsEqual 0.0f) + + if Utils.isFloat64Available context.ClDevice then + createTest (Utils.floatIsEqual 0.0) ] + |> testList "Intersect tests" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs index 6d0f8d01..c015716a 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Kronecker.fs @@ -9,6 +9,7 @@ open GraphBLAS.FSharp.Tests.TestCases open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Backend.Quotes +open Brahma.FSharp let config = { Utils.defaultConfig with @@ -17,7 +18,7 @@ let config = let logger = Log.create "kronecker.Tests" -let workGroupSize = Utils.defaultWorkGroupSize +let workGroupSize = Constants.Common.defaultWorkGroupSize let makeTest testContext zero isEqual op kroneckerFun (leftMatrix: 'a [,], rightMatrix: 'a [,]) = let context = testContext.ClContext @@ -51,11 +52,11 @@ let makeTest testContext zero isEqual op kroneckerFun (leftMatrix: 'a [,], right let actual = Option.map (fun (m: ClMatrix<'a>) -> m.ToHost processor) result - m1.Dispose processor - m2.Dispose processor + m1.Dispose() + m2.Dispose() match result with - | Some m -> m.Dispose processor + | Some m -> m.Dispose() | _ -> () // Check result @@ -68,7 +69,7 @@ let createGeneralTest testContext (zero: 'a) isEqual op opQ testName = |> testPropertyWithConfig config $"test on %A{typeof<'a>} %s{testName}" let generalTests (testContext: TestContext) = - [ testContext.Queue.Error.Add(fun e -> failwithf "%A" e) + [ //testContext.Queue.Error.Add(fun e -> failwithf "%A" e) createGeneralTest testContext false (=) (&&) ArithmeticOperations.boolMulOption "mul" createGeneralTest testContext false (=) (||) ArithmeticOperations.boolSumOption "sum" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs index e61d65bf..a5303ed8 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map.fs @@ -13,11 +13,12 @@ open GraphBLAS.FSharp.Tests.TestCases open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Objects.MatrixExtensions +open Brahma.FSharp let logger = Log.create "Map.Tests" let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let getCorrectnessTestName case datatype = $"Correctness on %s{datatype}, %A{case}" @@ -51,7 +52,7 @@ let checkResult isEqual op zero (baseMtx: 'a [,]) (actual: Matrix<'a>) = let correctnessGenericTest zero op - (addFun: MailboxProcessor<_> -> AllocationFlag -> ClMatrix<'a> -> ClMatrix<'b>) + (addFun: RawCommandQueue -> AllocationFlag -> ClMatrix<'a> -> ClMatrix<'b>) toCOOFun (isEqual: 'a -> 'a -> bool) q @@ -70,13 +71,13 @@ let correctnessGenericTest let res = addFun q HostInterop m - m.Dispose q + m.Dispose() let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res let actual = cooRes.ToHost q - cooRes.Dispose q - res.Dispose q + cooRes.Dispose() + res.Dispose() logger.debug ( eventX "Actual is {actual}" @@ -108,7 +109,7 @@ let createTestMap case (zero: 'a) (constant: 'a) binOp isEqual opQ = let testFixturesMapNot case = [ let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap case false true (fun _ -> not) (=) (fun _ _ -> ArithmeticOperations.notOption) ] @@ -118,7 +119,7 @@ let notTests = let testFixturesMapAdd case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap case 0 10 (+) (=) ArithmeticOperations.addLeftConst @@ -135,7 +136,7 @@ let addTests = let testFixturesMapMul case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap case 0 10 (*) (=) ArithmeticOperations.mulLeftConst diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs index 9d746f11..6462e6c7 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Map2.fs @@ -13,11 +13,12 @@ open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions +open Brahma.FSharp let logger = Log.create "Map2.Tests" let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let getCorrectTestName case datatype = $"Correctness on %s{datatype}, %A{case}" @@ -51,7 +52,7 @@ let checkResult isEqual op zero (baseMtx1: 'a [,]) (baseMtx2: 'a [,]) (actual: M let correctnessGenericTest zero op - (addFun: MailboxProcessor<_> -> AllocationFlag -> ClMatrix<'a> -> ClMatrix<'a> -> ClMatrix<'c>) + (addFun: RawCommandQueue -> AllocationFlag -> ClMatrix<'a> -> ClMatrix<'a> -> ClMatrix<'c>) toCOOFun (isEqual: 'a -> 'a -> bool) q @@ -75,14 +76,14 @@ let correctnessGenericTest let res = addFun q HostInterop m1 m2 - m1.Dispose q - m2.Dispose q + m1.Dispose() + m2.Dispose() let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res let actual = cooRes.ToHost q - cooRes.Dispose q - res.Dispose q + cooRes.Dispose() + res.Dispose() logger.debug ( eventX "Actual is {actual}" @@ -111,7 +112,7 @@ let createTestMap2Add case (zero: 'a) add isEqual addQ map2 = let testFixturesMap2Add case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap2Add case false (||) (=) ArithmeticOperations.boolSumOption Operations.Matrix.map2 createTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumOption Operations.Matrix.map2 @@ -128,7 +129,7 @@ let addTests = let testFixturesMap2AddAtLeastOne case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap2Add case false (||) (=) ArithmeticOperations.boolSumAtLeastOne Operations.Matrix.map2AtLeastOne createTestMap2Add case 0 (+) (=) ArithmeticOperations.intSumAtLeastOne Operations.Matrix.map2AtLeastOne @@ -159,7 +160,7 @@ let addAtLeastOneTests = let testFixturesMap2MulAtLeastOne case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap2Add case false (&&) (=) ArithmeticOperations.boolMulAtLeastOne Operations.Matrix.map2AtLeastOne createTestMap2Add case 0 (*) (=) ArithmeticOperations.intMulAtLeastOne Operations.Matrix.map2AtLeastOne diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Merge.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Merge.fs index 554fbff2..cbee2338 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Merge.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Merge.fs @@ -2,12 +2,14 @@ module GraphBLAS.FSharp.Tests.Backend.Matrix.Merge open Brahma.FSharp open Expecto +open GraphBLAS.FSharp.Test open Microsoft.FSharp.Collections open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Backend open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ArraysExtensions +open GraphBLAS.FSharp.Objects.MatrixExtensions let context = Context.defaultContext.ClContext @@ -66,8 +68,8 @@ let makeTestCOO isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = (clIsLeft: ClArray)) = testFun processor clLeftMatrix clRightMatrix - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor + clLeftMatrix.Dispose() + clRightMatrix.Dispose() let leftValues = clLeftValues.ToHostAndFree processor let rightValues = clRightValues.ToHostAndFree processor @@ -94,7 +96,7 @@ let makeTestCOO isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = checkResult isEqual zero actual leftArray rightArray let createTestCOO isEqual (zero: 'a) = - Matrix.COO.Merge.run context Utils.defaultWorkGroupSize + Matrix.COO.Merge.run context GraphBLAS.FSharp.Constants.Common.defaultWorkGroupSize |> makeTestCOO isEqual zero |> testPropertyWithConfig config $"test on {typeof<'a>}" @@ -108,6 +110,60 @@ let testsCOO = createTestCOO (=) false ] |> testList "COO" +let makeTestCOODisjoint isEqual zero testFun (array: ('a * 'a) [,]) = + + let leftArray = Array2D.map fst array + let rightArray = Array2D.map snd array + + let leftMatrix = + Matrix.COO.FromArray2D(leftArray, isEqual zero) + + let rightMatrix = + Matrix.COO.FromArray2D(rightArray, isEqual zero) + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + + let actual: ClMatrix.COO<'a> = + testFun processor clLeftMatrix clRightMatrix + + let actual = actual.ToHostAndFree processor + + clLeftMatrix.Dispose() + clRightMatrix.Dispose() + + rightArray + |> Array2D.iteri + (fun row column value -> + if value <> zero then + leftArray.[row, column] <- value) + + let expected = + Matrix.COO.FromArray2D(leftArray, isEqual zero) + + Utils.compareCOOMatrix isEqual actual expected + +let createTestCOODisjoint isEqual (zero: 'a) = + let configDisjoint = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + + Matrix.COO.Merge.runDisjoint context GraphBLAS.FSharp.Constants.Common.defaultWorkGroupSize + |> makeTestCOODisjoint isEqual zero + |> testPropertyWithConfig configDisjoint $"test on {typeof<'a>}" + +let testsCOODisjoint = + [ createTestCOODisjoint (=) 0 + + if Utils.isFloat64Available context.ClDevice then + createTestCOODisjoint (=) 0.0 + + createTestCOODisjoint (=) 0.0f + createTestCOODisjoint (=) false ] + |> testList "COO Disjoint" + let makeTestCSR isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = let leftMatrix = Matrix.CSR.FromArray2D(leftArray, isEqual zero) @@ -129,12 +185,12 @@ let makeTestCSR isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = (clIsLeft: ClArray)) = testFun processor clLeftMatrix clRightMatrix - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor + clLeftMatrix.Dispose() + clRightMatrix.Dispose() let leftValues = clLeftValues.ToHostAndFree processor let rightValues = clRightValues.ToHostAndFree processor - clIsEndOfRow.Free processor + clIsEndOfRow.Free() let isLeft = clIsLeft.ToHostAndFree processor let actualValues = @@ -158,7 +214,7 @@ let makeTestCSR isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) = checkResult isEqual zero actual leftArray rightArray let createTestCSR isEqual (zero: 'a) = - Matrix.CSR.Merge.run context Utils.defaultWorkGroupSize + Matrix.CSR.Merge.run context GraphBLAS.FSharp.Constants.Common.defaultWorkGroupSize |> makeTestCSR isEqual zero |> testPropertyWithConfig config $"test on {typeof<'a>}" @@ -173,4 +229,5 @@ let testsCSR = |> testList "CSR" let allTests = - [ testsCSR; testsCOO ] |> testList "Merge" + [ testsCSR; testsCOO; testsCOODisjoint ] + |> testList "Merge" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/RowsLengths.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/RowsLengths.fs index f690ca3e..81363f08 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/RowsLengths.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/RowsLengths.fs @@ -26,7 +26,7 @@ let makeTest isZero testFun (array: 'a [,]) = let clMatrix = matrix.ToDevice context let (clActual: ClArray) = testFun processor HostInterop clMatrix - clMatrix.Dispose processor + clMatrix.Dispose() let actual = clActual.ToHostAndFree processor let expected = @@ -50,7 +50,7 @@ let makeTest isZero testFun (array: 'a [,]) = |> Utils.compareArrays (=) actual expected let createTest<'a when 'a: struct> (isZero: 'a -> bool) = - CSR.Matrix.NNZInRows context Utils.defaultWorkGroupSize + CSR.Matrix.NNZInRows context GraphBLAS.FSharp.Constants.Common.defaultWorkGroupSize |> makeTest isZero |> testPropertyWithConfig config $"test on %A{typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs index 46b1d204..4b4f04dc 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Expand.fs @@ -47,8 +47,8 @@ let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = let actualLength, (clActual: ClArray) = testFun processor clLeftMatrix.Columns clRightMatrix.RowPointers - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor + clLeftMatrix.Dispose() + clRightMatrix.Dispose() let actualPointers = clActual.ToHostAndFree processor @@ -62,7 +62,7 @@ let makeTest isZero testFun (leftArray: 'a [,], rightArray: 'a [,]) = |> Expect.sequenceEqual actualPointers expectedPointers let createTest<'a when 'a: struct> (isZero: 'a -> bool) = - Expand.getSegmentPointers context Utils.defaultWorkGroupSize + Expand.getSegmentPointers context Constants.Common.defaultWorkGroupSize |> makeTest isZero |> testPropertyWithConfig config $"test on {typeof<'a>}" @@ -132,9 +132,9 @@ let makeExpandTest isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) clActualRows: ClArray) = testFun processor length clSegmentPointers clLeftMatrix clRightMatrix - clLeftMatrix.Dispose processor - clRightMatrix.Dispose processor - clSegmentPointers.Free processor + clLeftMatrix.Dispose() + clRightMatrix.Dispose() + clSegmentPointers.Free() let actualLeftValues = clActualLeftValues.ToHostAndFree processor @@ -161,7 +161,7 @@ let makeExpandTest isEqual zero testFun (leftArray: 'a [,], rightArray: 'a [,]) |> Utils.compareArrays (=) actualRows expectedRows let createExpandTest isEqual (zero: 'a) testFun = - testFun context Utils.defaultWorkGroupSize + testFun context Constants.Common.defaultWorkGroupSize |> makeExpandTest isEqual zero |> testPropertyWithConfig config $"test on %A{typeof<'a>}" @@ -200,7 +200,7 @@ let makeGeneralTest zero isEqual opAdd opMul testFun (leftArray: 'a [,], rightAr | Some clMatrixActual -> let matrixActual = clMatrixActual.ToHost processor - clMatrixActual.Dispose processor + clMatrixActual.Dispose() Utils.compareCOOMatrix isEqual matrixActual expected | None -> @@ -208,7 +208,7 @@ let makeGeneralTest zero isEqual opAdd opMul testFun (leftArray: 'a [,], rightAr |> Expect.isTrue (expected.NNZ = 0) let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = - testFun opAddQ opMulQ context Utils.defaultWorkGroupSize + testFun opAddQ opMulQ context Constants.Common.defaultWorkGroupSize |> makeGeneralTest zero isEqual opAdd opMul |> testPropertyWithConfig config $"test on %A{typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/ExpandCOO.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/ExpandCOO.fs new file mode 100644 index 00000000..c9b51f45 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/ExpandCOO.fs @@ -0,0 +1,77 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.SpGeMM.ExpandCOO + +open Expecto +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.ClContextExtensions +open GraphBLAS.FSharp.Objects.MatrixExtensions +open GraphBLAS.FSharp.Test +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Backend + +let context = Context.defaultContext.ClContext + +let processor = Context.defaultContext.Queue + +let config = + { Utils.defaultConfig with + arbitrary = [ typeof ] } + +let makeGeneralTest zero isEqual opAdd opMul testFun (leftArray: 'a [,], rightArray: 'a [,]) = + + let leftMatrix = + Utils.createMatrixFromArray2D COO leftArray (isEqual zero) + + let rightMatrix = + Utils.createMatrixFromArray2D CSR rightArray (isEqual zero) + + if leftMatrix.NNZ > 0 && rightMatrix.NNZ > 0 then + let clLeftMatrix = leftMatrix.ToDevice context + let clRightMatrix = rightMatrix.ToDevice context + + let (clMatrixActual: ClMatrix.COO<_> option) = + testFun processor HostInterop clLeftMatrix clRightMatrix + + let expected = + HostPrimitives.array2DMultiplication zero opMul opAdd leftArray rightArray + |> fun array -> Matrix.COO.FromArray2D(array, isEqual zero) + + match clMatrixActual with + | Some clMatrixActual -> + + let matrixActual = clMatrixActual.ToHost processor + clMatrixActual.Dispose() + + Utils.compareCOOMatrix isEqual matrixActual expected + | None -> + "Expected should be empty" + |> Expect.isTrue (expected.NNZ = 0) + +let createGeneralTest (zero: 'a) isEqual (opAddQ, opAdd) (opMulQ, opMul) testFun = + testFun opAddQ opMulQ context Constants.Common.defaultWorkGroupSize + |> makeGeneralTest zero isEqual opAdd opMul + |> testPropertyWithConfig config $"test on %A{typeof<'a>}" + +let generalTests = + [ createGeneralTest 0 (=) ArithmeticOperations.intAdd ArithmeticOperations.intMul Operations.SpGeMM.COO.expand + + if Utils.isFloat64Available context.ClDevice then + createGeneralTest + 0.0 + Utils.floatIsEqual + ArithmeticOperations.floatAdd + ArithmeticOperations.floatMul + Operations.SpGeMM.COO.expand + + createGeneralTest + 0.0f + Utils.float32IsEqual + ArithmeticOperations.float32Add + ArithmeticOperations.float32Mul + Operations.SpGeMM.COO.expand + createGeneralTest false (=) ArithmeticOperations.boolAdd ArithmeticOperations.boolMul Operations.SpGeMM.COO.expand ] + |> testList "General" + +let tests = + testList "SpGeMM.Expand" [ generalTests ] diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Masked.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Masked.fs index 18cc44c4..188f9bcd 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Masked.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SpGeMM/Masked.fs @@ -8,11 +8,12 @@ open GraphBLAS.FSharp.Objects.MatrixExtensions open GraphBLAS.FSharp.Test open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Context +open Brahma.FSharp let logger = Log.create "SpGeMM.Masked.Tests" let context = defaultContext.ClContext -let workGroupSize = Utils.defaultWorkGroupSize +let workGroupSize = Constants.Common.defaultWorkGroupSize let makeTest context q zero isEqual plus mul mxmFun (leftMatrix: 'a [,], rightMatrix: 'a [,], mask: bool [,]) = @@ -49,10 +50,10 @@ let makeTest context q zero isEqual plus mul mxmFun (leftMatrix: 'a [,], rightMa let (result: ClMatrix<'a>) = mxmFun q m1 m2 matrixMask let actual = result.ToHost q - m1.Dispose q - m2.Dispose q - matrixMask.Dispose q - result.Dispose q + m1.Dispose() + m2.Dispose() + matrixMask.Dispose() + result.Dispose() // Check result "Matrices should be equal" @@ -66,7 +67,7 @@ let tests = arbitrary = [ typeof ] } let q = defaultContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ let add = <@ fun x y -> diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SubRows.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SubRows.fs index 9a9ae54c..38898186 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SubRows.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/SubRows.fs @@ -51,7 +51,7 @@ let makeTest isEqual zero testFun (array: 'a [,], sourceRow, count) = Utils.compareCOOMatrix isEqual actual expected let createTest isEqual (zero: 'a) = - CSR.Matrix.subRows context Utils.defaultWorkGroupSize + CSR.Matrix.subRows context GraphBLAS.FSharp.Constants.Common.defaultWorkGroupSize |> makeTest isEqual zero |> testPropertyWithConfig config $"test on {typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Transpose.fs b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Transpose.fs index e7308335..8408daab 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Transpose.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Matrix/Transpose.fs @@ -14,7 +14,7 @@ let logger = Log.create "Transpose.Tests" let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let getCorrectnessTestName case datatype = $"Correctness on %s{datatype}, %A{case.Format}, %A{case.TestContext}" @@ -89,8 +89,8 @@ let makeTestRegular context q transposeFun hostTranspose isEqual zero case (arra let m = mtx.ToDevice context let (mT: ClMatrix<'a>) = transposeFun q HostInterop m let res = mT.ToHost q - m.Dispose q - mT.Dispose q + m.Dispose() + mT.Dispose() res logger.debug ( @@ -125,7 +125,7 @@ let createTest<'a when 'a: equality and 'a: struct> case (zero: 'a) isEqual = let testFixtures case = let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ createTest case 0 (=) diff --git a/tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/Algorithms/SSSP.fs b/tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/Algorithms/SSSP.fs new file mode 100644 index 00000000..ba4f3328 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/QuickGraph/Algorithms/SSSP.fs @@ -0,0 +1,37 @@ +namespace GraphBLAS.FSharp.Tests.Backend.QuickGraph.Algorithms + +open QuikGraph +open QuikGraph.Algorithms.ShortestPath +open QuikGraph.Algorithms.Observers + +module SSSP = + let runUndirected (matrix: int [,]) (graph: AdjacencyGraph>) source = + let weight = + fun (e: Edge) -> float matrix.[e.Source, e.Target] + + let dijkstra = + DijkstraShortestPathAlgorithm>(graph, weight) + + // Attach a distance observer to give us the shortest path distances + let distObserver = + VertexDistanceRecorderObserver>(weight) + + distObserver.Attach(dijkstra) |> ignore + + // Attach a Vertex Predecessor Recorder Observer to give us the paths + let predecessorObserver = + VertexPredecessorRecorderObserver>() + + predecessorObserver.Attach(dijkstra) |> ignore + + // Run the algorithm with A set to be the source + dijkstra.Compute(source) + + let res: array = + Array.zeroCreate (Array2D.length1 matrix) + + for kvp in distObserver.Distances do + res.[kvp.Key] <- Some kvp.Value + + res.[source] <- Some 0.0 + res diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/AssignByMask.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/AssignByMask.fs index 737c5831..5af11879 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/AssignByMask.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/AssignByMask.fs @@ -16,7 +16,7 @@ let logger = Log.create "Vector.assignByMask.Tests" let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let getCorrectnessTestName case datatype = $"Correctness on %s{datatype}, vector: %A{case.Format}" @@ -50,8 +50,8 @@ let checkResult isZero isComplemented (actual: Vector<'a>) (vector: 'a []) (mask let makeTest<'a when 'a: struct and 'a: equality> (isZero: 'a -> bool) - (toDense: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) - (fillVector: MailboxProcessor -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> ClCell<'a> -> ClVector<'a>) + (toDense: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (fillVector: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> 'a -> ClVector<'a>) isComplemented case (vector: 'a [], mask: 'a [], value: 'a) @@ -72,19 +72,18 @@ let makeTest<'a when 'a: struct and 'a: equality> let clMaskVector = maskVector.ToDevice context try - let clValue = context.CreateClCell<'a> value let clActual = - fillVector q HostInterop clLeftVector clMaskVector clValue + fillVector q HostInterop clLeftVector clMaskVector value let cooClActual = toDense q HostInterop clActual let actual = cooClActual.ToHost q - clLeftVector.Dispose q - clMaskVector.Dispose q - clActual.Dispose q - cooClActual.Dispose q + clLeftVector.Dispose() + clMaskVector.Dispose() + clActual.Dispose() + cooClActual.Dispose() checkResult isZero isComplemented actual vector mask value with diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Convert.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Convert.fs index d184bc47..a53691e1 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Convert.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Convert.fs @@ -10,17 +10,19 @@ open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions +open Brahma.FSharp let logger = Log.create "Backend.Vector.Convert.Tests" let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let makeTest formatFrom - (convertFun: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (convertFun: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (convertFunUnsorted: option AllocationFlag -> ClVector<'a> -> ClVector<'a>>) isZero case (array: 'a []) @@ -36,12 +38,12 @@ let makeTest let actual = let clVector = vector.ToDevice context - let convertedVector = convertFun q HostInterop clVector + let convertedVector = convertFun q DeviceOnly clVector let res = convertedVector.ToHost q - clVector.Dispose q - convertedVector.Dispose q + clVector.Dispose() + convertedVector.Dispose() res @@ -55,6 +57,27 @@ let makeTest Expect.equal actual expected "Vectors must be the same" + match convertFunUnsorted with + | None -> () + | Some convertFunUnsorted -> + let clVector = vector.ToDevice context + let convertedVector = convertFunUnsorted q DeviceOnly clVector + + let res = convertedVector.ToHost q + + match res, expected with + | Vector.Sparse res, Vector.Sparse expected -> + let iv = Array.zip res.Indices res.Values + let resSorted = Array.sortBy (fun (i, v) -> i) iv + let indices, values = Array.unzip resSorted + Expect.equal indices expected.Indices "Indices must be the same" + Expect.equal values expected.Values "Values must be the same" + Expect.equal res.Size expected.Size "Size must be the same" + | _ -> () + + clVector.Dispose() + convertedVector.Dispose() + let testFixtures case = let getCorrectnessTestName datatype formatFrom = sprintf $"Correctness on %s{datatype}, %A{formatFrom} -> %A{case.Format}" @@ -62,24 +85,26 @@ let testFixtures case = let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) match case.Format with | Sparse -> [ let convertFun = Vector.toSparse context wgSize + let convertFunUnsorted = Vector.toSparseUnsorted context wgSize Utils.listOfUnionCases |> List.map (fun formatFrom -> - makeTest formatFrom convertFun ((=) 0) case + makeTest formatFrom convertFun (Some convertFunUnsorted) ((=) 0) case |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) let convertFun = Vector.toSparse context wgSize + let convertFunUnsorted = Vector.toSparseUnsorted context wgSize Utils.listOfUnionCases |> List.map (fun formatFrom -> - makeTest formatFrom convertFun ((=) false) case + makeTest formatFrom convertFun (Some convertFunUnsorted) ((=) false) case |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] |> List.concat | Dense -> @@ -88,7 +113,7 @@ let testFixtures case = Utils.listOfUnionCases |> List.map (fun formatFrom -> - makeTest formatFrom convertFun ((=) 0) case + makeTest formatFrom convertFun None ((=) 0) case |> testPropertyWithConfig config (getCorrectnessTestName "int" formatFrom)) let convertFun = Vector.toDense context wgSize @@ -96,7 +121,7 @@ let testFixtures case = Utils.listOfUnionCases |> List.map (fun formatFrom -> - makeTest formatFrom convertFun ((=) false) case + makeTest formatFrom convertFun None ((=) false) case |> testPropertyWithConfig config (getCorrectnessTestName "bool" formatFrom)) ] |> List.concat diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Copy.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Copy.fs index a83a1f3f..df17455f 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Copy.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Copy.fs @@ -9,12 +9,13 @@ open TestCases open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions +open Brahma.FSharp let logger = Log.create "Vector.copy.Tests" let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let checkResult (isEqual: 'a -> 'a -> bool) (actual: Vector<'a>) (expected: Vector<'a>) = Expect.equal actual.Size expected.Size "The size should be the same" @@ -36,7 +37,7 @@ let checkResult (isEqual: 'a -> 'a -> bool) (actual: Vector<'a>) (expected: Vect let correctnessGenericTest<'a when 'a: struct> isEqual zero - (copy: MailboxProcessor -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (copy: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) (case: OperationCase) (array: 'a []) = @@ -53,8 +54,8 @@ let correctnessGenericTest<'a when 'a: struct> let clVectorCopy = copy q HostInterop clVector let actual = clVectorCopy.ToHost q - clVector.Dispose q - clVectorCopy.Dispose q + clVector.Dispose() + clVectorCopy.Dispose() checkResult isEqual actual expected diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map.fs index c3cfeab7..e1445b96 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map.fs @@ -14,11 +14,12 @@ open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClContextExtensions open GraphBLAS.FSharp.Objects.ClVectorExtensions open Mono.CompilerServices.SymbolWriter +open Brahma.FSharp let logger = Log.create "Vector.Map.Tests" let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let getCorrectnessTestName case datatype = $"Correctness on %s{datatype}, %A{case}" @@ -45,8 +46,8 @@ let checkResult isEqual op zero (baseVector: 'a []) (actual: Vector<'b>) = let correctnessGenericTest zero op - (addFun: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) - (toDense: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (addFun: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (toDense: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) (isEqual: 'a -> 'a -> bool) (case: OperationCase) (array: 'a []) @@ -67,14 +68,14 @@ let correctnessGenericTest try let res = addFun q HostInterop vector - vector.Dispose q + vector.Dispose() let denseActual = toDense q HostInterop res let actual = denseActual.ToHost q - res.Dispose q - denseActual.Dispose q + res.Dispose() + denseActual.Dispose() checkResult isEqual op zero array actual with @@ -101,7 +102,7 @@ let createTestMap case (zero: 'a) (constant: 'a) binOp isEqual opQ = let testFixturesMapNot case = [ let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap case false true (fun _ -> not) (=) (fun _ _ -> ArithmeticOperations.notOption) ] @@ -111,7 +112,7 @@ let notTests = let testFixturesMapAdd case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap case 0 10 (+) (=) ArithmeticOperations.addLeftConst @@ -128,7 +129,7 @@ let addTests = let testFixturesMapMul case = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTestMap case 0 10 (*) (=) ArithmeticOperations.mulLeftConst diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs index aac15b20..d7d8515d 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Map2.fs @@ -10,12 +10,13 @@ open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions +open Brahma.FSharp let logger = Log.create "Vector.ElementWise.Tests" let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let getCorrectnessTestName<'a> (case: OperationCase<'a>) dataType = $"Correctness on '{dataType} option -> '{dataType} option -> '{dataType} option, {case.Format}" @@ -44,8 +45,8 @@ let correctnessGenericTest isEqual zero op - (addFun: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> ClVector<'a>) - (toDense: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (addFun: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a> -> ClVector<'a> option) + (toDense: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) case (leftArray: 'a [], rightArray: 'a []) = @@ -71,17 +72,20 @@ let correctnessGenericTest let res = addFun q HostInterop firstVector secondVector - firstVector.Dispose q - secondVector.Dispose q + match res with + | Some res -> + let denseActual = toDense q HostInterop res - let denseActual = toDense q HostInterop res + let actual = denseActual.ToHost q - let actual = denseActual.ToHost q + res.Dispose() + denseActual.Dispose() - res.Dispose q - denseActual.Dispose q + checkResult isEqual zero op actual leftArray rightArray + | _ -> () - checkResult isEqual zero op actual leftArray rightArray + firstVector.Dispose() + secondVector.Dispose() with | ex when ex.Message = "InvalidBufferSize" -> () | ex -> raise ex diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Merge.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Merge.fs index ae363e78..21629319 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Merge.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Merge.fs @@ -34,8 +34,8 @@ let makeTest isEqual zero testFun (firstArray: 'a []) (secondArray: 'a []) = (isLeftBitmap: ClArray)) = testFun processor clFirstVector clSecondVector - clFirstVector.Dispose processor - clSecondVector.Dispose processor + clFirstVector.Dispose() + clSecondVector.Dispose() let actualIndices = allIndices.ToHostAndFree processor let actualFirstValues = firstValues.ToHostAndFree processor @@ -76,7 +76,7 @@ let makeTest isEqual zero testFun (firstArray: 'a []) (secondArray: 'a []) = |> Utils.compareArrays (=) actualIndices expectedIndices let createTest<'a when 'a: struct> isEqual (zero: 'a) = - Vector.Sparse.Merge.run context Utils.defaultWorkGroupSize + Vector.Sparse.Merge.run context Constants.Common.defaultWorkGroupSize |> makeTest isEqual zero |> testPropertyWithConfig config $"test on %A{typeof<'a>}" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/OfList.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/OfList.fs index 9623073f..54b572a7 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/OfList.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/OfList.fs @@ -10,12 +10,13 @@ open GraphBLAS.FSharp.Backend open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions +open Brahma.FSharp let logger = Log.create "Vector.ofList.Tests" let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let checkResult (isEqual: 'a -> 'a -> bool) @@ -35,8 +36,8 @@ let checkResult let correctnessGenericTest<'a when 'a: struct> (isEqual: 'a -> 'a -> bool) - (ofList: MailboxProcessor<_> -> AllocationFlag -> VectorFormat -> int -> (int * 'a) list -> ClVector<'a>) - (toCoo: MailboxProcessor<_> -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) + (ofList: RawCommandQueue -> AllocationFlag -> VectorFormat -> int -> (int * 'a) list -> ClVector<'a>) + (toCoo: RawCommandQueue -> AllocationFlag -> ClVector<'a> -> ClVector<'a>) (case: OperationCase) (elements: (int * 'a) []) (sizeDelta: int) @@ -64,8 +65,8 @@ let correctnessGenericTest<'a when 'a: struct> let actual = clCooActual.ToHost q - clActual.Dispose q - clCooActual.Dispose q + clActual.Dispose() + clCooActual.Dispose() checkResult isEqual indices values actual actualSize @@ -88,7 +89,7 @@ let testFixtures (case: OperationCase) = [ let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf $"%A{e}") + //q.Error.Add(fun e -> failwithf $"%A{e}") creatTest case creatTest case diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Reduce.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Reduce.fs index 7775d541..f247564a 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/Reduce.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/Reduce.fs @@ -11,7 +11,7 @@ open GraphBLAS.FSharp.Objects.ClCellExtensions let logger = Log.create "Vector.reduce.Tests" -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let config = Utils.defaultConfig @@ -52,7 +52,7 @@ let testFixtures case = let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ createTest case (=) 0 (+) <@ (+) @> "add" createTest case (=) 0uy (+) <@ (+) @> "add" diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMSpV.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMSpV.fs new file mode 100644 index 00000000..20243b01 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMSpV.fs @@ -0,0 +1,166 @@ +module GraphBLAS.FSharp.Tests.Backend.Vector.SpMSpV + +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Objects.ArraysExtensions +open Expecto +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Context +open GraphBLAS.FSharp.Tests.TestCases +open Microsoft.FSharp.Collections +open Microsoft.FSharp.Core +open GraphBLAS.FSharp.Objects +open Brahma.FSharp + +let config = Utils.defaultConfig + +let wgSize = Constants.Common.defaultWorkGroupSize + +let checkResult + sumOp + mulOp + (zero: 'a) + (baseMtx: 'a [,]) + (baseVtr: 'a []) + (actualIndices: int []) + (actualValues: 'a []) + = + let rows = Array2D.length1 baseMtx + let columns = Array2D.length2 baseMtx + + let expectedV = Array.create columns zero + let mutable expectedIndices = List.Empty + let mutable expectedValues = List.Empty + + for c in 0 .. columns - 1 do + let mutable sum = zero + + for r in 0 .. rows - 1 do + sum <- sumOp sum (mulOp baseMtx.[r, c] baseVtr.[r]) + + expectedV.[c] <- sum + + for i in 0 .. columns - 1 do + if expectedV.[i] <> zero then + expectedIndices <- List.append expectedIndices [ i ] + expectedValues <- List.append expectedValues [ expectedV.[i] ] + + Expect.sequenceEqual + actualIndices + expectedIndices + $"Values should be the same. Actual is {actualIndices}, expected {expectedIndices}." + + Expect.sequenceEqual + actualValues + expectedValues + $"Values should be the same. Actual is {actualValues}, expected {expectedValues}." + +let correctnessGenericTest + (zero: 'a) + some + sumOp + mulOp + (spMV: RawCommandQueue -> ClMatrix<'a> -> ClVector<'a> -> ClVector<'a> option) + (isEqual: 'a -> 'a -> bool) + q + (testContext: TestContext) + (vector: 'a [], matrix: 'a [,], _: bool []) + = + + if (Array2D.length1 matrix > 0 && vector.Length > 0) then + //Ensure that result is not empty + vector.[0] <- some + matrix.[0, 0] <- some + + let mtx = + Utils.createMatrixFromArray2D CSR matrix (isEqual zero) + + let vtr = + Utils.createVectorFromArray Sparse vector (isEqual zero) + + if mtx.NNZ > 0 && vtr.Size > 0 then + try + let m = mtx.ToDevice testContext.ClContext + + let v = vtr.ToDevice testContext.ClContext + + match spMV testContext.Queue m v with + | Some (ClVector.Sparse res) -> + m.Dispose() + v.Dispose() + let hostResIndices = res.Indices.ToHost q + let hostResValues = res.Values.ToHost q + res.Dispose() + + checkResult sumOp mulOp zero matrix vector hostResIndices hostResValues + | _ -> failwith "Result should not be empty while standard operations are tested" + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex + +let createTest spmspv testContext (zero: 'a) some isEqual add mul addQ mulQ = + let context = testContext.ClContext + let q = testContext.Queue + + let getCorrectnessTestName datatype = + $"Correctness on %s{datatype}, %A{testContext.ClContext}" + + let spMSpV = spmspv addQ mulQ context wgSize + + testContext + |> correctnessGenericTest zero some add mul spMSpV isEqual q + |> testPropertyWithConfig config (getCorrectnessTestName $"{typeof<'a>}") + + +let testFixturesSpMSpV (testContext: TestContext) = + [ let context = testContext.ClContext + let q = testContext.Queue + //q.Error.Add(fun e -> failwithf "%A" e) + + createTest + Operations.SpMSpVBool + testContext + false + true + (=) + (||) + (&&) + ArithmeticOperations.boolSumOption + ArithmeticOperations.boolMulOption + + createTest + Operations.SpMSpV + testContext + 0 + 1 + (=) + (+) + (*) + ArithmeticOperations.intSumOption + ArithmeticOperations.intMulOption + + createTest + Operations.SpMSpV + testContext + 0.0f + 1f + (=) + (+) + (*) + ArithmeticOperations.float32SumOption + ArithmeticOperations.float32MulOption + + if Utils.isFloat64Available context.ClDevice then + createTest + Operations.SpMSpV + testContext + 0.0 + 1 + (=) + (+) + (*) + ArithmeticOperations.floatSumOption + ArithmeticOperations.floatMulOption ] + +let tests = + gpuTests "Backend.Vector.SpMSpV tests" testFixturesSpMSpV diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMV.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMV.fs index aed7ea50..d18c7f7c 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMV.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/SpMV.fs @@ -15,7 +15,7 @@ open GraphBLAS.FSharp.Backend.Quotes let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let checkResult isEqual sumOp mulOp zero (baseMtx: 'a [,]) (baseVtr: 'a []) (actual: 'a option []) = let rows = Array2D.length1 baseMtx @@ -51,7 +51,7 @@ let correctnessGenericTest zero sumOp mulOp - (spMV: MailboxProcessor<_> -> AllocationFlag -> ClMatrix.CSR<'a> -> ClArray<'a option> -> ClArray<'a option>) + (spMV: RawCommandQueue -> AllocationFlag -> ClMatrix<'a> -> ClVector<'a> -> ClVector<'a>) (isEqual: 'a -> 'a -> bool) q (testContext: TestContext) @@ -68,14 +68,15 @@ let correctnessGenericTest try let m = mtx.ToDevice testContext.ClContext - match vtr, m with - | Vector.Dense vtr, ClMatrix.CSR m -> - let v = vtr.ToDevice testContext.ClContext + let v = vtr.ToDevice testContext.ClContext - let res = spMV testContext.Queue HostInterop m v + let res = spMV testContext.Queue HostInterop m v - (ClMatrix.CSR m).Dispose q - v.Free q + m.Dispose() + v.Dispose() + + match res with + | ClVector.Dense res -> let hostRes = res.ToHostAndFree q checkResult isEqual sumOp mulOp zero matrix vector hostRes @@ -101,7 +102,7 @@ let createTest testContext (zero: 'a) isEqual add mul addQ mulQ = let testFixturesSpMV (testContext: TestContext) = [ let context = testContext.ClContext let q = testContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) createTest testContext false (=) (||) (&&) ArithmeticOperations.boolSumOption ArithmeticOperations.boolMulOption createTest testContext 0 (=) (+) (*) ArithmeticOperations.intSumOption ArithmeticOperations.intMulOption diff --git a/tests/GraphBLAS-sharp.Tests/Backend/Vector/ZeroCreate.fs b/tests/GraphBLAS-sharp.Tests/Backend/Vector/ZeroCreate.fs index 79c1e4d9..fb15d602 100644 --- a/tests/GraphBLAS-sharp.Tests/Backend/Vector/ZeroCreate.fs +++ b/tests/GraphBLAS-sharp.Tests/Backend/Vector/ZeroCreate.fs @@ -10,12 +10,13 @@ open TestCases open GraphBLAS.FSharp.Objects open GraphBLAS.FSharp.Objects.ClVectorExtensions open GraphBLAS.FSharp.Objects.ClContextExtensions +open Brahma.FSharp let logger = Log.create "Vector.zeroCreate.Tests" let config = Utils.defaultConfig -let wgSize = Utils.defaultWorkGroupSize +let wgSize = Constants.Common.defaultWorkGroupSize let checkResult size (actual: Vector<'a>) = Expect.equal actual.Size size "The size should be the same" @@ -30,7 +31,7 @@ let checkResult size (actual: Vector<'a>) = Expect.equal vector.Indices [| 0 |] "The index array must contain the 0" let correctnessGenericTest<'a when 'a: struct and 'a: equality> - (zeroCreate: MailboxProcessor<_> -> AllocationFlag -> int -> VectorFormat -> ClVector<'a>) + (zeroCreate: RawCommandQueue -> AllocationFlag -> int -> VectorFormat -> ClVector<'a>) (case: OperationCase) (vectorSize: int) = @@ -38,16 +39,20 @@ let correctnessGenericTest<'a when 'a: struct and 'a: equality> let vectorSize = abs vectorSize if vectorSize > 0 then - let q = case.TestContext.Queue + try + let q = case.TestContext.Queue - let clVector = - zeroCreate q HostInterop vectorSize case.Format + let clVector = + zeroCreate q DeviceOnly vectorSize case.Format - let hostVector = clVector.ToHost q + let hostVector = clVector.ToHost q - clVector.Dispose q + clVector.Dispose() - checkResult vectorSize hostVector + checkResult vectorSize hostVector + with + | ex when ex.Message = "Attempting to create full sparse vector" -> () + | ex -> raise ex let createTest<'a> case = let getCorrectnessTestName dataType = @@ -65,7 +70,7 @@ let testFixtures case = let context = case.TestContext.ClContext let q = case.TestContext.Queue - q.Error.Add(fun e -> failwithf "%A" e) + //q.Error.Add(fun e -> failwithf "%A" e) [ createTest case createTest case diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index fec8f61e..deaab99c 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -34,9 +34,10 @@ module Generators = } let genericSparseGenerator zero valuesGen handler = - let maxSparsity = 10 + let minSparsity = 10 + let maxSparsity = 50 let upperBound = 100 - let sparsityGen = Gen.choose (1, maxSparsity) + let sparsityGen = Gen.choose (minSparsity, maxSparsity) let genWithSparsity sparseValuesGenProvider = gen { @@ -167,6 +168,67 @@ module Generators = |> genericSparseGenerator false Arb.generate |> Arb.fromGen + type PairOfSparseMatrices() = + static let pairOfMatricesOfEqualSizeGenerator (valuesGenerator: Gen<'a>) = + gen { + let! nRowsA, nColumnsA = dimension2DGenerator + let! nRowsB, nColumnsB = dimension2DGenerator + + let! matrixA = + valuesGenerator + |> Gen.array2DOfDim (nRowsA, nColumnsA) + + let! matrixB = + valuesGenerator + |> Gen.array2DOfDim (nRowsB, nColumnsB) + + return (matrixA, matrixB) + } + + static member IntType() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0 Arb.generate + |> Arb.fromGen + + static member FloatType() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator + 0. + (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0.0f (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0y Arb.generate + |> Arb.fromGen + + static member ByteType() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0uy Arb.generate + |> Arb.fromGen + + static member Int16Type() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0s Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator 0us Arb.generate + |> Arb.fromGen + + static member BoolType() = + pairOfMatricesOfEqualSizeGenerator + |> genericSparseGenerator false Arb.generate + |> Arb.fromGen + type PairOfSparseMatricesOfEqualSize() = static let pairOfMatricesOfEqualSizeGenerator (valuesGenerator: Gen<'a>) = gen { @@ -403,6 +465,73 @@ module Generators = |> genericSparseGenerator false Arb.generate |> Arb.fromGen + type PairOfDisjointMatricesOfTheSameSize() = + static let pairOfDisjointMatricesGenerator zero (valuesGenerator: Gen<'a>) = + gen { + let! rowCount, columnCount = dimension2DGenerator + + let! pairs = + Gen.two valuesGenerator + |> Gen.array2DOfDim (rowCount, columnCount) + + let isZero = (=) zero + + let pairs = + pairs + |> Array2D.map + (fun (fst, snd) -> + match () with + | () when isZero fst && not <| isZero snd -> (zero, snd) + | () when not <| isZero fst && isZero snd -> (fst, zero) + | () -> (fst, zero)) + + return pairs + } + + static member IntType() = + (pairOfDisjointMatricesGenerator 0) + |> genericSparseGenerator 0 Arb.generate + |> Arb.fromGen + + static member FloatType() = + (pairOfDisjointMatricesGenerator 0.) + |> genericSparseGenerator + 0. + (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + |> Arb.fromGen + + static member Float32Type() = + (pairOfDisjointMatricesGenerator 0.0f) + |> genericSparseGenerator 0.0f (normalFloat32Generator <| System.Random()) + |> Arb.fromGen + + static member SByteType() = + (pairOfDisjointMatricesGenerator 0y) + |> genericSparseGenerator 0y Arb.generate + |> Arb.fromGen + + static member ByteType() = + (pairOfDisjointMatricesGenerator 0uy) + |> genericSparseGenerator 0uy Arb.generate + |> Arb.fromGen + + static member Int16Type() = + (pairOfDisjointMatricesGenerator 0s) + |> genericSparseGenerator 0s Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + (pairOfDisjointMatricesGenerator 0us) + |> genericSparseGenerator 0us Arb.generate + |> Arb.fromGen + + static member BoolType() = + (pairOfDisjointMatricesGenerator false) + |> genericSparseGenerator false Arb.generate + |> Arb.fromGen + type VectorXMatrix() = static let pairOfVectorAndMatrixOfCompatibleSizeGenerator (valuesGenerator: Gen<'a>) = gen { @@ -1278,6 +1407,71 @@ module Generators = |> Arb.fromGen module ClArray = + type ExcludeElements() = + static let arrayAndBitmap (valuesGenerator: Gen<'a>) zero = + gen { + let! length = Gen.sized <| fun size -> Gen.choose (1, size) + + let! array = Gen.arrayOfLength length valuesGenerator + + let! bitmap = + Gen.collectToArr + (fun value -> + if value = zero then + Gen.constant 0 + else + Gen.choose (0, 1)) + array + + return (array, bitmap) + } + + static member IntType() = + arrayAndBitmap <| Arb.generate <| 0 + |> Arb.fromGen + + static member FloatType() = + arrayAndBitmap + <| (Arb.Default.NormalFloat() + |> Arb.toGen + |> Gen.map float) + <| 0. + |> Arb.fromGen + + static member Float32Type() = + arrayAndBitmap + <| (normalFloat32Generator <| System.Random()) + <| 0.0f + |> Arb.fromGen + + static member SByteType() = + arrayAndBitmap <| Arb.generate <| 0y + |> Arb.fromGen + + static member ByteType() = + arrayAndBitmap <| Arb.generate <| 0uy + |> Arb.fromGen + + static member Int16Type() = + arrayAndBitmap <| Arb.generate <| 0s + |> Arb.fromGen + + static member UInt16Type() = + arrayAndBitmap <| Arb.generate <| 0us + |> Arb.fromGen + + static member Int32Type() = + arrayAndBitmap <| Arb.generate <| 0 + |> Arb.fromGen + + static member UInt32Type() = + arrayAndBitmap <| Arb.generate <| 0u + |> Arb.fromGen + + static member BoolType() = + arrayAndBitmap <| Arb.generate <| false + |> Arb.fromGen + type Set() = static let arrayAndChunkPosition (valuesGenerator: Gen<'a>) = gen { @@ -1428,7 +1622,7 @@ module Generators = |> Arb.fromGen static member ByteType() = - arrayAndChunkPosition <| Arb.generate + arrayAndChunkPosition <| Arb.generate |> Arb.fromGen static member Int16Type() = diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 5e2185f9..78952059 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -1,4 +1,4 @@ - + Exe @@ -15,8 +15,12 @@ + + + + @@ -32,6 +36,7 @@ + @@ -48,11 +53,13 @@ + + @@ -62,6 +69,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Helpers.fs b/tests/GraphBLAS-sharp.Tests/Helpers.fs index 5f8d043b..b2e819ef 100644 --- a/tests/GraphBLAS-sharp.Tests/Helpers.fs +++ b/tests/GraphBLAS-sharp.Tests/Helpers.fs @@ -11,7 +11,6 @@ open OpenCL.Net [] module Utils = - let defaultWorkGroupSize = 32 let defaultConfig = { FsCheckConfig.defaultConfig with @@ -38,6 +37,10 @@ module Utils = float (abs (x - y)) < Accuracy.medium.absolute || x.Equals y + let inline float32IsEqualLowAccuracy x y = + float (abs (x - y)) < Accuracy.low.absolute + || x.Equals y + let vectorToDenseVector = function | Vector.Dense vector -> vector @@ -337,10 +340,69 @@ module HostPrimitives = op leftElement rightElement + let MSBFSParents matrix source = + let zero = -2 + + let opAdd a b = + let result = min a b + + if result = zero then + None + else + Some result + + let opMul (a: int) (b: int) = + if a = zero || b = 0 then + None + else + Some a + + let array2DMultiplication = array2DMultiplication zero opMul opAdd + + let mutable front = + Array2D.create + <| Seq.length source + <| Array2D.length1 matrix + <| zero + + source + |> Seq.iteri (fun row vertex -> front.[row, vertex] <- vertex) + + let parents = + Array2D.create + <| Seq.length source + <| Array2D.length1 matrix + <| zero + + source + |> Seq.iteri (fun row vertex -> parents.[row, vertex] <- -1) + + let mutable stop = false + + while not stop do + let newFront = array2DMultiplication front matrix + stop <- true + + newFront + |> Array2D.iteri + (fun row col value -> + if value <> zero then + if parents.[row, col] <> zero then + newFront.[row, col] <- zero + + else + stop <- false + parents.[row, col] <- value + newFront.[row, col] <- col) + + front <- newFront + + Utils.createMatrixFromArray2D COO parents ((=) -2) + module Context = type TestContext = { ClContext: ClContext - Queue: MailboxProcessor } + Queue: RawCommandQueue } let availableContexts (platformRegex: string) = let mutable e = ErrorCode.Unknown @@ -403,7 +465,10 @@ module Context = let translator = FSQuotationToOpenCLTranslator device let context = ClContext(device, translator) - let queue = context.QueueProvider.CreateQueue() + + let queue = + RawCommandQueue(context.ClDevice.Device, context.Context, context.Translator) + { ClContext = context; Queue = queue }) @@ -413,7 +478,8 @@ module Context = let context = ClContext(device, FSQuotationToOpenCLTranslator device) - let queue = context.QueueProvider.CreateQueue() + let queue = + RawCommandQueue(context.ClDevice.Device, context.Context, context.Translator) { ClContext = context; Queue = queue } diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index ee9ffa90..e2b1045b 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -1,7 +1,7 @@ open Expecto +open GraphBLAS.FSharp.Test.Generators open GraphBLAS.FSharp.Tests open GraphBLAS.FSharp.Tests.Backend -open GraphBLAS.FSharp.Tests.Backend.Matrix let matrixTests = testList @@ -15,6 +15,7 @@ let matrixTests = Matrix.ByRows.tests Matrix.ExpandRows.tests Matrix.SubRows.tests + Matrix.Intersect.tests Matrix.Kronecker.tests Matrix.SpGeMM.Expand.tests @@ -75,6 +76,7 @@ let vectorTests = testList "Vector" [ Vector.SpMV.tests + Vector.SpMSpV.tests Vector.ZeroCreate.tests Vector.OfList.tests Vector.Copy.tests @@ -88,11 +90,22 @@ let vectorTests = |> testSequenced let algorithmsTests = - testList "Algorithms tests" [ Algorithms.BFS.tests ] + testList + "Algorithms tests" + [ Algorithms.BFS.tests + Algorithms.SSSP.tests + Algorithms.PageRank.tests + Algorithms.MSBFS.levelsTests + Algorithms.MSBFS.parentsTests ] |> testSequenced let deviceTests = - testList "Device" [ matrixTests; commonTests ] + testList + "Device" + [ matrixTests + commonTests + vectorTests + algorithmsTests ] |> testSequenced let hostTests =