diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs index b168ddcd..613f9d4e 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksBFS.fs @@ -20,12 +20,12 @@ type BFSBenchmark4CSRMatrix() = [] member this.BuildMatrix() = - matrix <- CSRMatrix(this.PathToGraph) - source <- random.Next matrix.RowCount + matrix <- MatrixCSR <| CSRMatrix.FromFile this.PathToGraph + source <- random.Next <| Matrix.rowCount matrix [] member this.LevelBFS() = - levelBFS matrix source + BFS.levelSingleSource matrix source /// Sequence of paths to files where data for benchmarking will be taken from static member GraphPaths = seq { diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs index 9dfb68b0..ea458e9e 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/BenchmarksEWiseAdd.fs @@ -97,8 +97,8 @@ type EWiseAddBenchmarks4Float32() = let mutable leftCOO = Unchecked.defaultof> let mutable rightCOO = Unchecked.defaultof> - member val FirstMatrix = Unchecked.defaultof> with get, set - member val SecondMatrix = Unchecked.defaultof> with get, set + member val FirstMatrix = Unchecked.defaultof> with get, set + member val SecondMatrix = Unchecked.defaultof> with get, set [] member this.FormInputData() = @@ -130,13 +130,13 @@ type EWiseAddBenchmarks4Float32() = Array.blit this.FirstMatrix.Values 0 leftVals 0 this.FirstMatrix.Values.Length leftCOO <- - COOMatrix( + COOMatrix.FromTuples( this.FirstMatrix.RowCount, this.FirstMatrix.ColumnCount, leftRows, leftCols, leftVals - ) :> Matrix + ) |> MatrixCOO let rightRows = Array.zeroCreate this.SecondMatrix.Rows.Length let rightCols = Array.zeroCreate this.SecondMatrix.Columns.Length @@ -146,19 +146,20 @@ type EWiseAddBenchmarks4Float32() = Array.blit this.SecondMatrix.Values 0 rightVals 0 this.SecondMatrix.Values.Length rightCOO <- - COOMatrix( + COOMatrix.FromTuples( this.SecondMatrix.RowCount, this.SecondMatrix.ColumnCount, rightRows, rightCols, rightVals - ) :> Matrix + ) |> MatrixCOO [] member this.EWiseAdditionCOOFloat32() = let (ClContext context) = this.OclContext - leftCOO.EWiseAdd rightCOO None Float32Semiring.addMult - |> context.RunSync + (leftCOO, rightCOO) ||> Matrix.eWiseAdd AddMult.float32 + |> EvalGB.withClContext context + |> EvalGB.runSync static member InputMatricesProvider = "EWiseAddBenchmarks4Float32.txt" @@ -176,8 +177,8 @@ type EWiseAddBenchmarks4Bool() = let mutable leftCOO = Unchecked.defaultof> let mutable rightCOO = Unchecked.defaultof> - member val FirstMatrix = Unchecked.defaultof> with get, set - member val SecondMatrix = Unchecked.defaultof> with get, set + member val FirstMatrix = Unchecked.defaultof> with get, set + member val SecondMatrix = Unchecked.defaultof> with get, set [] member this.FormInputData() = @@ -201,13 +202,13 @@ type EWiseAddBenchmarks4Bool() = Array.blit this.FirstMatrix.Columns 0 leftCols 0 this.FirstMatrix.Columns.Length leftCOO <- - COOMatrix( + COOMatrix.FromTuples( this.FirstMatrix.RowCount, this.FirstMatrix.ColumnCount, leftRows, leftCols, leftVals - ) :> Matrix + ) |> MatrixCOO let rightRows = Array.zeroCreate this.SecondMatrix.Rows.Length let rightCols = Array.zeroCreate this.SecondMatrix.Columns.Length @@ -216,19 +217,20 @@ type EWiseAddBenchmarks4Bool() = Array.blit this.SecondMatrix.Columns 0 rightCols 0 this.SecondMatrix.Columns.Length rightCOO <- - COOMatrix( + COOMatrix.FromTuples( this.SecondMatrix.RowCount, this.SecondMatrix.ColumnCount, rightRows, rightCols, rightVals - ) :> Matrix + ) |> MatrixCOO [] member this.EWiseAdditionCOOBool() = let (ClContext context) = this.OclContext - leftCOO.EWiseAdd rightCOO None BooleanSemiring.anyAll - |> context.RunSync + (leftCOO, rightCOO) ||> Matrix.eWiseAdd AnyAll.bool + |> EvalGB.withClContext context + |> EvalGB.runSync static member InputMatricesProvider = "EWiseAddBenchmarks4Bool.txt" diff --git a/benchmarks/GraphBLAS-sharp.Benchmarks/Utils.fs b/benchmarks/GraphBLAS-sharp.Benchmarks/Utils.fs index cc534598..171278df 100644 --- a/benchmarks/GraphBLAS-sharp.Benchmarks/Utils.fs +++ b/benchmarks/GraphBLAS-sharp.Benchmarks/Utils.fs @@ -122,7 +122,7 @@ module Utils = ColumnCount = mtx.Shape.ColumnCount } - let transposeCOO (matrix: COOFormat<'a>) = + let transposeCOO (matrix: COOMatrix<'a>) = printfn "Start transpose COO" (matrix.Columns, matrix.Rows, matrix.Values) diff --git a/src/GraphBLAS-sharp/Abstracts.fs b/src/GraphBLAS-sharp/Abstracts.fs deleted file mode 100644 index 310aabbb..00000000 --- a/src/GraphBLAS-sharp/Abstracts.fs +++ /dev/null @@ -1,120 +0,0 @@ -namespace GraphBLAS.FSharp - -open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation -open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic - -type MatrixTuples<'a when 'a : struct and 'a : equality> = { - RowIndices: int[] - ColumnIndices: int[] - Values: 'a[] -} -with - member this.ToHost() = opencl { - let! rows = if this.RowIndices.Length = 0 then opencl { return [||] } else ToHost this.RowIndices - let! cols = if this.ColumnIndices.Length = 0 then opencl { return [||] } else ToHost this.ColumnIndices - let! vals = if this.Values.Length = 0 then opencl { return [||] } else ToHost this.Values - - return { - RowIndices = rows - ColumnIndices = cols - Values = vals - } - } - -[] -type Matrix<'a when 'a : struct and 'a : equality>(nrow: int, ncol: int) = - abstract RowCount: int - abstract ColumnCount: int - default this.RowCount = nrow - default this.ColumnCount = ncol - - abstract Clear: unit -> OpenCLEvaluation - abstract Copy: unit -> OpenCLEvaluation> - abstract Resize: int -> int -> OpenCLEvaluation> - abstract GetNNZ: unit -> OpenCLEvaluation - abstract GetTuples: unit -> OpenCLEvaluation> - abstract GetMask: ?isComplemented: bool -> OpenCLEvaluation - abstract ToHost: unit -> OpenCLEvaluation> - - abstract Extract: Mask2D option -> OpenCLEvaluation> - abstract Extract: (Mask1D option * int) -> OpenCLEvaluation> - abstract Extract: (int * Mask1D option) -> OpenCLEvaluation> - abstract Extract: (int * int) -> OpenCLEvaluation> - abstract Assign: Mask2D option * Matrix<'a> -> OpenCLEvaluation - abstract Assign: (Mask1D option * int) * Vector<'a> -> OpenCLEvaluation - abstract Assign: (int * Mask1D option) * Vector<'a> -> OpenCLEvaluation - abstract Assign: (int * int) * Scalar<'a> -> OpenCLEvaluation - abstract Assign: Mask2D option * Scalar<'a> -> OpenCLEvaluation - abstract Assign: (Mask1D option * int) * Scalar<'a> -> OpenCLEvaluation - abstract Assign: (int * Mask1D option) * Scalar<'a> -> OpenCLEvaluation - - abstract Mxm: Matrix<'a> -> Mask2D option -> Semiring<'a> -> OpenCLEvaluation> - abstract Mxv: Vector<'a> -> Mask1D option -> Semiring<'a> -> OpenCLEvaluation> - abstract EWiseAdd: Matrix<'a> -> Mask2D option -> Semiring<'a> -> OpenCLEvaluation> - abstract EWiseMult: Matrix<'a> -> Mask2D option -> Semiring<'a> -> OpenCLEvaluation> - abstract Apply: Mask2D option -> UnaryOp<'a, 'b> -> OpenCLEvaluation> - abstract Prune: Mask2D option -> UnaryOp<'a, bool> -> OpenCLEvaluation> - abstract ReduceIn: Mask1D option -> Monoid<'a> -> OpenCLEvaluation> - abstract ReduceOut: Mask1D option -> Monoid<'a> -> OpenCLEvaluation> - abstract Reduce: Monoid<'a> -> OpenCLEvaluation> - abstract Transpose: unit -> OpenCLEvaluation> - abstract Kronecker: Matrix<'a> -> Mask2D option -> Semiring<'a> -> OpenCLEvaluation> - -and [] Vector<'a when 'a : struct and 'a : equality>(size: int) = - abstract Size: int - default this.Size = size - - abstract Clear: unit -> OpenCLEvaluation - abstract Copy: unit -> OpenCLEvaluation> - abstract Resize: int -> OpenCLEvaluation> - abstract GetNNZ: unit -> OpenCLEvaluation - abstract GetTuples: unit -> OpenCLEvaluation<{| Indices: int[]; Values: 'a[] |}> - abstract GetMask: ?isComplemented: bool -> OpenCLEvaluation - abstract ToHost: unit -> OpenCLEvaluation> - - abstract Extract: Mask1D option -> OpenCLEvaluation> - abstract Extract: int -> OpenCLEvaluation> - abstract Assign: Mask1D option * Vector<'a> -> OpenCLEvaluation - abstract Assign: int * Scalar<'a> -> OpenCLEvaluation - abstract Assign: Mask1D option * Scalar<'a> -> OpenCLEvaluation - - abstract Vxm: Matrix<'a> -> Mask1D option -> Semiring<'a> -> OpenCLEvaluation> - abstract EWiseAdd: Vector<'a> -> Mask1D option -> Semiring<'a> -> OpenCLEvaluation> - abstract EWiseMult: Vector<'a> -> Mask1D option -> Semiring<'a> -> OpenCLEvaluation> - abstract Apply: Mask1D option -> UnaryOp<'a, 'b> -> OpenCLEvaluation> - abstract Prune: Mask1D option -> UnaryOp<'a, bool> -> OpenCLEvaluation> - abstract Reduce: Monoid<'a> -> OpenCLEvaluation> - -and Mask1D(indices: int[], size: int, isComplemented: bool) = - member this.Indices = indices - member this.Size = size - member this.IsComplemented = isComplemented - -and Mask2D(rowIndices: int[], columnIndices: int[], rowCount: int, columnCount: int, isComplemented: bool) = - member this.RowIndices = rowIndices - member this.ColumnIndices = columnIndices - member this.RowCount = rowCount - member this.ColumnCount = columnCount - member this.IsComplemented = isComplemented - -type COOFormat<'a> = { - RowCount: int - ColumnCount: int - Rows: int[] - Columns: int[] - Values: 'a[] -} - -type CSRFormat<'a> = { - ColumnCount: int - RowPointers: int[] - ColumnIndices: int[] - Values: 'a[] -} -with - static member CreateEmpty<'a>() = { - RowPointers = Array.zeroCreate 0 - ColumnIndices = Array.zeroCreate 0 - Values = Array.zeroCreate<'a> 0 - ColumnCount = 0 - } diff --git a/src/GraphBLAS-sharp/AlgebraicStructures.fs b/src/GraphBLAS-sharp/AlgebraicStructures.fs new file mode 100644 index 00000000..2c51068c --- /dev/null +++ b/src/GraphBLAS-sharp/AlgebraicStructures.fs @@ -0,0 +1,78 @@ +namespace GraphBLAS.FSharp + +open Microsoft.FSharp.Quotations + +type UnaryOp<'a, 'b> = UnaryOp of Expr<'a -> 'b> +type BinaryOp<'a, 'b, 'c> = BinaryOp of Expr<'a -> 'b -> 'c> + +type ClosedUnaryOp<'a> = ClosedUnaryOp of Expr<'a -> 'a> +type ClosedBinaryOp<'a> = ClosedBinaryOp of Expr<'a -> 'a -> 'a> + +/// Magma with associative (magma is set with closed binary operator) +type ISemigroup<'a> = + abstract Op: ClosedBinaryOp<'a> + +/// Semigroup with identity +type IMonoid<'a> = + abstract Plus: ClosedBinaryOp<'a> + abstract Zero: 'a + +/// Monoid with associative binary operator, +/// for wich Zero is annihilator +type ISemiring<'a> = + abstract Zero: 'a + abstract Plus: ClosedBinaryOp<'a> + abstract Times: ClosedBinaryOp<'a> + +type Semigroup<'a> = + { + AssociativeOp: ClosedBinaryOp<'a> + } + + interface ISemigroup<'a> with + member this.Op = this.AssociativeOp + +type Monoid<'a> = + { + AssociativeOp: ClosedBinaryOp<'a> + Identity: 'a + } + + interface ISemigroup<'a> with + member this.Op = this.AssociativeOp + + interface IMonoid<'a> with + member this.Plus = this.AssociativeOp + member this.Zero = this.Identity + +type Semiring<'a> = + { + PlusMonoid: Monoid<'a> + TimesSemigroup: Semigroup<'a> + } + + interface IMonoid<'a> with + member this.Zero = this.PlusMonoid.Identity + member this.Plus = this.PlusMonoid.AssociativeOp + + interface ISemiring<'a> with + member this.Times = this.TimesSemigroup.AssociativeOp + member this.Zero = this.PlusMonoid.Identity + member this.Plus = this.PlusMonoid.AssociativeOp + +(* + мотивация: + хотим, чтобы ноль был нулем (даже если он явно в матрице хранится) + и все моноиды, определенные над MonoidicType 'a имели корректную семантику + (если получился 0 и мы сменили моноид, то этот элемент все еще будет нулем в другом моноиде) +*) + +[] +type MonoidicType<'a> = + | Just of 'a + | Zero + +module MonoidicType = + let wrap (isZero: 'a -> bool) x = + if isZero x then Zero + else Just x diff --git a/src/GraphBLAS-sharp/Algorithms/BFS.fs b/src/GraphBLAS-sharp/Algorithms/BFS.fs index 278b50c1..50dfc57d 100644 --- a/src/GraphBLAS-sharp/Algorithms/BFS.fs +++ b/src/GraphBLAS-sharp/Algorithms/BFS.fs @@ -1,40 +1,23 @@ namespace GraphBLAS.FSharp.Algorithms open GraphBLAS.FSharp.Predefined -open GraphBLAS.FSharp.Helpers open GraphBLAS.FSharp -open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic -open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation -[] module BFS = - let levelBFS (matrix: Matrix) (source: int) : OpenCLEvaluation> = - let vertexCount = matrix.RowCount - let levels = Vector.ofArray <| Array.zeroCreate vertexCount <| (=) 0 - let frontier = Vector.ofTuples vertexCount [source, true] + let levelSingleSource (matrix: Matrix) (source: int) = graphblas { + let vertexCount = Matrix.rowCount matrix + let! levels = Vector.zeroCreate vertexCount + let! frontier = Vector.ofList vertexCount [source, true] - opencl { - let mutable currentLevel = 1 - while currentLevel < vertexCount do - let! frontierMask = frontier.GetMask() - do! levels.Assign(frontierMask, Scalar currentLevel) - let! levelsComplemented = levels.GetMask(isComplemented = true) - let! frontier = frontier.Vxm matrix levelsComplemented BooleanSemiring.anyAll - currentLevel <- currentLevel + 1 + let mutable currentLevel = 1 + while currentLevel < vertexCount do + let! frontierMask = Vector.mask frontier + do! levels |> Vector.fillSubVector frontierMask (Scalar currentLevel) - return levels - } + let! levelsComplemented = Vector.complemented levels + let! frontier = (frontier, matrix) ||> Vector.vxmWithMask AnyAll.bool levelsComplemented - // let parentBFS (matrix: Matrix) (source: int) : Vector = - // let vertexCount = matrix.RowCount - // let parents = SparseVector(vertexCount, [source, -1]) + currentLevel <- currentLevel + 1 - // let id = DenseVector(Array.init vertexCount id, IntegerMonoid.add) - // let frontier = SparseVector(vertexCount, [source, source]) - - // for _ in 1 .. vertexCount - 1 do - // frontier.[parents.Complemented] <- (frontier @. matrix) parents.Complemented IntegerSemiring.minFirst - // parents.[frontier.Mask] <- frontier - // frontier.[frontier.Mask] <- id - - // upcast parents + return levels + } diff --git a/src/GraphBLAS-sharp/Algorithms/SSSP.fs b/src/GraphBLAS-sharp/Algorithms/SSSP.fs deleted file mode 100644 index aa3a6263..00000000 --- a/src/GraphBLAS-sharp/Algorithms/SSSP.fs +++ /dev/null @@ -1,20 +0,0 @@ -namespace GraphBLAS.FSharp.Algorithms - -open GraphBLAS.FSharp.Predefined -open GraphBLAS.FSharp -open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic -open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation - -[] -module SSSP = - let SSSP (matrix: Matrix) (source: int) : OpenCLEvaluation> = - let vertexCount = matrix.RowCount - let distance = Vector.ofTuples vertexCount [source, 0.] - - opencl { - for _ in 1 .. vertexCount - 1 do - let! step = distance.Vxm matrix None FloatSemiring.minAdd - do! distance.Assign(None, step) - - return distance - } diff --git a/src/GraphBLAS-sharp/Algorithms/ShortestPath.fs b/src/GraphBLAS-sharp/Algorithms/ShortestPath.fs new file mode 100644 index 00000000..f1042302 --- /dev/null +++ b/src/GraphBLAS-sharp/Algorithms/ShortestPath.fs @@ -0,0 +1,18 @@ +namespace GraphBLAS.FSharp.Algorithms + +open GraphBLAS.FSharp.Predefined +open GraphBLAS.FSharp +open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic +open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation + +module ShortestPath = + let singleSource (matrix: Matrix) (source: int) = graphblas { + let vertexCount = Matrix.rowCount matrix + let! distance = Vector.ofList vertexCount [source, 0.] + + for _ = 1 to vertexCount - 1 do + let! step = (distance, matrix) ||> Vector.vxm MinAdd.float + do! distance |> Vector.assignVector step + + return distance + } diff --git a/src/GraphBLAS-sharp/Algorithms/TriangleCounting.fs b/src/GraphBLAS-sharp/Algorithms/TriangleCounting.fs index 31f2b802..f115cbb1 100644 --- a/src/GraphBLAS-sharp/Algorithms/TriangleCounting.fs +++ b/src/GraphBLAS-sharp/Algorithms/TriangleCounting.fs @@ -2,21 +2,16 @@ namespace GraphBLAS.FSharp.Algorithms open GraphBLAS.FSharp.Predefined open GraphBLAS.FSharp -open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic -open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation -[] module TriangleCounting = - // скорее всего, тут не скаляр возвращать нужно, а инт - let sandiaTriangleCount (lowerTriangular: Matrix) : OpenCLEvaluation> = - let bool2int = function - | true -> 1 - | false -> 0 + let sandia (matrix: Matrix) = graphblas { + let! lowerTriangular = matrix |> Matrix.select (UnaryOp <@ fun (i, j, _) -> i <= j @>) + let! matrix' = lowerTriangular |> Matrix.apply (UnaryOp <@ function | true -> 1 | false -> 0 @>) + let! transposed = matrix' |> Matrix.transpose - opencl { - let! convertedMatrix = lowerTriangular.Apply None (UnaryOp <@ bool2int @>) - let! convertedTransposed = convertedMatrix.Transpose() - let! lowerTriangularMask = lowerTriangular.GetMask() - let! result = convertedMatrix.Mxm convertedTransposed lowerTriangularMask IntegerSemiring.addMult - return! result.Reduce IntegerMonoid.add - } + let! lowerTriangularMask = lowerTriangular |> Matrix.mask + let! result = (matrix', transposed) ||> Matrix.mxmWithMask AddMult.int lowerTriangularMask + let! (Scalar count) = result |> Matrix.reduce Add.int + + return count + } diff --git a/src/GraphBLAS-sharp/Backend/COOMatrix/EWiseAdd.fs b/src/GraphBLAS-sharp/Backend/COOMatrix/EWiseAdd.fs new file mode 100644 index 00000000..fe9467c0 --- /dev/null +++ b/src/GraphBLAS-sharp/Backend/COOMatrix/EWiseAdd.fs @@ -0,0 +1,57 @@ +namespace GraphBLAS.FSharp.Backend.COOMatrix + +open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.COOMatrix.Utilities + +module internal EWiseAdd = + let private runNonEmpty (matrixLeft: COOMatrix<'a>) (matrixRight: COOMatrix<'a>) (mask: Mask2D option) (monoid: IMonoid<'a>) = opencl { + let! allRows, allColumns, allValues = merge matrixLeft matrixRight mask + + let (ClosedBinaryOp plus) = monoid.Plus + let! rawPositions = preparePositions allRows allColumns allValues plus + let! resultRows, resultColumns, resultValues = setPositions allRows allColumns allValues rawPositions + + return { + RowCount = matrixLeft.RowCount + ColumnCount = matrixLeft.ColumnCount + Rows = resultRows + Columns = resultColumns + Values = resultValues + } + } + + let run (matrixLeft: COOMatrix<'a>) (matrixRight: COOMatrix<'a>) (mask: Mask2D option) (monoid: IMonoid<'a>) = + if matrixLeft.Values.Length = 0 then + opencl { + let! resultRows = Copy.run matrixRight.Rows + let! resultColumns = Copy.run matrixRight.Columns + let! resultValues = Copy.run matrixRight.Values + + return { + RowCount = matrixRight.RowCount + ColumnCount = matrixRight.ColumnCount + Rows = resultRows + Columns = resultColumns + Values = resultValues + } + } + + elif matrixRight.Values.Length = 0 then + opencl { + let! resultRows = Copy.run matrixLeft.Rows + let! resultColumns = Copy.run matrixLeft.Columns + let! resultValues = Copy.run matrixLeft.Values + + return { + RowCount = matrixLeft.RowCount + ColumnCount = matrixLeft.ColumnCount + Rows = resultRows + Columns = resultColumns + Values = resultValues + } + } + + else + runNonEmpty matrixLeft matrixRight mask monoid diff --git a/src/GraphBLAS-sharp/Backend/COOMatrix/GetTuples.fs b/src/GraphBLAS-sharp/Backend/COOMatrix/GetTuples.fs new file mode 100644 index 00000000..1d0a766e --- /dev/null +++ b/src/GraphBLAS-sharp/Backend/COOMatrix/GetTuples.fs @@ -0,0 +1,14 @@ +namespace GraphBLAS.FSharp.Backend.COOMatrix + +open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic +open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation +open GraphBLAS.FSharp + +module internal GetTuples = + let from (matrix: COOMatrix<'a>) = opencl { + return { + RowIndices = matrix.Rows + ColumnIndices = matrix.Columns + Values = matrix.Values + } + } diff --git a/src/GraphBLAS-sharp/Backend/Merge.fs b/src/GraphBLAS-sharp/Backend/COOMatrix/Utilities/Merge.fs similarity index 52% rename from src/GraphBLAS-sharp/Backend/Merge.fs rename to src/GraphBLAS-sharp/Backend/COOMatrix/Utilities/Merge.fs index f3bf10ef..2fbba2dd 100644 --- a/src/GraphBLAS-sharp/Backend/Merge.fs +++ b/src/GraphBLAS-sharp/Backend/COOMatrix/Utilities/Merge.fs @@ -1,4 +1,4 @@ -namespace GraphBLAS.FSharp.Backend +namespace GraphBLAS.FSharp.Backend.COOMatrix.Utilities open Brahma.OpenCL open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic @@ -6,8 +6,9 @@ open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation open GraphBLAS.FSharp open GraphBLAS.FSharp.Backend.Common +[] module internal Merge = - let runForMatrix (matrixLeft: COOFormat<'a>) (matrixRight: COOFormat<'a>) (mask: Mask2D option) : OpenCLEvaluation = opencl { + let merge (matrixLeft: COOMatrix<'a>) (matrixRight: COOMatrix<'a>) (mask: Mask2D option) : OpenCLEvaluation = opencl { let workGroupSize = Utils.workGroupSize let firstSide = matrixLeft.Values.Length let secondSide = matrixRight.Values.Length @@ -125,113 +126,3 @@ module internal Merge = return allRows, allColumns, allValues } - - let runForVector (leftIndices: int[]) (leftValues: 'a[]) (rightIndices: int[]) (rightValues: 'a[]) (mask: Mask1D option) : OpenCLEvaluation = opencl { - let workGroupSize = Utils.workGroupSize - let firstSide = leftValues.Length - let secondSide = rightValues.Length - let sumOfSides = firstSide + secondSide - - let merge = - <@ - fun (ndRange: _1D) - (firstIndicesBuffer: int[]) - (firstValuesBuffer: 'a[]) - (secondIndicesBuffer: int[]) - (secondValuesBuffer: 'a[]) - (allIndicesBuffer: int[]) - (allValuesBuffer: 'a[]) -> - - let i = ndRange.GlobalID0 - - let mutable beginIdxLocal = local () - let mutable endIdxLocal = local () - let localID = ndRange.LocalID0 - if localID < 2 then - let mutable x = localID * (workGroupSize - 1) + i - 1 - if x >= sumOfSides then x <- sumOfSides - 1 - let diagonalNumber = x - - let mutable leftEdge = diagonalNumber + 1 - secondSide - if leftEdge < 0 then leftEdge <- 0 - - let mutable rightEdge = firstSide - 1 - if rightEdge > diagonalNumber then rightEdge <- diagonalNumber - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = firstIndicesBuffer.[middleIdx] - let secondIndex = secondIndicesBuffer.[diagonalNumber - middleIdx] - if firstIndex < secondIndex then leftEdge <- middleIdx + 1 else rightEdge <- middleIdx - 1 - - // Here localID equals either 0 or 1 - if localID = 0 then beginIdxLocal <- leftEdge else endIdxLocal <- leftEdge - barrier () - - let beginIdx = beginIdxLocal - let endIdx = endIdxLocal - let firstLocalLength = endIdx - beginIdx - let mutable x = workGroupSize - firstLocalLength - if endIdx = firstSide then x <- secondSide - i + localID + beginIdx - let secondLocalLength = x - - //First indices are from 0 to firstLocalLength - 1 inclusive - //Second indices are from firstLocalLength to firstLocalLength + secondLocalLength - 1 inclusive - let localIndices = localArray workGroupSize - - if localID < firstLocalLength then - localIndices.[localID] <- firstIndicesBuffer.[beginIdx + localID] - if localID < secondLocalLength then - localIndices.[firstLocalLength + localID] <- secondIndicesBuffer.[i - beginIdx] - barrier () - - if i < sumOfSides then - let mutable leftEdge = localID + 1 - secondLocalLength - if leftEdge < 0 then leftEdge <- 0 - - let mutable rightEdge = firstLocalLength - 1 - if rightEdge > localID then rightEdge <- localID - - while leftEdge <= rightEdge do - let middleIdx = (leftEdge + rightEdge) / 2 - let firstIndex = localIndices.[middleIdx] - let secondIndex = localIndices.[firstLocalLength + localID - middleIdx] - if firstIndex < secondIndex then leftEdge <- middleIdx + 1 else rightEdge <- middleIdx - 1 - - let boundaryX = rightEdge - let boundaryY = localID - leftEdge - - // boundaryX and boundaryY can't be off the right edge of array (only off the left edge) - let isValidX = boundaryX >= 0 - let isValidY = boundaryY >= 0 - - let mutable fstIdx = 0 - if isValidX then fstIdx <- localIndices.[boundaryX] - - let mutable sndIdx = 0 - if isValidY then sndIdx <- localIndices.[firstLocalLength + boundaryY] - - if not isValidX || isValidY && fstIdx < sndIdx then - allIndicesBuffer.[i] <- sndIdx - allValuesBuffer.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] - else - allIndicesBuffer.[i] <- fstIdx - allValuesBuffer.[i] <- firstValuesBuffer.[beginIdx + boundaryX] - @> - - let allIndices = Array.zeroCreate sumOfSides - let allValues = Array.create sumOfSides Unchecked.defaultof<'a> - - do! RunCommand merge <| fun kernelPrepare -> - let ndRange = _1D(Utils.workSize sumOfSides, workGroupSize) - kernelPrepare - ndRange - leftIndices - leftValues - rightIndices - rightValues - allIndices - allValues - - return allIndices, allValues - } diff --git a/src/GraphBLAS-sharp/Backend/COOMatrix/Utilities/PreparePositions.fs b/src/GraphBLAS-sharp/Backend/COOMatrix/Utilities/PreparePositions.fs new file mode 100644 index 00000000..941985f8 --- /dev/null +++ b/src/GraphBLAS-sharp/Backend/COOMatrix/Utilities/PreparePositions.fs @@ -0,0 +1,48 @@ +namespace GraphBLAS.FSharp.Backend.COOMatrix.Utilities + +open Brahma.OpenCL +open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic +open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation +open GraphBLAS.FSharp.Backend.Common +open Microsoft.FSharp.Quotations + +[] +module internal PreparePositions = + let preparePositions (allRows: int[]) (allColumns: int[]) (allValues: 'a[]) (plus: Expr<'a -> 'a -> 'a>) = opencl { + let length = allValues.Length + + let preparePositions = + <@ + fun (ndRange: _1D) + (allRowsBuffer: int[]) + (allColumnsBuffer: int[]) + (allValuesBuffer: 'a[]) + (rawPositionsBuffer: int[]) -> + + let i = ndRange.GlobalID0 + + if i < length - 1 + && allRowsBuffer.[i] = allRowsBuffer.[i + 1] + && allColumnsBuffer.[i] = allColumnsBuffer.[i + 1] + then + rawPositionsBuffer.[i] <- 0 + allValuesBuffer.[i + 1] <- (%plus) allValuesBuffer.[i] allValuesBuffer.[i + 1] + + //Drop explicit zeroes + // let localResultBuffer = (%plus) allValuesBuffer.[i] allValuesBuffer.[i + 1] + // if localResultBuffer = zero then rawPositionsBuffer.[i + 1] <- 0 else allValuesBuffer.[i + 1] <- localResultBuffer + @> + + let rawPositions = Array.create length 1 + + do! RunCommand preparePositions <| fun kernelPrepare -> + let ndRange = _1D(Utils.workSize (length - 1), Utils.workGroupSize) + kernelPrepare + ndRange + allRows + allColumns + allValues + rawPositions + + return rawPositions + } diff --git a/src/GraphBLAS-sharp/Backend/COOMatrix/Utilities/SetPositions.fs b/src/GraphBLAS-sharp/Backend/COOMatrix/Utilities/SetPositions.fs new file mode 100644 index 00000000..a1de1517 --- /dev/null +++ b/src/GraphBLAS-sharp/Backend/COOMatrix/Utilities/SetPositions.fs @@ -0,0 +1,60 @@ +namespace GraphBLAS.FSharp.Backend.COOMatrix.Utilities + +open Brahma.OpenCL +open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic +open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation +open GraphBLAS.FSharp.Backend.Common + +[] +module internal SetPositions = + let setPositions (allRows: int[]) (allColumns: int[]) (allValues: 'a[]) (positions: int[]) = opencl { + let prefixSumArrayLength = positions.Length + + let setPositions = + <@ + fun (ndRange: _1D) + (allRowsBuffer: int[]) + (allColumnsBuffer: int[]) + (allValuesBuffer: 'a[]) + (prefixSumArrayBuffer: int[]) + (resultRowsBuffer: int[]) + (resultColumnsBuffer: int[]) + (resultValuesBuffer: 'a[]) -> + + let i = ndRange.GlobalID0 + + if i = prefixSumArrayLength - 1 + || i < prefixSumArrayLength + && prefixSumArrayBuffer.[i] <> prefixSumArrayBuffer.[i + 1] + then + let index = prefixSumArrayBuffer.[i] + + resultRowsBuffer.[index] <- allRowsBuffer.[i] + resultColumnsBuffer.[index] <- allColumnsBuffer.[i] + resultValuesBuffer.[index] <- allValuesBuffer.[i] + @> + + let resultLength = Array.zeroCreate 1 + + do! PrefixSum.runInplace positions resultLength + let! _ = ToHost resultLength + let resultLength = resultLength.[0] + + let resultRows = Array.zeroCreate resultLength + let resultColumns = Array.zeroCreate resultLength + let resultValues = Array.create resultLength Unchecked.defaultof<'a> + + do! RunCommand setPositions <| fun kernelPrepare -> + let ndRange = _1D(Utils.workSize positions.Length, Utils.workGroupSize) + kernelPrepare + ndRange + allRows + allColumns + allValues + positions + resultRows + resultColumns + resultValues + + return resultRows, resultColumns, resultValues + } diff --git a/src/GraphBLAS-sharp/Backend/COOVector/EWiseAdd.fs b/src/GraphBLAS-sharp/Backend/COOVector/EWiseAdd.fs new file mode 100644 index 00000000..10b9115b --- /dev/null +++ b/src/GraphBLAS-sharp/Backend/COOVector/EWiseAdd.fs @@ -0,0 +1,37 @@ +namespace GraphBLAS.FSharp.Backend.COOVector + +open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic +open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend.Common +open GraphBLAS.FSharp.Backend.COOVector.Utilities + +module internal EWiseAdd = + let private runNonEmpty (leftIndices: int[]) (leftValues: 'a[]) (rightIndices: int[]) (rightValues: 'a[]) (mask: Mask1D option) (semiring: ISemiring<'a>) : OpenCLEvaluation = opencl { + let! allIndices, allValues = merge leftIndices leftValues rightIndices rightValues mask + + let (ClosedBinaryOp plus) = semiring.Plus + let! rawPositions = preparePositions allIndices allValues plus + + return! setPositions allIndices allValues rawPositions + } + + let run (leftIndices: int[]) (leftValues: 'a[]) (rightIndices: int[]) (rightValues: 'a[]) (mask: Mask1D option) (semiring: ISemiring<'a>) : OpenCLEvaluation = + if leftValues.Length = 0 then + opencl { + let! resultIndices = Copy.run rightIndices + let! resultValues = Copy.run rightValues + + return resultIndices, resultValues + } + + elif rightIndices.Length = 0 then + opencl { + let! resultIndices = Copy.run leftIndices + let! resultValues = Copy.run leftValues + + return resultIndices, resultValues + } + + else + runNonEmpty leftIndices leftValues rightIndices rightValues mask semiring diff --git a/src/GraphBLAS-sharp/Backend/COOVector/Utilities/Merge.fs b/src/GraphBLAS-sharp/Backend/COOVector/Utilities/Merge.fs new file mode 100644 index 00000000..ed7b3620 --- /dev/null +++ b/src/GraphBLAS-sharp/Backend/COOVector/Utilities/Merge.fs @@ -0,0 +1,119 @@ +namespace GraphBLAS.FSharp.Backend.COOVector.Utilities + +open Brahma.OpenCL +open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic +open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend.Common + +[] +module internal Merge = + let merge (leftIndices: int[]) (leftValues: 'a[]) (rightIndices: int[]) (rightValues: 'a[]) (mask: Mask1D option) : OpenCLEvaluation = opencl { + let workGroupSize = Utils.workGroupSize + let firstSide = leftValues.Length + let secondSide = rightValues.Length + let sumOfSides = firstSide + secondSide + + let merge = + <@ + fun (ndRange: _1D) + (firstIndicesBuffer: int[]) + (firstValuesBuffer: 'a[]) + (secondIndicesBuffer: int[]) + (secondValuesBuffer: 'a[]) + (allIndicesBuffer: int[]) + (allValuesBuffer: 'a[]) -> + + let i = ndRange.GlobalID0 + + let mutable beginIdxLocal = local () + let mutable endIdxLocal = local () + let localID = ndRange.LocalID0 + if localID < 2 then + let mutable x = localID * (workGroupSize - 1) + i - 1 + if x >= sumOfSides then x <- sumOfSides - 1 + let diagonalNumber = x + + let mutable leftEdge = diagonalNumber + 1 - secondSide + if leftEdge < 0 then leftEdge <- 0 + + let mutable rightEdge = firstSide - 1 + if rightEdge > diagonalNumber then rightEdge <- diagonalNumber + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + let firstIndex = firstIndicesBuffer.[middleIdx] + let secondIndex = secondIndicesBuffer.[diagonalNumber - middleIdx] + if firstIndex < secondIndex then leftEdge <- middleIdx + 1 else rightEdge <- middleIdx - 1 + + // Here localID equals either 0 or 1 + if localID = 0 then beginIdxLocal <- leftEdge else endIdxLocal <- leftEdge + barrier () + + let beginIdx = beginIdxLocal + let endIdx = endIdxLocal + let firstLocalLength = endIdx - beginIdx + let mutable x = workGroupSize - firstLocalLength + if endIdx = firstSide then x <- secondSide - i + localID + beginIdx + let secondLocalLength = x + + //First indices are from 0 to firstLocalLength - 1 inclusive + //Second indices are from firstLocalLength to firstLocalLength + secondLocalLength - 1 inclusive + let localIndices = localArray workGroupSize + + if localID < firstLocalLength then + localIndices.[localID] <- firstIndicesBuffer.[beginIdx + localID] + if localID < secondLocalLength then + localIndices.[firstLocalLength + localID] <- secondIndicesBuffer.[i - beginIdx] + barrier () + + if i < sumOfSides then + let mutable leftEdge = localID + 1 - secondLocalLength + if leftEdge < 0 then leftEdge <- 0 + + let mutable rightEdge = firstLocalLength - 1 + if rightEdge > localID then rightEdge <- localID + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + let firstIndex = localIndices.[middleIdx] + let secondIndex = localIndices.[firstLocalLength + localID - middleIdx] + if firstIndex < secondIndex then leftEdge <- middleIdx + 1 else rightEdge <- middleIdx - 1 + + let boundaryX = rightEdge + let boundaryY = localID - leftEdge + + // boundaryX and boundaryY can't be off the right edge of array (only off the left edge) + let isValidX = boundaryX >= 0 + let isValidY = boundaryY >= 0 + + let mutable fstIdx = 0 + if isValidX then fstIdx <- localIndices.[boundaryX] + + let mutable sndIdx = 0 + if isValidY then sndIdx <- localIndices.[firstLocalLength + boundaryY] + + if not isValidX || isValidY && fstIdx < sndIdx then + allIndicesBuffer.[i] <- sndIdx + allValuesBuffer.[i] <- secondValuesBuffer.[i - localID - beginIdx + boundaryY] + else + allIndicesBuffer.[i] <- fstIdx + allValuesBuffer.[i] <- firstValuesBuffer.[beginIdx + boundaryX] + @> + + let allIndices = Array.zeroCreate sumOfSides + let allValues = Array.create sumOfSides Unchecked.defaultof<'a> + + do! RunCommand merge <| fun kernelPrepare -> + let ndRange = _1D(Utils.workSize sumOfSides, workGroupSize) + kernelPrepare + ndRange + leftIndices + leftValues + rightIndices + rightValues + allIndices + allValues + + return allIndices, allValues + } diff --git a/src/GraphBLAS-sharp/Backend/COOVector/Utilities/PreparePositions.fs b/src/GraphBLAS-sharp/Backend/COOVector/Utilities/PreparePositions.fs new file mode 100644 index 00000000..4101d02f --- /dev/null +++ b/src/GraphBLAS-sharp/Backend/COOVector/Utilities/PreparePositions.fs @@ -0,0 +1,45 @@ +namespace GraphBLAS.FSharp.Backend.COOVector.Utilities + +open Brahma.OpenCL +open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic +open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation +open GraphBLAS.FSharp.Backend.Common +open Microsoft.FSharp.Quotations + +[] +module internal PreparePositions = + let preparePositions (allIndices: int[]) (allValues: 'a[]) (plus: Expr<'a -> 'a -> 'a>) : OpenCLEvaluation = opencl { + let length = allValues.Length + + let preparePositions = + <@ + fun (ndRange: _1D) + (allIndicesBuffer: int[]) + (allValuesBuffer: 'a[]) + (rawPositionsBuffer: int[]) -> + + let i = ndRange.GlobalID0 + + if i < length - 1 && allIndicesBuffer.[i] = allIndicesBuffer.[i + 1] then + rawPositionsBuffer.[i] <- 0 + + //Do not drop explicit zeroes + allValuesBuffer.[i + 1] <- (%plus) allValuesBuffer.[i] allValuesBuffer.[i + 1] + + //Drop explicit zeroes + // let localResultBuffer = (%plus) allValuesBuffer.[i] allValuesBuffer.[i + 1] + // if localResultBuffer = zero then rawPositionsBuffer.[i + 1] <- 0 else allValuesBuffer.[i + 1] <- localResultBuffer + @> + + let rawPositions = Array.create length 1 + + do! RunCommand preparePositions <| fun kernelPrepare -> + let ndRange = _1D(Utils.workSize (length - 1), Utils.workGroupSize) + kernelPrepare + ndRange + allIndices + allValues + rawPositions + + return rawPositions + } diff --git a/src/GraphBLAS-sharp/Backend/COOVector/Utilities/SetPositions.fs b/src/GraphBLAS-sharp/Backend/COOVector/Utilities/SetPositions.fs new file mode 100644 index 00000000..8599ffae --- /dev/null +++ b/src/GraphBLAS-sharp/Backend/COOVector/Utilities/SetPositions.fs @@ -0,0 +1,51 @@ +namespace GraphBLAS.FSharp.Backend.COOVector.Utilities + +open Brahma.OpenCL +open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic +open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation +open GraphBLAS.FSharp.Backend.Common + +[] +module internal SetPositions = + let setPositions (allIndices: int[]) (allValues: 'a[]) (positions: int[]) : OpenCLEvaluation = opencl { + let prefixSumArrayLength = positions.Length + + let setPositions = + <@ + fun (ndRange: _1D) + (allIndicesBuffer: int[]) + (allValuesBuffer: 'a[]) + (prefixSumArrayBuffer: int[]) + (resultIndicesBuffer: int[]) + (resultValuesBuffer: 'a[]) -> + + let i = ndRange.GlobalID0 + + if i = prefixSumArrayLength - 1 || i < prefixSumArrayLength && prefixSumArrayBuffer.[i] <> prefixSumArrayBuffer.[i + 1] then + let index = prefixSumArrayBuffer.[i] + + resultIndicesBuffer.[index] <- allIndicesBuffer.[i] + resultValuesBuffer.[index] <- allValuesBuffer.[i] + @> + + let resultLength = Array.zeroCreate 1 + + do! PrefixSum.runInplace positions resultLength + let! _ = ToHost resultLength + let resultLength = resultLength.[0] + + let resultIndices = Array.zeroCreate resultLength + let resultValues = Array.create resultLength Unchecked.defaultof<'a> + + do! RunCommand setPositions <| fun kernelPrepare -> + let ndRange = _1D(Utils.workSize positions.Length, Utils.workGroupSize) + kernelPrepare + ndRange + allIndices + allValues + positions + resultIndices + resultValues + + return resultIndices, resultValues + } diff --git a/src/GraphBLAS-sharp/Backend/CSRMatrix/Mxv.fs b/src/GraphBLAS-sharp/Backend/CSRMatrix/Mxv.fs new file mode 100644 index 00000000..a96ab295 --- /dev/null +++ b/src/GraphBLAS-sharp/Backend/CSRMatrix/Mxv.fs @@ -0,0 +1,74 @@ +namespace GraphBLAS.FSharp.Backend.CSRMatrix + +open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic +open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Backend.Common +open Brahma.OpenCL + +module internal Mxv = + // not finished + let pcsr (matrix: CSRMatrix<'a>) (vector: BitmapVector<'a>) mask (semiring: ISemiring<'a>) = opencl { + let (ClosedBinaryOp plus) = semiring.Plus + let (ClosedBinaryOp times) = semiring.Times + + let matrixLength = matrix.Values.Length + + let kernel1 = + <@ + fun (ndRange: _1D) + (matrixColumns: int[]) + (matrixValues: 'a[]) + (vectorBitmap: bool[]) + (vectorValues: 'a[]) + (intermediateArray: 'a[]) -> + + let i = ndRange.GlobalID0 + if i < matrixLength && vectorBitmap.[i] then + let value = matrixValues.[i] + let column = matrixColumns.[i] + intermediateArray.[i] <- (%times) value vectorValues.[column] + @> + + let kernel2 = + <@ + fun (ndRange: _1D) + (intermediateArray: 'a[]) + (matrixPtr: int[]) + (outputVector: 'a[]) -> + + let gid = ndRange.GlobalID0 + let lid = ndRange.LocalID0 + + let localPtr = localArray (Utils.workGroupSize + 1) + localPtr.[lid] <- matrixPtr.[gid] + if lid = 0 then + localPtr.[Utils.workGroupSize] <- matrixPtr.[gid + Utils.workGroupSize] + barrier () + @> + + let intermediateArray = Array.zeroCreate<'a> matrixLength + do! RunCommand kernel1 <| fun kernelPrepare -> + let range = _1D(Utils.workSize matrixLength, Utils.workGroupSize) + kernelPrepare + range + matrix.ColumnIndices + matrix.Values + vector.Bitmap + vector.Values + intermediateArray + + let outputVector = Array.zeroCreate<'a> matrix.RowCount + do! RunCommand kernel2 <| fun kernelPrepare -> + let range = _1D(Utils.workSize matrixLength, Utils.workGroupSize) + kernelPrepare + range + intermediateArray + matrix.RowPointers + outputVector + + return { + Bitmap = vector.Bitmap + Values = outputVector + } + } diff --git a/src/GraphBLAS-sharp/Backend/Common/Copy.fs b/src/GraphBLAS-sharp/Backend/Common/Copy.fs index deb2ff0c..7e7ff2ce 100644 --- a/src/GraphBLAS-sharp/Backend/Common/Copy.fs +++ b/src/GraphBLAS-sharp/Backend/Common/Copy.fs @@ -2,10 +2,15 @@ namespace GraphBLAS.FSharp.Backend.Common open Brahma.OpenCL open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic -open Utils -module internal Copy = - let runNotEmpty (inputArray: 'a[]) = opencl { +module internal rec Copy = + let run (inputArray: 'a[]) = + if inputArray.Length = 0 then + opencl { return [||] } + else + runNotEmpty inputArray + + let private runNotEmpty (inputArray: 'a[]) = opencl { let inputArrayLength = inputArray.Length let copy = <@ @@ -21,9 +26,7 @@ module internal Copy = let outputArray = Array.zeroCreate inputArray.Length do! RunCommand copy <| fun kernelPrepare -> - let ndRange = _1D(workSize inputArray.Length, workGroupSize) + let ndRange = _1D(Utils.workSize inputArray.Length, Utils.workGroupSize) kernelPrepare ndRange inputArray outputArray return outputArray } - - let run (inputArray: 'a[]) = if inputArray.Length = 0 then opencl { return [||] } else runNotEmpty inputArray diff --git a/src/GraphBLAS-sharp/Backend/Common/PrefixSum.fs b/src/GraphBLAS-sharp/Backend/Common/PrefixSum.fs index 0016f525..b3902c7f 100644 --- a/src/GraphBLAS-sharp/Backend/Common/PrefixSum.fs +++ b/src/GraphBLAS-sharp/Backend/Common/PrefixSum.fs @@ -2,12 +2,32 @@ namespace GraphBLAS.FSharp.Backend.Common open Brahma.OpenCL open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic -open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation -// functions in mudule could be named run\get\if\it\t -// like mentioned here https://www.reddit.com/r/fsharp/comments/5kvsyk/modules_or_namespaces/dbt0zf7?utm_source=share&utm_medium=web2x&context=3 -module internal PrefixSum = - let scan (inputArray: int[]) (inputArrayLength: int) (vertices: int[]) (verticesLength: int) (totalSum: int[]) : OpenCLEvaluation = opencl { +module internal rec PrefixSum = + let runInplace (inputArray: int[]) (totalSum: int[]) = opencl { + let workGroupSize = Utils.workGroupSize + + let firstVertices = Array.zeroCreate <| (inputArray.Length - 1) / workGroupSize + 1 + let secondVertices = Array.zeroCreate <| (firstVertices.Length - 1) / workGroupSize + 1 + let mutable verticesArrays = firstVertices, secondVertices + let swap (a, b) = (b, a) + + let mutable verticesLength = (inputArray.Length - 1) / workGroupSize + 1 + let mutable bunchLength = workGroupSize + + do! scan inputArray inputArray.Length (fst verticesArrays) verticesLength totalSum + while verticesLength > 1 do + let fstVertices = fst verticesArrays + let sndVertices = snd verticesArrays + do! scan fstVertices verticesLength sndVertices ((verticesLength - 1) / workGroupSize + 1) totalSum + do! update inputArray inputArray.Length fstVertices bunchLength + + bunchLength <- bunchLength * workGroupSize + verticesArrays <- swap verticesArrays + verticesLength <- (verticesLength - 1) / workGroupSize + 1 + } + + let private scan (inputArray: int[]) (inputArrayLength: int) (vertices: int[]) (verticesLength: int) (totalSum: int[]) = opencl { let workGroupSize = Utils.workGroupSize let scan = @@ -62,7 +82,7 @@ module internal PrefixSum = totalSum } - let update (inputArray: int[]) (inputArrayLength: int) (vertices: int[]) (bunchLength: int) : OpenCLEvaluation = opencl { + let private update (inputArray: int[]) (inputArrayLength: int) (vertices: int[]) (bunchLength: int) = opencl { let workGroupSize = Utils.workGroupSize let update = @@ -83,151 +103,3 @@ module internal PrefixSum = inputArray vertices } - - // Changes received arrays - let run (inputArray: int[]) (totalSum: int[]) = opencl { - let workGroupSize = Utils.workGroupSize - - let firstVertices = Array.zeroCreate <| (inputArray.Length - 1) / workGroupSize + 1 - let secondVertices = Array.zeroCreate <| (firstVertices.Length - 1) / workGroupSize + 1 - let mutable verticesArrays = firstVertices, secondVertices - let swap (a, b) = (b, a) - - let mutable verticesLength = (inputArray.Length - 1) / workGroupSize + 1 - let mutable bunchLength = workGroupSize - - do! scan inputArray inputArray.Length (fst verticesArrays) verticesLength totalSum - while verticesLength > 1 do - let fstVertices = fst verticesArrays - let sndVertices = snd verticesArrays - do! scan fstVertices verticesLength sndVertices ((verticesLength - 1) / workGroupSize + 1) totalSum - do! update inputArray inputArray.Length fstVertices bunchLength - - bunchLength <- bunchLength * workGroupSize - verticesArrays <- swap verticesArrays - verticesLength <- (verticesLength - 1) / workGroupSize + 1 - } - - // let rec v1 (inputArray: int[]) = - // let outputArray = Array.zeroCreate inputArray.Length - - // if inputArray.Length = 1 then - // let fillOutputArray = - // <@ - // fun (ndRange: _1D) - // (inputArrayBuffer: int[]) - // (outputArrayBuffer: int[]) -> - - // let i = ndRange.GlobalID0 - // outputArrayBuffer.[i] <- inputArrayBuffer.[i] - // @> - - // opencl { - // let binder kernelP = - // let ndRange = _1D(outputArray.Length) - // kernelP - // ndRange - // inputArray - // outputArray - // do! RunCommand fillOutputArray binder - // return outputArray - // } - // else - // let intermediateArray = Array.zeroCreate ((inputArray.Length + 1) / 2) - // let inputArrayLength = inputArray.Length - // let intermediateArrayLength = intermediateArray.Length - - // let fillIntermediateArray = - // <@ - // fun (ndRange: _1D) - // (inputArrayBuffer: int[]) - // (intermediateArrayBuffer: int[]) -> - - // let i = ndRange.GlobalID0 - // if i < intermediateArrayLength then - // if 2 * i + 1 < inputArrayLength then - // intermediateArrayBuffer.[i] <- inputArrayBuffer.[2 * i] + inputArrayBuffer.[2 * i + 1] - // else intermediateArrayBuffer.[i] <- inputArrayBuffer.[2 * i] - // @> - - // let fillIntermediateArray = - // opencl { - // let binder kernelP = - // let ndRange = _1D(workSize intermediateArray.Length, workGroupSize) - // kernelP - // ndRange - // inputArray - // intermediateArray - // do! RunCommand fillIntermediateArray binder - // } - - // let fillOutputArray = - // <@ - // fun (ndRange: _1D) - // (auxiliaryPrefixSumArrayBuffer: int[]) - // (inputArrayBuffer: int[]) - // (outputArrayBuffer: int[]) -> - - // let i = ndRange.GlobalID0 - // if i < inputArrayLength then - // let j = (i - 1) / 2 - // if i % 2 = 0 then - // if i = 0 then outputArrayBuffer.[i] <- inputArrayBuffer.[i] - // else outputArrayBuffer.[i] <- auxiliaryPrefixSumArrayBuffer.[j] + inputArrayBuffer.[i] - // else outputArrayBuffer.[i] <- auxiliaryPrefixSumArrayBuffer.[j] - // @> - - // opencl { - // do! fillIntermediateArray - // let! auxiliaryPrefixSumArray = v1 intermediateArray - - // let binder kernelP = - // let ndRange = _1D(workSize inputArray.Length, workGroupSize) - // kernelP - // ndRange - // auxiliaryPrefixSumArray - // inputArray - // outputArray - // do! RunCommand fillOutputArray binder - - // return outputArray - // } - - // let v2 (inputArray: int[]) = - // let firstIntermediateArray = Array.copy inputArray - // let secondIntermediateArray = Array.copy inputArray - // let outputArrayLength = firstIntermediateArray.Length - - // let updateResult = - // <@ - // fun (ndRange: _1D) - // (offset: int) - // (firstIntermediateArrayBuffer: int[]) - // (secondIntermediateArrayBuffer: int[]) -> - - // let i = ndRange.GlobalID0 - // if i < outputArrayLength then - // if i < offset then firstIntermediateArrayBuffer.[i] <- secondIntermediateArrayBuffer.[i] - // else firstIntermediateArrayBuffer.[i] <- secondIntermediateArrayBuffer.[i] + secondIntermediateArrayBuffer.[i - offset] - // @> - - // let binder offset firstIntermediateArray secondIntermediateArray kernelP = - // let ndRange = _1D(workSize outputArrayLength, workGroupSize) - // kernelP - // ndRange - // offset - // firstIntermediateArray - // secondIntermediateArray - - // let swap (a, b) = (b, a) - // let mutable arrays = firstIntermediateArray, secondIntermediateArray - - // opencl { - // let mutable offset = 1 - // while offset < outputArrayLength do - // arrays <- swap arrays - // do! RunCommand updateResult <| (binder offset <|| arrays) - // offset <- offset * 2 - - // return (fst arrays) - // } diff --git a/src/GraphBLAS-sharp/Backend/Common/RemoveDuplicates.fs b/src/GraphBLAS-sharp/Backend/Common/RemoveDuplicates.fs new file mode 100644 index 00000000..c546e121 --- /dev/null +++ b/src/GraphBLAS-sharp/Backend/Common/RemoveDuplicates.fs @@ -0,0 +1,50 @@ +namespace GraphBLAS.FSharp.Backend.Common + +open Brahma.OpenCL +open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic + +module internal RemoveDuplicates = + let run (array: 'a[]) = opencl { + let inputLength = array.Length + + let getUniqueBitmap = + <@ + fun (ndRange: _1D) + (inputArray: 'a[]) + (isUniqueBitmap: int[]) -> + + let i = ndRange.GlobalID0 + if i < inputLength - 1 && inputArray.[i] = inputArray.[i + 1] then + isUniqueBitmap.[i] <- 0 + @> + + let setPositions = + <@ + fun (ndRange: _1D) + (inputArray: 'a[]) + (positions: int[]) + (ouputArray: 'a[]) -> + + let i = ndRange.GlobalID0 + if i < inputLength then + let position = positions.[i] - 1 + ouputArray.[position] <- inputArray.[i] + @> + + let bitmap = Array.create inputLength 1 + do! RunCommand getUniqueBitmap <| fun kernelPrepare -> + let range = _1D(Utils.workSize inputLength, Utils.workGroupSize) + kernelPrepare range array bitmap + + let resultLength = Array.zeroCreate 1 + do! PrefixSum.runInplace bitmap resultLength + let! _ = ToHost resultLength + let resultLength = resultLength.[0] + + let outputArray = Array.zeroCreate resultLength + do! RunCommand setPositions <| fun kernelPrepare -> + let range = _1D(Utils.workSize inputLength, Utils.workGroupSize) + kernelPrepare range array bitmap outputArray + + return outputArray + } diff --git a/src/GraphBLAS-sharp/Backend/EWiseAdd.fs b/src/GraphBLAS-sharp/Backend/EWiseAdd.fs deleted file mode 100644 index 02702ef2..00000000 --- a/src/GraphBLAS-sharp/Backend/EWiseAdd.fs +++ /dev/null @@ -1,81 +0,0 @@ -namespace GraphBLAS.FSharp.Backend - -open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic -open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation -open GraphBLAS.FSharp -open GraphBLAS.FSharp.Backend.Common - -module internal EWiseAdd = - let cooNotEmpty (matrixLeft: COOFormat<'a>) (matrixRight: COOFormat<'a>) (mask: Mask2D option) (semiring: Semiring<'a>) : OpenCLEvaluation> = opencl { - let! allRows, allColumns, allValues = Merge.runForMatrix matrixLeft matrixRight mask - - let (BinaryOp append) = semiring.PlusMonoid.Append - let! rawPositions = PreparePositions.runForMatrix allRows allColumns allValues append - - let! resultRows, resultColumns, resultValues = SetPositions.runForMatrix allRows allColumns allValues rawPositions - - return { - RowCount = matrixLeft.RowCount - ColumnCount = matrixLeft.ColumnCount - Rows = resultRows - Columns = resultColumns - Values = resultValues - } - } - - let coo (matrixLeft: COOFormat<'a>) (matrixRight: COOFormat<'a>) (mask: Mask2D option) (semiring: Semiring<'a>) : OpenCLEvaluation> = - if matrixLeft.Values.Length = 0 then - opencl { - let! resultRows = Copy.run matrixRight.Rows - let! resultColumns = Copy.run matrixRight.Columns - let! resultValues = Copy.run matrixRight.Values - - return { - RowCount = matrixRight.RowCount - ColumnCount = matrixRight.ColumnCount - Rows = resultRows - Columns = resultColumns - Values = resultValues - } - } - elif matrixRight.Values.Length = 0 then - opencl { - let! resultRows = Copy.run matrixLeft.Rows - let! resultColumns = Copy.run matrixLeft.Columns - let! resultValues = Copy.run matrixLeft.Values - - return { - RowCount = matrixLeft.RowCount - ColumnCount = matrixLeft.ColumnCount - Rows = resultRows - Columns = resultColumns - Values = resultValues - } - } - else cooNotEmpty matrixLeft matrixRight mask semiring - - let sparseNotEmpty (leftIndices: int[]) (leftValues: 'a[]) (rightIndices: int[]) (rightValues: 'a[]) (mask: Mask1D option) (semiring: Semiring<'a>) : OpenCLEvaluation = opencl { - let! allIndices, allValues = Merge.runForVector leftIndices leftValues rightIndices rightValues mask - - let (BinaryOp append) = semiring.PlusMonoid.Append - let! rawPositions = PreparePositions.runForVector allIndices allValues append - - return! SetPositions.runForVector allIndices allValues rawPositions - } - - let sparse (leftIndices: int[]) (leftValues: 'a[]) (rightIndices: int[]) (rightValues: 'a[]) (mask: Mask1D option) (semiring: Semiring<'a>) : OpenCLEvaluation = - if leftValues.Length = 0 then - opencl { - let! resultIndices = Copy.run rightIndices - let! resultValues = Copy.run rightValues - - return resultIndices, resultValues - } - elif rightIndices.Length = 0 then - opencl { - let! resultIndices = Copy.run leftIndices - let! resultValues = Copy.run leftValues - - return resultIndices, resultValues - } - else sparseNotEmpty leftIndices leftValues rightIndices rightValues mask semiring diff --git a/src/GraphBLAS-sharp/Backend/PreparePositions.fs b/src/GraphBLAS-sharp/Backend/PreparePositions.fs deleted file mode 100644 index e4ee057f..00000000 --- a/src/GraphBLAS-sharp/Backend/PreparePositions.fs +++ /dev/null @@ -1,82 +0,0 @@ -namespace GraphBLAS.FSharp.Backend - -open Brahma.OpenCL -open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic -open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation -open GraphBLAS.FSharp.Backend.Common -open Microsoft.FSharp.Quotations - -module internal PreparePositions = - let runForMatrix (allRows: int[]) (allColumns: int[]) (allValues: 'a[]) (plus: Expr<'a -> 'a -> 'a>) : OpenCLEvaluation = opencl { - let length = allValues.Length - - let preparePositions = - <@ - fun (ndRange: _1D) - (allRowsBuffer: int[]) - (allColumnsBuffer: int[]) - (allValuesBuffer: 'a[]) - (rawPositionsBuffer: int[]) -> - - let i = ndRange.GlobalID0 - - if i < length - 1 && allRowsBuffer.[i] = allRowsBuffer.[i + 1] && allColumnsBuffer.[i] = allColumnsBuffer.[i + 1] then - rawPositionsBuffer.[i] <- 0 - - //Do not drop explicit zeroes - allValuesBuffer.[i + 1] <- (%plus) allValuesBuffer.[i] allValuesBuffer.[i + 1] - - //Drop explicit zeroes - // let localResultBuffer = (%plus) allValuesBuffer.[i] allValuesBuffer.[i + 1] - // if localResultBuffer = zero then rawPositionsBuffer.[i + 1] <- 0 else allValuesBuffer.[i + 1] <- localResultBuffer - @> - - let rawPositions = Array.create length 1 - - do! RunCommand preparePositions <| fun kernelPrepare -> - let ndRange = _1D(Utils.workSize (length - 1), Utils.workGroupSize) - kernelPrepare - ndRange - allRows - allColumns - allValues - rawPositions - - return rawPositions - } - - let runForVector (allIndices: int[]) (allValues: 'a[]) (plus: Expr<'a -> 'a -> 'a>) : OpenCLEvaluation = opencl { - let length = allValues.Length - - let preparePositions = - <@ - fun (ndRange: _1D) - (allIndicesBuffer: int[]) - (allValuesBuffer: 'a[]) - (rawPositionsBuffer: int[]) -> - - let i = ndRange.GlobalID0 - - if i < length - 1 && allIndicesBuffer.[i] = allIndicesBuffer.[i + 1] then - rawPositionsBuffer.[i] <- 0 - - //Do not drop explicit zeroes - allValuesBuffer.[i + 1] <- (%plus) allValuesBuffer.[i] allValuesBuffer.[i + 1] - - //Drop explicit zeroes - // let localResultBuffer = (%plus) allValuesBuffer.[i] allValuesBuffer.[i + 1] - // if localResultBuffer = zero then rawPositionsBuffer.[i + 1] <- 0 else allValuesBuffer.[i + 1] <- localResultBuffer - @> - - let rawPositions = Array.create length 1 - - do! RunCommand preparePositions <| fun kernelPrepare -> - let ndRange = _1D(Utils.workSize (length - 1), Utils.workGroupSize) - kernelPrepare - ndRange - allIndices - allValues - rawPositions - - return rawPositions - } diff --git a/src/GraphBLAS-sharp/Backend/SetPositions.fs b/src/GraphBLAS-sharp/Backend/SetPositions.fs deleted file mode 100644 index a43132c9..00000000 --- a/src/GraphBLAS-sharp/Backend/SetPositions.fs +++ /dev/null @@ -1,99 +0,0 @@ -namespace GraphBLAS.FSharp.Backend - -open Brahma.OpenCL -open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic -open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation -open GraphBLAS.FSharp.Backend.Common - -module internal SetPositions = - let runForMatrix (allRows: int[]) (allColumns: int[]) (allValues: 'a[]) (positions: int[]) : OpenCLEvaluation = opencl { - let prefixSumArrayLength = positions.Length - - let setPositions = - <@ - fun (ndRange: _1D) - (allRowsBuffer: int[]) - (allColumnsBuffer: int[]) - (allValuesBuffer: 'a[]) - (prefixSumArrayBuffer: int[]) - (resultRowsBuffer: int[]) - (resultColumnsBuffer: int[]) - (resultValuesBuffer: 'a[]) -> - - let i = ndRange.GlobalID0 - - if i = prefixSumArrayLength - 1 || i < prefixSumArrayLength && prefixSumArrayBuffer.[i] <> prefixSumArrayBuffer.[i + 1] then - let index = prefixSumArrayBuffer.[i] - - resultRowsBuffer.[index] <- allRowsBuffer.[i] - resultColumnsBuffer.[index] <- allColumnsBuffer.[i] - resultValuesBuffer.[index] <- allValuesBuffer.[i] - @> - - let resultLength = Array.zeroCreate 1 - - do! PrefixSum.run positions resultLength - let! _ = ToHost resultLength - let resultLength = resultLength.[0] - - let resultRows = Array.zeroCreate resultLength - let resultColumns = Array.zeroCreate resultLength - let resultValues = Array.create resultLength Unchecked.defaultof<'a> - - do! RunCommand setPositions <| fun kernelPrepare -> - let ndRange = _1D(Utils.workSize positions.Length, Utils.workGroupSize) - kernelPrepare - ndRange - allRows - allColumns - allValues - positions - resultRows - resultColumns - resultValues - - return resultRows, resultColumns, resultValues - } - - let runForVector (allIndices: int[]) (allValues: 'a[]) (positions: int[]) : OpenCLEvaluation = opencl { - let prefixSumArrayLength = positions.Length - - let setPositions = - <@ - fun (ndRange: _1D) - (allIndicesBuffer: int[]) - (allValuesBuffer: 'a[]) - (prefixSumArrayBuffer: int[]) - (resultIndicesBuffer: int[]) - (resultValuesBuffer: 'a[]) -> - - let i = ndRange.GlobalID0 - - if i = prefixSumArrayLength - 1 || i < prefixSumArrayLength && prefixSumArrayBuffer.[i] <> prefixSumArrayBuffer.[i + 1] then - let index = prefixSumArrayBuffer.[i] - - resultIndicesBuffer.[index] <- allIndicesBuffer.[i] - resultValuesBuffer.[index] <- allValuesBuffer.[i] - @> - - let resultLength = Array.zeroCreate 1 - - do! PrefixSum.run positions resultLength - let! _ = ToHost resultLength - let resultLength = resultLength.[0] - - let resultIndices = Array.zeroCreate resultLength - let resultValues = Array.create resultLength Unchecked.defaultof<'a> - - do! RunCommand setPositions <| fun kernelPrepare -> - let ndRange = _1D(Utils.workSize positions.Length, Utils.workGroupSize) - kernelPrepare - ndRange - allIndices - allValues - positions - resultIndices - resultValues - - return resultIndices, resultValues - } diff --git a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj index ece08b71..e27337a1 100644 --- a/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj +++ b/src/GraphBLAS-sharp/GraphBLAS-sharp.fsproj @@ -1,3 +1,4 @@ + netstandard2.1;net461 @@ -10,37 +11,41 @@ - - - - - + + + + + + - - - - - - - + + + + + + + + + + + + + + - - - - - + Always - + \ No newline at end of file diff --git a/src/GraphBLAS-sharp/GraphblasEvaluation.fs b/src/GraphBLAS-sharp/GraphblasEvaluation.fs new file mode 100644 index 00000000..5e3e05bc --- /dev/null +++ b/src/GraphBLAS-sharp/GraphblasEvaluation.fs @@ -0,0 +1,87 @@ +namespace GraphBLAS.FSharp + +open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation +open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic +open GraphBLAS.FSharp.Helpers + +type GraphblasContext = + { + ClContext: OpenCLEvaluationContext + } + +type GraphblasEvaluation<'a> = EvalGB of (GraphblasContext -> 'a) + +module EvalGB = + let defaultEnv = { ClContext = OpenCLEvaluationContext() } + + let private runCl env (OpenCLEvaluation f) = f env + + let run env (EvalGB action) = action env + + let ask = EvalGB id + + let asks f = EvalGB f + + let bind f reader = + EvalGB <| fun env -> + let x = run env reader + run env (f x) + + let (>>=) x f = bind f x + + let return' x = + EvalGB <| fun _ -> x + + let returnFrom x = x + + let fromCl clEvaluation = + EvalGB <| fun env -> + runCl env.ClContext clEvaluation + + let withClContext clContext (EvalGB action) = + ask >>= fun env -> + return' ^ action { env with ClContext = clContext } + + let runSync (EvalGB action) = + let result = action defaultEnv + defaultEnv.ClContext.CommandQueue.Finish() |> ignore + result + +type GraphblasBuilder() = + member this.Bind(x, f) = EvalGB.bind f x + member this.Return x = EvalGB.return' x + member this.ReturnFrom x = x + + member this.Zero() = + EvalGB.return' () + + member this.Combine(m1, m2) = + EvalGB <| fun env -> + EvalGB.run env m1 + EvalGB.run env m2 + + member this.Delay rest = + EvalGB <| fun env -> + EvalGB.run env <| rest () + + member this.While(predicate, body) = + EvalGB <| fun env -> + while predicate () do + EvalGB.run env body + + member this.For(sequence, f) = + EvalGB <| fun env -> + for elem in sequence do + EvalGB.run env (f elem) + + member this.TryWith(tryBlock, handler) = + EvalGB <| fun env -> + try + EvalGB.run env tryBlock + with + | e -> + EvalGB.run env (handler e) + +[] +module GraphblasBuilder = + let graphblas = GraphblasBuilder() diff --git a/src/GraphBLAS-sharp/Helpers.fs b/src/GraphBLAS-sharp/Helpers.fs index 546343d2..7acefed3 100644 --- a/src/GraphBLAS-sharp/Helpers.fs +++ b/src/GraphBLAS-sharp/Helpers.fs @@ -1,4 +1,7 @@ namespace GraphBLAS.FSharp +[] module Helpers = - let inline (!>) (x: ^a) : ^b = (^a : (static member op_Implicit : ^a -> ^b) x) + let inline (!>) (x: ^a) : ^b = (^a: (static member op_Implicit : ^a -> ^b) x) + + let inline (^) f x = f x diff --git a/src/GraphBLAS-sharp/IO/MtxReader.fs b/src/GraphBLAS-sharp/IO/MtxReader.fs new file mode 100644 index 00000000..dbc6b443 --- /dev/null +++ b/src/GraphBLAS-sharp/IO/MtxReader.fs @@ -0,0 +1,105 @@ +namespace GraphBLAS.FSharp.IO + +// open System.IO +// open GraphBLAS.FSharp +// open System + +// type MtxShape = +// { +// Filename: string +// Object: string +// Format: string +// Field: string +// Symmetry: string +// Size: int[] +// } + +// member this.RowCount = this.Size.[0] +// member this.ColumnCount = this.Size.[1] + +// override this.ToString() = +// sprintf "%s" <| Path.GetFileNameWithoutExtension this.Filename + +// module MtxReader = +// let private readShapeWithReader (streamReader: StreamReader) (pathToFile: string) = +// let shape = streamReader.ReadLine().Split(' ') +// let object = shape.[1] +// let format = shape.[2] +// let field = shape.[3] +// let symmetry = shape.[4] + +// while streamReader.Peek() = int '%' do +// streamReader.ReadLine() |> ignore + +// let size = +// streamReader.ReadLine().Split(' ') +// |> Array.map int + +// { +// Filename = pathToFile |> Path.GetFileName +// Object = object +// Format = format +// Field = field +// Symmetry = symmetry +// Size = size +// } + +// let readShapeFromFile (pathToFile: string) = +// use streamReader = new StreamReader(pathToFile) +// readShapeWithReader streamReader pathToFile + +// let private readGenericMatrixFromFile (pathToFile: string) : Matrix<'a> = +// use streamReader = new StreamReader(pathToFile) +// let shape = readShapeWithReader streamReader pathToFile + +// let len = +// match shape.Format with +// | "array" -> shape.Size.[0] * shape.Size.[1] +// | "coordinate" -> shape.Size.[2] +// | _ -> failwith "Unsupported matrix format" + +// let data = +// [0 .. len - 1] +// |> List.map (fun _ -> streamReader.ReadLine().Split(' ')) + +// let makeCOO () = +// let pack x y = (uint64 x <<< 32) ||| (uint64 y) +// let unpack x = (int ((x &&& 0xFFFFFFFF0000000UL) >>> 32)), (int (x &&& 0xFFFFFFFUL)) + +// data +// |> Array.ofList +// |> Array.Parallel.map +// (fun line -> +// let value = Convert.ChangeType(line.[2], typeof<'a>) |> unbox<'a> +// struct(pack <| int line.[0] <| int line.[1], value) +// ) +// |> Array.sortBy (fun struct(packedIndex, _) -> packedIndex) +// |> +// fun data -> +// let rows = Array.zeroCreate data.Length +// let cols = Array.zeroCreate data.Length +// let values = Array.zeroCreate data.Length + +// Array.Parallel.iteri (fun i struct(packedIndex, value) -> +// let (rowIdx, columnIdx) = unpack packedIndex +// // in mtx indecies start at 1 +// rows.[i] <- rowIdx - 1 +// cols.[i] <- columnIdx - 1 +// values.[i] <- value +// ) data + +// { +// Rows = rows +// Columns = cols +// Values = values +// RowCount = shape.RowCount +// ColumnCount = shape.ColumnCount +// } + + +// match shape.Format with +// | "array" -> failwith "Unsupported matrix format" +// | "coordinate" -> MatrixCOO <| makeCOO () + +// let readRealMatrix (pathToFile: string) : Matrix = +// readGenericMatrixFromFile pathToFile diff --git a/src/GraphBLAS-sharp/Implementations.fs b/src/GraphBLAS-sharp/Implementations.fs deleted file mode 100644 index 8446dc9c..00000000 --- a/src/GraphBLAS-sharp/Implementations.fs +++ /dev/null @@ -1,254 +0,0 @@ -namespace GraphBLAS.FSharp - -open Brahma.OpenCL -open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic -open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation -open GraphBLAS.FSharp.Backend.Common -open GraphBLAS.FSharp.Backend - -type CSRMatrix<'a when 'a : struct and 'a : equality>(csrTuples: CSRFormat<'a>) = - inherit Matrix<'a>(csrTuples.RowPointers.Length - 1, csrTuples.ColumnCount) - - let rowCount = base.RowCount - let columnCount = base.ColumnCount - - new(rows: int[], columns: int[], values: 'a[]) = CSRMatrix(CSRFormat.CreateEmpty()) - new(pathToMatrix: string) = CSRMatrix(CSRFormat.CreateEmpty()) - - member this.Values = csrTuples.Values - member this.Columns = csrTuples.ColumnIndices - member this.RowPointers = csrTuples.RowPointers - - override this.Clear () = failwith "Not Implemented" - override this.Copy () = failwith "Not Implemented" - override this.Resize a b = failwith "Not Implemented" - override this.GetNNZ () = failwith "Not Implemented" - override this.GetTuples () = failwith "Not Implemented" - override this.GetMask(?isComplemented: bool) = - let isComplemented = defaultArg isComplemented false - failwith "Not Implemented" - override this.ToHost () = failwith "Not implemented" - - override this.Extract (mask: Mask2D option) : OpenCLEvaluation> = failwith "Not Implemented" - override this.Extract (colMask: Mask1D option * int) : OpenCLEvaluation> = failwith "Not Implemented" - override this.Extract (rowMask: int * Mask1D option) : OpenCLEvaluation> = failwith "Not Implemented" - override this.Extract (idx: int * int) : OpenCLEvaluation> = failwith "Not Implemented" - override this.Assign (mask: Mask2D option, value: Matrix<'a>) : OpenCLEvaluation = failwith "Not Implemented" - override this.Assign (colMask: Mask1D option * int, value: Vector<'a>) : OpenCLEvaluation = failwith "Not Implemented" - override this.Assign (rowMask: int * Mask1D option, value: Vector<'a>) : OpenCLEvaluation = failwith "Not Implemented" - override this.Assign (idx: int * int, value: Scalar<'a>) : OpenCLEvaluation = failwith "Not Implemented" - override this.Assign (mask: Mask2D option, value: Scalar<'a>) : OpenCLEvaluation = failwith "Not Implemented" - override this.Assign (colMask: Mask1D option * int, value: Scalar<'a>) : OpenCLEvaluation = failwith "Not Implemented" - override this.Assign (rowMask: int * Mask1D option, value: Scalar<'a>) : OpenCLEvaluation = failwith "Not Implemented" - - override this.Mxm a b c = failwith "Not Implemented" - override this.Mxv a b c = failwith "Not Implemented" - override this.EWiseAdd a b c = failwith "Not Implemented" - override this.EWiseMult a b c = failwith "Not Implemented" - override this.Apply a b = failwith "Not Implemented" - override this.Prune a b = failwith "Not Implemented" - override this.ReduceIn a b = failwith "Not Implemented" - override this.ReduceOut a b = failwith "Not Implemented" - override this.Reduce a = failwith "Not Implemented" - override this.Transpose () = failwith "Not Implemented" - override this.Kronecker a b c = failwith "Not Implemented" - -and COOMatrix<'a when 'a : struct and 'a : equality>(cooFormat: COOFormat<'a>) = - inherit Matrix<'a>(cooFormat.RowCount, cooFormat.ColumnCount) - - new(rowCount: int, columnCount: int, rows: int[], columns: int[], values: 'a[]) = - let cooFormat = { - RowCount = rowCount - ColumnCount = columnCount - Rows = rows - Columns = columns - Values = values - } - - COOMatrix(cooFormat) - - new(array: 'a[,], isZero: 'a -> bool) = - let (rows, cols, vals) = - array - |> Seq.cast<'a> - |> Seq.mapi (fun idx v -> (idx / Array2D.length2 array, idx % Array2D.length2 array, v)) - |> Seq.filter (fun (i, j, v) -> not <| isZero v) - |> Array.ofSeq - |> Array.unzip3 - - COOMatrix(Array2D.length1 array, Array2D.length2 array, rows, cols, vals) - - override this.ToString() = - [ - sprintf "COO Matrix %ix%i \n" cooFormat.RowCount cooFormat.ColumnCount - sprintf "RowIndices: %A \n" cooFormat.Rows - sprintf "ColumnIndices: %A \n" cooFormat.Columns - sprintf "Values: %A \n" cooFormat.Values - ] - |> String.concat "" - - member this.Storage = cooFormat - - member this.Rows with get() = cooFormat.Rows - member this.Columns with get() = cooFormat.Columns - member this.Values with get() = cooFormat.Values - member this.Elements with get() = (cooFormat.Rows, cooFormat.Columns, cooFormat.Values) |||> Array.zip3 - - override this.Clear () = failwith "Not Implemented" - override this.Copy () = failwith "Not Implemented" - override this.Resize a b = failwith "Not Implemented" - override this.GetNNZ () = failwith "Not Implemented" - - override this.GetTuples() = opencl { - return { - RowIndices = this.Rows - ColumnIndices = this.Columns - Values = this.Values - } - } - - override this.GetMask(?isComplemented: bool) = - let isComplemented = defaultArg isComplemented false - failwith "Not Implemented" - - override this.ToHost() = opencl { - let! _ = ToHost this.Rows - let! _ = ToHost this.Columns - let! _ = ToHost this.Values - - return upcast this - } - - override this.Extract (mask: Mask2D option) : OpenCLEvaluation> = failwith "Not Implemented" - override this.Extract (colMask: Mask1D option * int) : OpenCLEvaluation> = failwith "Not Implemented" - override this.Extract (rowMask: int * Mask1D option) : OpenCLEvaluation> = failwith "Not Implemented" - override this.Extract (idx: int * int) : OpenCLEvaluation> = failwith "Not Implemented" - override this.Assign (mask: Mask2D option, value: Matrix<'a>) : OpenCLEvaluation = failwith "Not Implemented" - override this.Assign (colMask: Mask1D option * int, value: Vector<'a>) : OpenCLEvaluation = failwith "Not Implemented" - override this.Assign (rowMask: int * Mask1D option, value: Vector<'a>) : OpenCLEvaluation = failwith "Not Implemented" - override this.Assign (idx: int * int, value: Scalar<'a>) : OpenCLEvaluation = failwith "Not Implemented" - override this.Assign (mask: Mask2D option, value: Scalar<'a>) : OpenCLEvaluation = failwith "Not Implemented" - override this.Assign (colMask: Mask1D option * int, value: Scalar<'a>) : OpenCLEvaluation = failwith "Not Implemented" - override this.Assign (rowMask: int * Mask1D option, value: Scalar<'a>) : OpenCLEvaluation = failwith "Not Implemented" - - override this.Mxm a b c = failwith "Not Implemented" - override this.Mxv a b c = failwith "Not Implemented" - - override this.EWiseAdd - (matrix: Matrix<'a>) - (mask: Mask2D option) - (semiring: Semiring<'a>) = - - if (this.RowCount, this.ColumnCount) <> (matrix.RowCount, matrix.ColumnCount) then - invalidArg - "matrix" - (sprintf "Argument has invalid dimension. Need %A, but given %A" (this.RowCount, this.ColumnCount) (matrix.RowCount, matrix.ColumnCount)) - - // let mask = - // match matrixMask with - // | Some m -> - // if (m.RowCount, m.ColumnCount) <> (this.RowCount, this.ColumnCount) then - // invalidArg - // "mask" - // (sprintf "Argument has invalid dimension. Need %A, but given %A" (this.RowCount, this.ColumnCount) (m.RowCount, m.ColumnCount)) - // m - // | _ -> Mask2D(Array.empty, this.RowCount, this.ColumnCount, true) // Empty complemented mask is equal to none - - match matrix with - | :? COOMatrix<'a> as coo -> - opencl { - let! cooFormat = EWiseAdd.coo this.Storage coo.Storage mask semiring - return upcast COOMatrix(cooFormat) - } - | _ -> failwith "Not Implemented" - - override this.EWiseMult a b c = failwith "Not Implemented" - override this.Apply a b = failwith "Not Implemented" - override this.Prune a b = failwith "Not Implemented" - override this.ReduceIn a b = failwith "Not Implemented" - override this.ReduceOut a b = failwith "Not Implemented" - override this.Reduce a = failwith "Not Implemented" - override this.Transpose () = failwith "Not Implemented" - override this.Kronecker a b c = failwith "Not Implemented" - -and SparseVector<'a when 'a : struct and 'a : equality>(size: int, indices: int[], values: 'a[]) = - inherit Vector<'a>(size) - - let mutable indices = indices - let mutable values = values - - override this.ToString() = - [ - sprintf "Sparse Vector\n" - sprintf "Size: %i\n" this.Size - sprintf "Indices: %A \n" this.Indices - sprintf "Values: %A \n" this.Values - ] - |> String.concat "" - - member this.Values with get() = values - member this.Indices with get() = indices - member this.Elements with get() = (indices, values) ||> Array.zip - - override this.Clear () = failwith "Not Implemented" - override this.Copy () = failwith "Not Implemented" - override this.Resize a = failwith "Not Implemented" - override this.GetNNZ () = failwith "Not Implemented" - - override this.GetTuples () = - opencl { - return {| Indices = this.Indices; Values = this.Values |} - } - - override this.GetMask(?isComplemented: bool) = - let isComplemented = defaultArg isComplemented false - failwith "Not Implemented" - - override this.ToHost () = - opencl { - let! _ = ToHost this.Indices - let! _ = ToHost this.Values - - return upcast this - } - - override this.Extract (mask: Mask1D option) : OpenCLEvaluation> = failwith "Not Implemented" - override this.Extract (idx: int) : OpenCLEvaluation> = failwith "Not Implemented" - override this.Assign (mask: Mask1D option, vector: Vector<'a>) : OpenCLEvaluation = failwith "Not Implemented" - override this.Assign (idx: int, Scalar (value: 'a)) : OpenCLEvaluation = failwith "Not Implemented" - override this.Assign (mask: Mask1D option, Scalar (value: 'a)) : OpenCLEvaluation = failwith "Not Implemented" - - override this.Vxm (matrix: Matrix<'a>) (mask: Mask1D option) (semiring: Semiring<'a>) : OpenCLEvaluation> = failwith "Not Implemented" - - override this.EWiseAdd - (vector: Vector<'a>) - (mask: Mask1D option) - (semiring: Semiring<'a>) = - - if vector.Size <> this.Size then - invalidArg - "vector" - (sprintf "Argument has invalid dimension. Need %i, but given %i" this.Size vector.Size) - - // let mask = - // match mask with - // | Some m -> - // if m.Size <> this.Size then - // invalidArg - // "mask" - // (sprintf "Argument has invalid dimension. Need %i, but given %i" this.Size m.Size) - // m - // | _ -> Mask1D(Array.empty, this.Size, true) // Empty complemented mask is equal to none - - match vector with - | :? SparseVector<'a> as sparse -> - opencl { - let! resultIndices, resultValues = EWiseAdd.sparse this.Indices this.Values sparse.Indices sparse.Values mask semiring - return upcast SparseVector(this.Size, resultIndices, resultValues) - } - | _ -> failwith "Not Implemented" - - override this.EWiseMult a b c = failwith "Not Implemented" - override this.Apply a b = failwith "Not Implemented" - override this.Prune a b = failwith "Not Implemented" - override this.Reduce (monoid: Monoid<'a>) = failwith "Not Implemented" diff --git a/src/GraphBLAS-sharp/Matrix.fs b/src/GraphBLAS-sharp/Matrix.fs deleted file mode 100644 index 16437ecb..00000000 --- a/src/GraphBLAS-sharp/Matrix.fs +++ /dev/null @@ -1,20 +0,0 @@ -namespace GraphBLAS.FSharp - -open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic - -[] -module Matrix = - let build (rowCount: int) (columnCount: int) (rows: int[]) (columns: int[]) (values: 'a[]) : Matrix<'a> = - failwith "Not Implemented yet" - - let ofArray2D (array: 'a[,]) (isZero: 'a -> bool) : Matrix<'a> = - failwith "Not Implemented yet" - - let fromFile (pathToMatrix: string) : Matrix<'a> = - failwith "Not Implemented yet" - - let init (rowCount: int) (columnCount: int) (initializer: int -> int -> 'a) : Matrix<'a> = - failwith "Not Implemented yet" - - let zeroCreate (rowCount: int) (columnCount: int) : Matrix<'a> = - failwith "Not Implemented yet" diff --git a/src/GraphBLAS-sharp/Methods/Matrix.fs b/src/GraphBLAS-sharp/Methods/Matrix.fs new file mode 100644 index 00000000..eed1d90c --- /dev/null +++ b/src/GraphBLAS-sharp/Methods/Matrix.fs @@ -0,0 +1,209 @@ +namespace GraphBLAS.FSharp + +open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic +open GraphBLAS.FSharp.Backend + +[] +module Matrix = + + (* + constructors + *) + + let build (rowCount: int) (columnCount: int) (rows: int[]) (columns: int[]) (values: 'a[]) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + let ofTuples (rowCount: int) (columnCount: int) (tuples: MatrixTuples<'a>) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + let ofList (rowCount: int) (columnCount: int) (elements: (int * int * 'a) list) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + let ofArray2D (array: 'a[,]) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + let init (rowCount: int) (columnCount: int) (initializer: int -> int -> 'a) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + let create (rowCount: int) (columnCount: int) (value: 'a) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + let zeroCreate (rowCount: int) (columnCount: int) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + let fromFile (pathToMatrix: string) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + (* + methods + *) + + let rowCount (matrix: Matrix<'a>) : int = failwith "Not Implemented yet" + let columnCount (matrix: Matrix<'a>) : int = failwith "Not Implemented yet" + let clear (matrix: Matrix<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" + let copy (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let resize (rowCount: int) (columnCount: int) (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let nnz (matrix: Matrix<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" + + let tuples (matrix: Matrix<'a>) : GraphblasEvaluation> = + let matrixTuples = + match matrix with + | MatrixCOO matrix -> COOMatrix.GetTuples.from matrix + | _ -> failwith "Not Implemented" + + graphblas { return! EvalGB.fromCl matrixTuples } + + let mask (matrix: Matrix<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" + let complemented (matrix: Matrix<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" + let thin (isZero: 'a -> bool) (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let switch (matrixType: MatrixType) (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let synchronize (matrix: Matrix<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" + + (* + assignment, extraction and filling + *) + + /// mat.[mask] + let extractSubMatrix (mask: Mask2D option) (matrix: Matrix<'a>) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + /// mat.[rowIdx. *] + let extractRow (rowIdx: int) (matrix: Matrix<'a>) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + /// mat.[rowIdx, mask] + let extractSubRow (rowIdx: int) (mask: Mask2D) (matrix: Matrix<'a>) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + /// mat.[*, colIdx] + let extractCol (colIdx: int) (matrix: Matrix<'a>) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + /// mat.[mask. colIdx] + let extractSubCol (colIdx: int) (mask: Mask2D) (matrix: Matrix<'a>) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + /// mat.[rowIdx, colIdx] + let extractValue (rowIdx: int) (colIdx: int) (matrix: Matrix<'a>) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + /// t <- s + let assignMatrix (source: Matrix<'a>) (target: Matrix<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// t.[mask] <- s + let assignSubMatrix (mask: Mask2D) (source: Matrix<'a>) (target: Matrix<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// t.[rowIdx, *] <- s + let assignRow (rowIdx: int) (source: Vector<'a>) (target: Matrix<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// t.[rowIdx, mask] <- s + let assignSubRow (rowIdx: int) (mask: Mask1D) (source: Vector<'a>) (target: Matrix<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// t.[*, colIdx] <- s + let assignCol (colIdx: int) (source: Vector<'a>) (target: Matrix<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// t.[mask, colIdx] <- s + let assignSubCol (colIdx: int) (mask: Mask1D) (source: Vector<'a>) (target: Matrix<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// mat.[i, j] <- value + let assignValue (rowIdx: int) (colIdx: int) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// mat.[*, *] <- value + let fillMatrix (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// mat.[mask] <- value + let fillSubMatrix (mask: Mask2D) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// mat.[rowIdx, *] <- value + let fillRow (rowIdx: int) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// mat.[rowIdx, mask] <- value + let fillSubRow (rowIdx: int) (mask: Mask1D) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// mat.[*, colIdx] <- value + let fillCol (colIdx: int) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// mat.[mask, colIdx] <- value + let fillSubCol (colIdx: int) (mask: Mask1D) (value: Scalar<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + (* + closed operations + *) + + let mxm (semiring: ISemiring<'a>) (leftMatrix: Matrix<'a>) (rightMatrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + + let mxv (semiring: ISemiring<'a>) (matrix: Matrix<'a>) (vector: Vector<'a>) : GraphblasEvaluation> = + let operationResult = + match matrix, vector with + | MatrixCSR matrix, VectorBitmap vector -> + opencl { + let! result = CSRMatrix.Mxv.pcsr matrix vector None semiring + return VectorBitmap result + } + | _ -> failwith "Not Implemented" + + graphblas { return! EvalGB.fromCl operationResult } + + let eWiseAdd (monoid: IMonoid<'a>) (leftMatrix: Matrix<'a>) (rightMatrix: Matrix<'a>) : GraphblasEvaluation> = + let operationResult = + match leftMatrix, rightMatrix with + | MatrixCOO left, MatrixCOO right -> + opencl { + let! result = COOMatrix.EWiseAdd.run left right None monoid + return MatrixCOO result + } + | _ -> failwith "Not Implemented" + + graphblas { return! EvalGB.fromCl operationResult } + + let eWiseMult (semiring: ISemiring<'a>) (leftMatrix: Matrix<'a>) (rightMatrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let apply (mapper: UnaryOp<'a, 'b>) (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let select (predicate: UnaryOp) (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let reduceRows (monoid: IMonoid<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let reduceCols (monoid: IMonoid<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let reduce (monoid: IMonoid<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let transpose (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let kronecker (semiring: ISemiring<'a>) (leftMatrix: Matrix<'a>) (rightMatrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + + let mxmWithMask (semiring: ISemiring<'a>) (mask: Mask2D) (leftMatrix: Matrix<'a>) (rightMatrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let mxvWithMask (semiring: ISemiring<'a>) (mask: Mask1D) (matrix: Matrix<'a>) (vector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let eWiseAddWithMask (monoid: IMonoid<'a>) (mask: Mask2D) (leftMatrix: Matrix<'a>) (rightMatrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let eWiseMultWithMask (semiring: ISemiring<'a>) (mask: Mask2D) (leftMatrix: Matrix<'a>) (rightMatrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let applyWithMask (mapper: UnaryOp<'a, 'b>) (mask: Mask2D) (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let selectWithMask (predicate: UnaryOp) (mask: Mask2D) (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let reduceRowsWithMask (monoid: IMonoid<'a>) (mask: Mask1D) (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let reduceColsWithMask (monoid: IMonoid<'a>) (mask: Mask1D) (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let kroneckerWithMask (semiring: ISemiring<'a>) (mask: Mask2D) (leftMatrix: Matrix<'a>) (rightMatrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + + (* + unclosed operations + *) + + // Должны принимать либо BinaryOp, либо {|BinaryOp; BinaryOp|} с соответствующей семантикой + +// ждём тайпклассов чтобы можно было вызывать synchronize для всех объектов, +// для которых он реализован, не привязывая реализацию к классу (как стратегия) +[] +module MatrixTuples = + let synchronize (matrixTuples: MatrixTuples<'a>) = + opencl { + let! rows = if matrixTuples.RowIndices.Length = 0 then opencl { return [||] } else ToHost matrixTuples.RowIndices + let! cols = if matrixTuples.ColumnIndices.Length = 0 then opencl { return [||] } else ToHost matrixTuples.ColumnIndices + let! vals = if matrixTuples.Values.Length = 0 then opencl { return [||] } else ToHost matrixTuples.Values + + return () + } + |> EvalGB.fromCl diff --git a/src/GraphBLAS-sharp/Methods/Vector.fs b/src/GraphBLAS-sharp/Methods/Vector.fs new file mode 100644 index 00000000..588c0975 --- /dev/null +++ b/src/GraphBLAS-sharp/Methods/Vector.fs @@ -0,0 +1,106 @@ +namespace GraphBLAS.FSharp + +open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic + +[] +module Vector = + + (* + constructors + *) + + let build (size: int) (indices: int[]) (values: int[]) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + let ofTuples (size: int) (tuples: VectorTuples<'a>) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + let ofList (size: int) (elements: (int * 'a) list) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + let ofArray (array: 'a[]) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + let init (size: int) (initializer: int -> 'a) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + let create (size: int) (value: 'a) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + let zeroCreate (size: int) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + (* + methods + *) + + let size (vector: Vector<'a>) : int = failwith "Not Implemented yet" + let clear (vector: Vector<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" + let copy (vector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let resize (size: int) (vector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let nnz (vector: Vector<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" + let tuples (vector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let mask (vector: Vector<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" + let complemented (vector: Vector<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" + let thin (isZero: 'a -> bool) (vector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let switch (vectorType: VectorType) (vector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let synchronize (vector: Vector<'a>) : GraphblasEvaluation = failwith "Not Implemented yet" + + (* + assignment, extraction and filling + *) + + /// vec.[mask] + let extractSubVector (mask: Mask1D) (vector: Vector<'a>) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + /// vec.[idx] + let extractValue (idx: int) (vector: Vector<'a>) : GraphblasEvaluation> = + failwith "Not Implemented yet" + + /// t <- vec + let assignVector (source: Vector<'a>) (target: Vector<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// t.[mask] <- vec + let assignSubVector (mask: Mask1D) (source: Vector<'a>) (target: Vector<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// t.[idx] <- value + let assignValue (idx: int) (value: Scalar<'a>) (target: Vector<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// vec.[*] <- value + let fillVector (value: Scalar<'a>) (vector: Vector<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + /// vec.[mask] <- value + let fillSubVector (mask: Mask1D) (value: Scalar<'a>) (vector: Vector<'a>) : GraphblasEvaluation = + failwith "Not Implemented yet" + + (* + operations + *) + + let vxm (semiring: ISemiring<'a>) (vector: Vector<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let eWiseAdd (monoid: IMonoid<'a>) (mask: Mask1D option) (leftVector: Vector<'a>) (rightVector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let eWiseMult (semiring: ISemiring<'a>) (leftVector: Vector<'a>) (rightVector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let apply (mapper: UnaryOp<'a, 'b>) (vector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let select (predicate: UnaryOp<'a, bool>) (vector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let reduce (monoid: IMonoid<'a>) (vector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + + let vxmWithMask (semiring: ISemiring<'a>) (mask: Mask1D) (vector: Vector<'a>) (matrix: Matrix<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let eWiseAddWithMask (monoid: IMonoid<'a>) (mask: Mask1D) (leftVector: Vector<'a>) (rightVector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let eWiseMultWithMask (semiring: ISemiring<'a>) (mask: Mask1D) (leftVector: Vector<'a>) (rightVector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let applyWithMask (mapper: UnaryOp<'a, 'b>) (mask: Mask1D) (vector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + let selectWithMask (predicate: UnaryOp<'a, bool>) (mask: Mask1D) (vector: Vector<'a>) : GraphblasEvaluation> = failwith "Not Implemented yet" + +[] +module VectorTuples = + let synchronize (vectorTuples: VectorTuples<'a>) = + opencl { + let! _ = ToHost vectorTuples.Indices + let! _ = ToHost vectorTuples.Values + return () + } + |> EvalGB.fromCl diff --git a/src/GraphBLAS-sharp/Monoid.fs b/src/GraphBLAS-sharp/Monoid.fs deleted file mode 100644 index 5fb09de9..00000000 --- a/src/GraphBLAS-sharp/Monoid.fs +++ /dev/null @@ -1,6 +0,0 @@ -namespace GraphBLAS.FSharp - -type Monoid<'T> = { - Zero: 'T - Append: BinaryOp<'T, 'T, 'T> -} diff --git a/src/GraphBLAS-sharp/Objects/Masks.fs b/src/GraphBLAS-sharp/Objects/Masks.fs new file mode 100644 index 00000000..57c528f2 --- /dev/null +++ b/src/GraphBLAS-sharp/Objects/Masks.fs @@ -0,0 +1,18 @@ +namespace GraphBLAS.FSharp + +type MaskType = + | Regular + | Complemented + | NoMask + +type Mask1D(indices: int[], size: int, isComplemented: bool) = + member this.Indices = indices + member this.Size = size + member this.IsComplemented = isComplemented + +type Mask2D(rowIndices: int[], columnIndices: int[], rowCount: int, columnCount: int, isComplemented: bool) = + member this.RowIndices = rowIndices + member this.ColumnIndices = columnIndices + member this.RowCount = rowCount + member this.ColumnCount = columnCount + member this.IsComplemented = isComplemented diff --git a/src/GraphBLAS-sharp/Objects/Matrix.fs b/src/GraphBLAS-sharp/Objects/Matrix.fs new file mode 100644 index 00000000..a7972ef9 --- /dev/null +++ b/src/GraphBLAS-sharp/Objects/Matrix.fs @@ -0,0 +1,67 @@ +namespace GraphBLAS.FSharp + +// matrixFormat +type MatrixType = + | CSR + | COO + +type Matrix<'a when 'a : struct> = + | MatrixCSR of CSRMatrix<'a> + | MatrixCOO of COOMatrix<'a> + +and CSRMatrix<'a> = + { + RowCount: int + ColumnCount: int + RowPointers: int[] + ColumnIndices: int[] + Values: 'a[] + } + + static member FromFile(pathToMatrix: string) : CSRMatrix<'a> = + failwith "Not Implemented yet" + +and COOMatrix<'a> = + { + RowCount: int + ColumnCount: int + Rows: int[] + Columns: int[] + Values: 'a[] + } + + override this.ToString() = + [ + sprintf "COO Matrix %ix%i \n" this.RowCount this.ColumnCount + sprintf "RowIndices: %A \n" this.Rows + sprintf "ColumnIndices: %A \n" this.Columns + sprintf "Values: %A \n" this.Values + ] + |> String.concat "" + + static member FromTuples(rowCount: int, columnCount: int, rows: int[], columns: int[], values: 'a[]) = + { + RowCount = rowCount + ColumnCount = columnCount + Rows = rows + Columns = columns + Values = values + } + + static member FromArray2D(array: 'a[,], isZero: 'a -> bool) = + let (rows, cols, vals) = + array + |> Seq.cast<'a> + |> Seq.mapi (fun idx v -> (idx / Array2D.length2 array, idx % Array2D.length2 array, v)) + |> Seq.filter (fun (_, _, v) -> not <| isZero v) + |> Array.ofSeq + |> Array.unzip3 + + COOMatrix.FromTuples(Array2D.length1 array, Array2D.length2 array, rows, cols, vals) + +type MatrixTuples<'a> = + { + RowIndices: int[] + ColumnIndices: int[] + Values: 'a[] + } diff --git a/src/GraphBLAS-sharp/Objects/Scalar.fs b/src/GraphBLAS-sharp/Objects/Scalar.fs new file mode 100644 index 00000000..80bec2cc --- /dev/null +++ b/src/GraphBLAS-sharp/Objects/Scalar.fs @@ -0,0 +1,3 @@ +namespace GraphBLAS.FSharp + +type Scalar<'a> = Scalar of 'a diff --git a/src/GraphBLAS-sharp/Objects/Vector.fs b/src/GraphBLAS-sharp/Objects/Vector.fs new file mode 100644 index 00000000..167393f7 --- /dev/null +++ b/src/GraphBLAS-sharp/Objects/Vector.fs @@ -0,0 +1,37 @@ +namespace GraphBLAS.FSharp + +type VectorType = + | COO + | Bitmap + +type Vector<'a when 'a : struct> = + | VectorCOO of COOVector<'a> + | VectorBitmap of BitmapVector<'a> + +and COOVector<'a> = + { + Size: int + Indices: int[] + Values: 'a[] + } + + override this.ToString() = + [ + sprintf "Sparse Vector\n" + sprintf "Size: %i \n" this.Size + sprintf "Indices: %A \n" this.Indices + sprintf "Values: %A \n" this.Values + ] + |> String.concat "" + +and BitmapVector<'a> = + { + Bitmap: bool[] + Values: 'a[] + } + +type VectorTuples<'a> = + { + Indices: int[] + Values: 'a[] + } diff --git a/src/GraphBLAS-sharp/Operators.fs b/src/GraphBLAS-sharp/Operators.fs deleted file mode 100644 index 57a0521d..00000000 --- a/src/GraphBLAS-sharp/Operators.fs +++ /dev/null @@ -1,12 +0,0 @@ -namespace GraphBLAS.FSharp - -open Microsoft.FSharp.Quotations - -type UnaryOp<'TIn, 'TOut> = UnaryOp of Expr<'TIn -> 'TOut> -with - static member op_Implicit (UnaryOp source) = source - - -type BinaryOp<'T1, 'T2, 'TOut> = BinaryOp of Expr<'T1 -> 'T2 -> 'TOut> -with - static member op_Implicit (BinaryOp source) = source diff --git a/src/GraphBLAS-sharp/Predefined/Boolean.fs b/src/GraphBLAS-sharp/Predefined/Boolean.fs deleted file mode 100644 index fafbb54a..00000000 --- a/src/GraphBLAS-sharp/Predefined/Boolean.fs +++ /dev/null @@ -1,15 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module BooleanMonoid = - let any: Monoid = { - Zero = false - Append = BinaryOp <@ ( || ) @> - } - -module BooleanSemiring = - let anyAll: Semiring = { - PlusMonoid = BooleanMonoid.any - Times = BinaryOp <@ ( && ) @> - } diff --git a/src/GraphBLAS-sharp/Predefined/Float.fs b/src/GraphBLAS-sharp/Predefined/Float.fs deleted file mode 100644 index e0fb907b..00000000 --- a/src/GraphBLAS-sharp/Predefined/Float.fs +++ /dev/null @@ -1,25 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module FloatMonoid = - let add: Monoid = { - Zero = 0. - Append = BinaryOp <@ ( + ) @> - } - - let min: Monoid = { - Zero = System.Double.PositiveInfinity - Append = BinaryOp <@ fun x y -> System.Math.Min(x, y) @> - } - -module FloatSemiring = - let addMult: Semiring = { - PlusMonoid = FloatMonoid.add - Times = BinaryOp <@ ( * ) @> - } - - let minAdd: Semiring = { - PlusMonoid = FloatMonoid.min - Times = BinaryOp <@ ( + ) @> - } diff --git a/src/GraphBLAS-sharp/Predefined/Float32.fs b/src/GraphBLAS-sharp/Predefined/Float32.fs deleted file mode 100644 index bc2c9e67..00000000 --- a/src/GraphBLAS-sharp/Predefined/Float32.fs +++ /dev/null @@ -1,15 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module Float32Monoid = - let add: Monoid = { - Zero = 0.f - Append = BinaryOp <@ (+) @> - } - -module Float32Semiring = - let addMult: Semiring = { - PlusMonoid = Float32Monoid.add - Times = BinaryOp <@ (*) @> - } diff --git a/src/GraphBLAS-sharp/Predefined/Integer.fs b/src/GraphBLAS-sharp/Predefined/Integer.fs deleted file mode 100644 index 5b166fe7..00000000 --- a/src/GraphBLAS-sharp/Predefined/Integer.fs +++ /dev/null @@ -1,25 +0,0 @@ -namespace GraphBLAS.FSharp.Predefined - -open GraphBLAS.FSharp - -module IntegerMonoid = - let add: Monoid = { - Zero = 0 - Append = BinaryOp <@ ( + ) @> - } - - let min: Monoid = { - Zero = System.Int32.MaxValue - Append = BinaryOp <@ fun x y -> System.Math.Min(x, y) @> - } - -module IntegerSemiring = - let addMult: Semiring = { - PlusMonoid = IntegerMonoid.add - Times = BinaryOp <@ ( * ) @> - } - - // let minFirst<'b> : Semiring = { - // PlusMonoid = IntegerMonoid.min - // Times = BinaryOp <@ fun x y -> x @> - // } diff --git a/src/GraphBLAS-sharp/Predefined/Monoids/Add.fs b/src/GraphBLAS-sharp/Predefined/Monoids/Add.fs index f0925d34..9dd3dc88 100644 --- a/src/GraphBLAS-sharp/Predefined/Monoids/Add.fs +++ b/src/GraphBLAS-sharp/Predefined/Monoids/Add.fs @@ -3,37 +3,61 @@ namespace GraphBLAS.FSharp.Predefined open GraphBLAS.FSharp module Add = - let int: Monoid = { - Zero = 0 - Append = BinaryOp <@ (+) @> - } - - let float: Monoid = { - Zero = 0. - Append = BinaryOp <@ (+) @> - } - - let float32: Monoid = { - Zero = 0.f - Append = BinaryOp <@ (+) @> - } - - let sbyte: Monoid = { - Zero = 0y - Append = BinaryOp <@ (+) @> - } - - let byte: Monoid = { - Zero = 0uy - Append = BinaryOp <@ (+) @> - } - - let int16: Monoid = { - Zero = 0s - Append = BinaryOp <@ (+) @> - } - - let uint16: Monoid = { - Zero = 0us - Append = BinaryOp <@ (+) @> - } + let int: Monoid = + { + AssociativeOp = ClosedBinaryOp <@ (+) @> + Identity = 0 + } + + let float: Monoid = + { + AssociativeOp = ClosedBinaryOp <@ (+) @> + Identity = 0. + } + + let float32: Monoid = + { + AssociativeOp = ClosedBinaryOp <@ (+) @> + Identity = 0.f + } + + let sbyte: Monoid = + { + AssociativeOp = ClosedBinaryOp <@ (+) @> + Identity = 0y + } + + let byte: Monoid = + { + AssociativeOp = ClosedBinaryOp <@ (+) @> + Identity = 0uy + } + + let int16: Monoid = + { + AssociativeOp = ClosedBinaryOp <@ (+) @> + Identity = 0s + } + + let uint16: Monoid = + { + AssociativeOp = ClosedBinaryOp <@ (+) @> + Identity = 0us + } + + let monoidicFloat: Monoid> = + { + AssociativeOp = + <@ + fun x y -> + match x, y with + | Just x, Just y -> + let result = x + y + if abs result < 1e-16 then Zero else Just result + | Just x, Zero -> Just x + | Zero, Just y -> Just y + | Zero, Zero -> Zero + @> |> ClosedBinaryOp + + Identity = Zero + } diff --git a/src/GraphBLAS-sharp/Predefined/Monoids/Any.fs b/src/GraphBLAS-sharp/Predefined/Monoids/Any.fs index 7bd7973c..cf8c7980 100644 --- a/src/GraphBLAS-sharp/Predefined/Monoids/Any.fs +++ b/src/GraphBLAS-sharp/Predefined/Monoids/Any.fs @@ -3,7 +3,8 @@ namespace GraphBLAS.FSharp.Predefined open GraphBLAS.FSharp module Any = - let bool: Monoid = { - Zero = false - Append = BinaryOp <@ (||) @> - } + let bool: Monoid = + { + AssociativeOp = ClosedBinaryOp <@ (||) @> + Identity = false + } diff --git a/src/GraphBLAS-sharp/Predefined/Monoids/Min.fs b/src/GraphBLAS-sharp/Predefined/Monoids/Min.fs index 2b6791ed..c69fd809 100644 --- a/src/GraphBLAS-sharp/Predefined/Monoids/Min.fs +++ b/src/GraphBLAS-sharp/Predefined/Monoids/Min.fs @@ -3,12 +3,14 @@ namespace GraphBLAS.FSharp.Predefined open GraphBLAS.FSharp module Min = - let int: Monoid = { - Zero = System.Int32.MaxValue - Append = BinaryOp <@ fun x y -> System.Math.Min(x, y) @> - } + let int: Monoid = + { + AssociativeOp = ClosedBinaryOp <@ fun x y -> System.Math.Min(x, y) @> + Identity = System.Int32.MaxValue + } - let float: Monoid = { - Zero = System.Double.PositiveInfinity - Append = BinaryOp <@ fun x y -> System.Math.Min(x, y) @> - } + let float: Monoid = + { + AssociativeOp = ClosedBinaryOp <@ fun x y -> System.Math.Min(x, y) @> + Identity = System.Double.PositiveInfinity + } diff --git a/src/GraphBLAS-sharp/Predefined/Semirings/AddMult.fs b/src/GraphBLAS-sharp/Predefined/Semirings/AddMult.fs index e0e98dad..f0d01598 100644 --- a/src/GraphBLAS-sharp/Predefined/Semirings/AddMult.fs +++ b/src/GraphBLAS-sharp/Predefined/Semirings/AddMult.fs @@ -3,37 +3,44 @@ namespace GraphBLAS.FSharp.Predefined open GraphBLAS.FSharp module AddMult = - let int: Semiring = { - PlusMonoid = Add.int - Times = BinaryOp <@ (*) @> - } - - let float: Semiring = { - PlusMonoid = Add.float - Times = BinaryOp <@ (*) @> - } - - let float32: Semiring = { - PlusMonoid = Add.float32 - Times = BinaryOp <@ (*) @> - } - - let sbyte: Semiring = { - PlusMonoid = Add.sbyte - Times = BinaryOp <@ (*) @> - } - - let byte: Semiring = { - PlusMonoid = Add.byte - Times = BinaryOp <@ (*) @> - } - - let int16: Semiring = { - PlusMonoid = Add.int16 - Times = BinaryOp <@ (*) @> - } - - let uint16: Semiring = { - PlusMonoid = Add.uint16 - Times = BinaryOp <@ (*) @> - } + let int: Semiring = + { + PlusMonoid = Add.int + TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } + } + + let float: Semiring = + { + PlusMonoid = Add.float + TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } + } + + let float32: Semiring = + { + PlusMonoid = Add.float32 + TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } + } + + let sbyte: Semiring = + { + PlusMonoid = Add.sbyte + TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } + } + + let byte: Semiring = + { + PlusMonoid = Add.byte + TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } + } + + let int16: Semiring = + { + PlusMonoid = Add.int16 + TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } + } + + let uint16: Semiring = + { + PlusMonoid = Add.uint16 + TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (*) @> } + } diff --git a/src/GraphBLAS-sharp/Predefined/Semirings/AnyAll.fs b/src/GraphBLAS-sharp/Predefined/Semirings/AnyAll.fs index 64571c9f..bd57b906 100644 --- a/src/GraphBLAS-sharp/Predefined/Semirings/AnyAll.fs +++ b/src/GraphBLAS-sharp/Predefined/Semirings/AnyAll.fs @@ -3,7 +3,8 @@ namespace GraphBLAS.FSharp.Predefined open GraphBLAS.FSharp module AnyAll = - let bool: Semiring = { - PlusMonoid = Any.bool - Times = BinaryOp <@ (&&) @> - } + let bool: Semiring = + { + PlusMonoid = Any.bool + TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (&&) @> } + } diff --git a/src/GraphBLAS-sharp/Predefined/Semirings/MinAdd.fs b/src/GraphBLAS-sharp/Predefined/Semirings/MinAdd.fs index 9b382835..56590f66 100644 --- a/src/GraphBLAS-sharp/Predefined/Semirings/MinAdd.fs +++ b/src/GraphBLAS-sharp/Predefined/Semirings/MinAdd.fs @@ -3,7 +3,8 @@ namespace GraphBLAS.FSharp.Predefined open GraphBLAS.FSharp module MinAdd = - let float: Semiring = { - PlusMonoid = Min.float - Times = BinaryOp <@ (+) @> - } + let float: Semiring = + { + PlusMonoid = Min.float + TimesSemigroup = { AssociativeOp = ClosedBinaryOp <@ (+) @> } + } diff --git a/src/GraphBLAS-sharp/Scalar.fs b/src/GraphBLAS-sharp/Scalar.fs deleted file mode 100644 index 1f105c7d..00000000 --- a/src/GraphBLAS-sharp/Scalar.fs +++ /dev/null @@ -1,5 +0,0 @@ -namespace GraphBLAS.FSharp - -type Scalar<'a when 'a : struct and 'a : equality> = Scalar of 'a -with - static member op_Implicit (Scalar source) = source diff --git a/src/GraphBLAS-sharp/Semiring.fs b/src/GraphBLAS-sharp/Semiring.fs deleted file mode 100644 index b05c51d4..00000000 --- a/src/GraphBLAS-sharp/Semiring.fs +++ /dev/null @@ -1,6 +0,0 @@ -namespace GraphBLAS.FSharp - -type Semiring<'T> = { - PlusMonoid: Monoid<'T> - Times: BinaryOp<'T, 'T, 'T> -} diff --git a/src/GraphBLAS-sharp/Vector.fs b/src/GraphBLAS-sharp/Vector.fs deleted file mode 100644 index 09699d0b..00000000 --- a/src/GraphBLAS-sharp/Vector.fs +++ /dev/null @@ -1,19 +0,0 @@ -namespace GraphBLAS.FSharp - -[] -module Vector = - let build (size: int) (indices: int[]) (values: int[]) : Vector<'a> = - failwith "Not Implemented yet" - - // ambiguous name (tuples = коллекция троек или 3 коллекции) - let ofTuples (size: int) (elements: (int * 'a) list) : Vector<'a> = - failwith "Not Implemented yet" - - let ofArray (array: 'a[]) (isZero: 'a -> bool) : Vector<'a> = - failwith "Not Implemented yet" - - let init (size: int) (initializer: int -> 'a) : Vector<'a> = - failwith "Not Implemented yet" - - let zeroCreate (size: int) : Vector<'a> = - failwith "Not Implemented yet" diff --git a/tests/GraphBLAS-sharp.Tests/Common.fs b/tests/GraphBLAS-sharp.Tests/Common.fs index d08884fd..667080f2 100644 --- a/tests/GraphBLAS-sharp.Tests/Common.fs +++ b/tests/GraphBLAS-sharp.Tests/Common.fs @@ -5,24 +5,14 @@ open System open GraphBLAS.FSharp open Microsoft.FSharp.Reflection open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation - -type MatrixBackendFormat = - | CSR - | COO - -type VectorBackendFormat = - | Sparse - -type MaskType = - | Regular - | Complemented - | NoMask - -module BackendState = - let mutable oclContext = OpenCLEvaluationContext() - let mutable matrixBackendFormat = CSR +open OpenCL.Net +open Expecto.Logging +open Expecto.Logging.Message +open System.Text.RegularExpressions module Generators = + let logger = Log.create "Generators" + let dimension2DGenerator = Gen.sized <| fun size -> Gen.choose (1, size |> float |> sqrt |> int) @@ -33,6 +23,30 @@ module Generators = Gen.choose (1, size |> float |> sqrt |> int) |> Gen.three + let genericSparseGenerator zero valuesGen handler = + let maxSparsity = 100 + let sparsityGen = Gen.choose (0, maxSparsity) + let genWithSparsity sparseValuesGenProvider = + gen { + let! sparsity = sparsityGen + + logger.debug ( + eventX "Sparcity is {sp} of {ms}" + >> setField "sp" sparsity + >> setField "ms" maxSparsity + ) + + return! sparseValuesGenProvider sparsity + } + + genWithSparsity <| fun sparsity -> + [ + (maxSparsity - sparsity, valuesGen) + (sparsity, Gen.constant zero) + ] + |> Gen.frequency + |> handler + // generate non-empty matrices let pairOfMatricesOfEqualSizeGenerator (valuesGenerator: Gen<'a>) = gen { @@ -43,6 +57,15 @@ module Generators = } |> Gen.filter (fun (matrixA, matrixB) -> matrixA.Length <> 0 && matrixB.Length <> 0) + let pairOfMatrixAndVectorOfEqualSizeGenerator (valuesGenerator: Gen<'a>) = + gen { + let! (nrows, ncols) = dimension2DGenerator + let! matrix = valuesGenerator |> Gen.array2DOfDim (nrows, ncols) + let! vector = valuesGenerator |> Gen.arrayOfLength ncols + return (matrix, vector) + } + |> Gen.filter (fun (matrix, vector) -> matrix.Length <> 0 && vector.Length <> 0) + module Utils = let rec cartesian listOfLists = match listOfLists with @@ -57,3 +80,23 @@ module Utils = FSharpType.GetUnionCases typeof<'a> |> Array.map (fun caseInfo -> FSharpValue.MakeUnion(caseInfo, [||]) :?> 'a) |> List.ofArray + + let avaliableContexts (platformRegex: string) = + let mutable e = ErrorCode.Unknown + Cl.GetPlatformIDs &e + |> Array.collect (fun platform -> Cl.GetDeviceIDs(platform, DeviceType.All, &e)) + |> Seq.ofArray + |> Seq.distinctBy (fun device -> Cl.GetDeviceInfo(device, DeviceInfo.Name, &e).ToString()) + |> Seq.filter + (fun device -> + let platform = Cl.GetDeviceInfo(device, DeviceInfo.Platform, &e).CastTo() + let platformName = Cl.GetPlatformInfo(platform, PlatformInfo.Name, &e).ToString() + (Regex platformRegex).IsMatch platformName + ) + |> Seq.map + (fun device -> + let platform = Cl.GetDeviceInfo(device, DeviceInfo.Platform, &e).CastTo() + let platformName = Cl.GetPlatformInfo(platform, PlatformInfo.Name, &e).ToString() + let deviceType = Cl.GetDeviceInfo(device, DeviceInfo.Type, &e).CastTo() + OpenCLEvaluationContext(platformName, deviceType) + ) diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index 2e0bb548..5adeb7a6 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -9,8 +9,9 @@ + - + \ No newline at end of file diff --git a/tests/GraphBLAS-sharp.Tests/OperationsTests/EWiseAddTests.fs b/tests/GraphBLAS-sharp.Tests/OperationsTests/EWiseAddTests.fs index 71f160a9..44a23115 100644 --- a/tests/GraphBLAS-sharp.Tests/OperationsTests/EWiseAddTests.fs +++ b/tests/GraphBLAS-sharp.Tests/OperationsTests/EWiseAddTests.fs @@ -3,123 +3,88 @@ module EWiseAdd open Expecto open FsCheck open GraphBLAS.FSharp -open MathNet.Numerics -open Brahma.FSharp.OpenCL.WorkflowBuilder.Basic open GraphBLAS.FSharp.Tests -open System open GraphBLAS.FSharp.Predefined open TypeShape.Core open Expecto.Logging open Expecto.Logging.Message -open BackendState +open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation +open OpenCL.Net -type OperationParameter = - | MatrixFormatParam of MatrixBackendFormat - | MaskTypeParam of MaskType +let logger = Log.create "EWiseAddTests" -type OperationCase = { - MatrixCase: MatrixBackendFormat - MaskCase: MaskType -} +type OperationCase = + { + ClContext: OpenCLEvaluationContext + MatrixCase: MatrixType + MaskCase: MaskType + } let testCases = [ - Utils.listOfUnionCases |> List.map MatrixFormatParam - Utils.listOfUnionCases |> List.map MaskTypeParam + Utils.avaliableContexts "" |> Seq.map box + Utils.listOfUnionCases |> Seq.map box + Utils.listOfUnionCases |> Seq.map box ] + |> List.map List.ofSeq |> Utils.cartesian - |> List.map - (fun list -> - let (MatrixFormatParam marixFormat) = list.[0] - let (MaskTypeParam maskType) = list.[1] - { - MatrixCase = marixFormat - MaskCase = maskType - } - ) - -type PairOfSparseMatricesOfEqualSize = + |> List.map ^fun list -> + { + ClContext = unbox list.[0] + MatrixCase = unbox list.[1] + MaskCase = unbox list.[2] + } + +type PairOfSparseMatricesOfEqualSize() = static member IntType() = - Generators.pairOfMatricesOfEqualSizeGenerator ( - Gen.oneof [ - Arb.generate - Gen.constant 0 - ] - ) |> Arb.fromGen + Generators.pairOfMatricesOfEqualSizeGenerator + |> Generators.genericSparseGenerator 0 Arb.generate + |> Arb.fromGen static member FloatType() = - Generators.pairOfMatricesOfEqualSizeGenerator ( - Gen.oneof [ - (Arb.Default.NormalFloat() |> Arb.toGen |> Gen.map float) - Gen.constant 0. - ] - ) |> Arb.fromGen + Generators.pairOfMatricesOfEqualSizeGenerator + |> Generators.genericSparseGenerator 0. (Arb.Default.NormalFloat() |> Arb.toGen |> Gen.map float) + |> Arb.fromGen static member SByteType() = - Generators.pairOfMatricesOfEqualSizeGenerator ( - Gen.oneof [ - Arb.generate - Gen.constant 0y - ] - ) |> Arb.fromGen + Generators.pairOfMatricesOfEqualSizeGenerator + |> Generators.genericSparseGenerator 0y Arb.generate + |> Arb.fromGen static member ByteType() = - Generators.pairOfMatricesOfEqualSizeGenerator ( - Gen.oneof [ - Arb.generate - Gen.constant 0uy - ] - ) |> Arb.fromGen + Generators.pairOfMatricesOfEqualSizeGenerator + |> Generators.genericSparseGenerator 0uy Arb.generate + |> Arb.fromGen static member Int16Type() = - Generators.pairOfMatricesOfEqualSizeGenerator ( - Gen.oneof [ - Arb.generate - Gen.constant 0s - ] - ) |> Arb.fromGen + Generators.pairOfMatricesOfEqualSizeGenerator + |> Generators.genericSparseGenerator 0s Arb.generate + |> Arb.fromGen static member UInt16Type() = - Generators.pairOfMatricesOfEqualSizeGenerator ( - Gen.oneof [ - Arb.generate - Gen.constant 0us - ] - ) |> Arb.fromGen + Generators.pairOfMatricesOfEqualSizeGenerator + |> Generators.genericSparseGenerator 0us Arb.generate + |> Arb.fromGen static member BoolType() = - Generators.pairOfMatricesOfEqualSizeGenerator ( - Gen.oneof [ - Arb.generate - Gen.constant false - ] - ) |> Arb.fromGen - -let createMatrix<'a when 'a : struct and 'a : equality> matrixFormat args = - match matrixFormat with - | CSR -> - Activator.CreateInstanceGeneric>( - Array.singleton typeof<'a>, args - ) - |> unbox> - :> Matrix<'a> - | COO -> - Activator.CreateInstanceGeneric>( - Array.singleton typeof<'a>, args - ) - |> unbox> - :> Matrix<'a> - -let logger = Log.create "Sample" + Generators.pairOfMatricesOfEqualSizeGenerator + |> Generators.genericSparseGenerator false Arb.generate + |> Arb.fromGen -let checkCorrectnessGeneric<'a when 'a : struct and 'a : equality> +let checkCorrectnessGeneric<'a when 'a : struct> + (oclContext: OpenCLEvaluationContext) (sum: 'a -> 'a -> 'a) (diff: 'a -> 'a -> 'a) (isZero: 'a -> bool) - (semiring: Semiring<'a>) + (monoid: IMonoid<'a>) (case: OperationCase) (matrixA: 'a[,], matrixB: 'a[,]) = + let createMatrixFromArray2D matrixFormat array isZero = + match matrixFormat with + | CSR -> failwith "Not implemented" + | COO -> MatrixCOO <| COOMatrix.FromArray2D(array, isZero) + let eWiseAddNaive (matrixA: 'a[,]) (matrixB: 'a[,]) = let left = matrixA |> Seq.cast<'a> let right = matrixB |> Seq.cast<'a> @@ -147,8 +112,8 @@ let checkCorrectnessGeneric<'a when 'a : struct and 'a : equality> let eWiseAddGB (matrixA: 'a[,]) (matrixB: 'a[,]) = try - let left = createMatrix<'a> case.MatrixCase [|matrixA; isZero|] - let right = createMatrix<'a> case.MatrixCase [|matrixB; isZero|] + let left = createMatrixFromArray2D case.MatrixCase matrixA isZero + let right = createMatrixFromArray2D case.MatrixCase matrixB isZero logger.debug ( eventX "Left matrix is \n{matrix}" @@ -160,12 +125,14 @@ let checkCorrectnessGeneric<'a when 'a : struct and 'a : equality> >> setField "matrix" right ) - opencl { - let! result = left.EWiseAdd right None semiring - let! tuples = result.GetTuples() - return! tuples.ToHost() + graphblas { + let! result = Matrix.eWiseAdd monoid left right + let! tuples = Matrix.tuples result + do! MatrixTuples.synchronize tuples + return tuples } - |> oclContext.RunSync + |> EvalGB.withClContext oclContext + |> EvalGB.runSync finally oclContext.Provider.CloseAllBuffers() @@ -199,46 +166,68 @@ let checkCorrectnessGeneric<'a when 'a : struct and 'a : equality> "There should be no difference between expected and received values" |> Expect.all difference isZero -let config = { - FsCheckConfig.defaultConfig with +let config = + { FsCheckConfig.defaultConfig with arbitrary = [typeof] - startSize = 0 maxTest = 10 -} + startSize = 0 + // endSize = 1_000_000 + } // https://docs.microsoft.com/ru-ru/dotnet/csharp/language-reference/language-specification/types#value-types let testFixtures case = [ + let getTestName datatype = sprintf "Correctness on %s, %A, %A" datatype case.MatrixCase case.MaskCase + case - |> checkCorrectnessGeneric (+) (-) ((=) 0) AddMult.int - |> testPropertyWithConfig config (sprintf "Correctness on int, %A, %A" case.MatrixCase case.MaskCase) + |> checkCorrectnessGeneric case.ClContext (+) (-) ((=) 0) AddMult.int + |> testPropertyWithConfig config (getTestName "int") case - |> checkCorrectnessGeneric (+) (-) (fun x -> abs x < Accuracy.medium.absolute) AddMult.float - |> testPropertyWithConfig config (sprintf "Correctness on float, %A, %A" case.MatrixCase case.MaskCase) + |> checkCorrectnessGeneric case.ClContext (+) (-) (fun x -> abs x < Accuracy.medium.absolute) AddMult.float + |> testPropertyWithConfig config (getTestName "float") - // case - // |> checkCorrectnessGeneric (+) (-) ((=) 0y) AddMult.sbyte - // |> testPropertyWithConfig config (sprintf "Correctness on sbyte, %A, %A" case.MatrixCase case.MaskCase) + case + |> checkCorrectnessGeneric case.ClContext (+) (-) ((=) 0y) AddMult.sbyte + |> ptestPropertyWithConfig config (getTestName "sbyte") case - |> checkCorrectnessGeneric (+) (-) ((=) 0uy) AddMult.byte - |> testPropertyWithConfig config (sprintf "Correctness on byte, %A, %A" case.MatrixCase case.MaskCase) + |> checkCorrectnessGeneric case.ClContext (+) (-) ((=) 0uy) AddMult.byte + |> testPropertyWithConfig config (getTestName "byte") case - |> checkCorrectnessGeneric (+) (-) ((=) 0s) AddMult.int16 - |> testPropertyWithConfig config (sprintf "Correctness on int16, %A, %A" case.MatrixCase case.MaskCase) + |> checkCorrectnessGeneric case.ClContext (+) (-) ((=) 0s) AddMult.int16 + |> testPropertyWithConfig config (getTestName "int16") case - |> checkCorrectnessGeneric (+) (-) ((=) 0us) AddMult.uint16 - |> testPropertyWithConfig config (sprintf "Correctness on uint16, %A, %A" case.MatrixCase case.MaskCase) + |> checkCorrectnessGeneric case.ClContext (+) (-) ((=) 0us) AddMult.uint16 + |> testPropertyWithConfig config (getTestName "uint16") case - |> checkCorrectnessGeneric (||) (<>) not AnyAll.bool - |> testPropertyWithConfig config (sprintf "Correctness on bool, %A, %A" case.MatrixCase case.MaskCase) + |> checkCorrectnessGeneric case.ClContext (||) (<>) not AnyAll.bool + |> testPropertyWithConfig config (getTestName "bool") + + case + |> checkCorrectnessGeneric case.ClContext (||) (<>) not AnyAll.bool + |> testPropertyWithConfigStdGen + (355610228, 296870493) + { FsCheckConfig.defaultConfig with + arbitrary = [typeof] + maxTest = 10 + startSize = 0 + } + "Correctness on both empty matrices" ] let tests = testCases |> List.filter (fun case -> case.MatrixCase = COO && case.MaskCase = NoMask) + |> List.filter + (fun case -> + let mutable e = ErrorCode.Unknown + let device = case.ClContext.Device + // let platform = Cl.GetDeviceInfo(device, DeviceInfo.Platform, &e).CastTo() + let deviceType = Cl.GetDeviceInfo(device, DeviceInfo.Type, &e).CastTo() + deviceType = DeviceType.Cpu + ) |> List.collect testFixtures |> testList "EWiseAdd tests" diff --git a/tests/GraphBLAS-sharp.Tests/OperationsTests/MxvTests.fs b/tests/GraphBLAS-sharp.Tests/OperationsTests/MxvTests.fs new file mode 100644 index 00000000..64713f6f --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/OperationsTests/MxvTests.fs @@ -0,0 +1,75 @@ +module Mxv + +open Expecto +open FsCheck +open GraphBLAS.FSharp +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Predefined +open TypeShape.Core +open Expecto.Logging +open Expecto.Logging.Message +open Brahma.FSharp.OpenCL.WorkflowBuilder.Evaluation +open OpenCL.Net + +let logger = Log.create "MxvTests" + +type OperationCase = + { + ClContext: OpenCLEvaluationContext + MatrixCase: MatrixType + VectorCase: VectorType + MaskCase: MaskType + } + +let testCases = + [ + Utils.avaliableContexts "" |> Seq.map box + Utils.listOfUnionCases |> Seq.map box + Utils.listOfUnionCases |> Seq.map box + Utils.listOfUnionCases |> Seq.map box + ] + |> List.map List.ofSeq + |> Utils.cartesian + |> List.map ^fun list -> + { + ClContext = unbox list.[0] + MatrixCase = unbox list.[1] + VectorCase = unbox list.[2] + MaskCase = unbox list.[3] + } + +type PairOfSparseMatrixAndVectorOfEqualSize() = + static member IntType() = + Generators.pairOfMatrixAndVectorOfEqualSizeGenerator + |> Generators.genericSparseGenerator 0 Arb.generate + |> Arb.fromGen + + static member FloatType() = + Generators.pairOfMatrixAndVectorOfEqualSizeGenerator + |> Generators.genericSparseGenerator 0. (Arb.Default.NormalFloat() |> Arb.toGen |> Gen.map float) + |> Arb.fromGen + + static member SByteType() = + Generators.pairOfMatrixAndVectorOfEqualSizeGenerator + |> Generators.genericSparseGenerator 0y Arb.generate + |> Arb.fromGen + + static member ByteType() = + Generators.pairOfMatrixAndVectorOfEqualSizeGenerator + |> Generators.genericSparseGenerator 0uy Arb.generate + |> Arb.fromGen + + static member Int16Type() = + Generators.pairOfMatrixAndVectorOfEqualSizeGenerator + |> Generators.genericSparseGenerator 0s Arb.generate + |> Arb.fromGen + + static member UInt16Type() = + Generators.pairOfMatrixAndVectorOfEqualSizeGenerator + |> Generators.genericSparseGenerator 0us Arb.generate + |> Arb.fromGen + + static member BoolType() = + Generators.pairOfMatrixAndVectorOfEqualSizeGenerator + |> Generators.genericSparseGenerator false Arb.generate + |> Arb.fromGen diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index cf61719f..e59a05ac 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -8,7 +8,6 @@ let allTests = ] |> testSequenced -// sequenced test? [] let main argv = allTests