diff --git a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj index c40576ad..2cb9c61c 100644 --- a/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj +++ b/src/GraphBLAS-sharp.Backend/GraphBLAS-sharp.Backend.fsproj @@ -38,9 +38,12 @@ + + + diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs new file mode 100644 index 00000000..cc7c2f72 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map.fs @@ -0,0 +1,116 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.COO + +open System +open Brahma.FSharp +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Quotes +open Microsoft.FSharp.Quotations +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Objects.ClMatrix +open GraphBLAS.FSharp.Backend.Objects.ClContext + +module internal Map = + let preparePositions<'a, 'b> (clContext: ClContext) workGroupSize opAdd = + + let preparePositions (op: Expr<'a option -> 'b option>) = + <@ fun (ndRange: Range1D) rowCount columnCount valuesLength (values: ClArray<'a>) (rows: ClArray) (columns: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'b>) (resultRows: ClArray) (resultColumns: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < rowCount * columnCount then + + let columnIndex = gid % columnCount + let rowIndex = gid / columnCount + + let index = + (uint64 rowIndex <<< 32) ||| (uint64 columnIndex) + + let value = + (%Search.Bin.byKey2D) valuesLength index rows columns values + + match (%op) value with + | Some resultValue -> + resultValues.[gid] <- resultValue + resultRows.[gid] <- rowIndex + resultColumns.[gid] <- columnIndex + + resultBitmap.[gid] <- 1 + | None -> resultBitmap.[gid] <- 0 @> + + let kernel = + clContext.Compile <| preparePositions opAdd + + fun (processor: MailboxProcessor<_>) rowCount columnCount (values: ClArray<'a>) (rowPointers: ClArray) (columns: ClArray) -> + + let (resultLength: int) = columnCount * rowCount + + let resultBitmap = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let resultRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let resultColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'b>(DeviceOnly, resultLength) + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + rowCount + columnCount + values.Length + values + rowPointers + columns + resultBitmap + resultValues + resultRows + resultColumns) + ) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + resultBitmap, resultValues, resultRows, resultColumns + + let run<'a, 'b when 'a: struct and 'b: struct and 'b: equality> + (clContext: ClContext) + (opAdd: Expr<'a option -> 'b option>) + workGroupSize + = + + let map = + preparePositions clContext workGroupSize opAdd + + let setPositions = + Common.setPositions<'b> clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.COO<'a>) -> + + let bitmap, values, rows, columns = + map queue matrix.RowCount matrix.ColumnCount matrix.Values matrix.Rows matrix.Columns + + let resultRows, resultColumns, resultValues, _ = + setPositions queue allocationMode rows columns values bitmap + + queue.Post(Msg.CreateFreeMsg<_>(bitmap)) + queue.Post(Msg.CreateFreeMsg<_>(values)) + queue.Post(Msg.CreateFreeMsg<_>(rows)) + queue.Post(Msg.CreateFreeMsg<_>(columns)) + + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + Rows = resultRows + Columns = resultColumns + Values = resultValues } diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs index 567bc993..ee0f1b4f 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Map2.fs @@ -5,6 +5,7 @@ open GraphBLAS.FSharp.Backend.Matrix open Microsoft.FSharp.Quotations open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Quotes open GraphBLAS.FSharp.Backend.Objects.ClMatrix open GraphBLAS.FSharp.Backend.Objects.ClContext open GraphBLAS.FSharp.Backend.Quotes diff --git a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs index b7714251..d4ef9174 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/COOMatrix/Matrix.fs @@ -8,6 +8,8 @@ open GraphBLAS.FSharp.Backend.Objects open GraphBLAS.FSharp.Backend.Objects.ClMatrix module Matrix = + let map = Map.run + let map2 = Map2.run ///. diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs new file mode 100644 index 00000000..67e73b93 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map.fs @@ -0,0 +1,129 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.CSR + +open Brahma.FSharp +open FSharp.Quotations +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Matrix.COO +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClMatrix +open GraphBLAS.FSharp.Backend.Objects.ClContext + +module internal Map = + let preparePositions<'a, 'b> (clContext: ClContext) workGroupSize op = + + let preparePositions (op: Expr<'a option -> 'b option>) = + <@ fun (ndRange: Range1D) rowCount columnCount (values: ClArray<'a>) (rowPointers: ClArray) (columns: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'b>) (resultRows: ClArray) (resultColumns: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < rowCount * columnCount then + + let columnIndex = gid % columnCount + let rowIndex = gid / columnCount + + let startIndex = rowPointers.[rowIndex] + let lastIndex = rowPointers.[rowIndex + 1] - 1 + + let value = + (%Search.Bin.inRange) startIndex lastIndex columnIndex columns values + + match (%op) value with + | Some resultValue -> + resultValues.[gid] <- resultValue + resultRows.[gid] <- rowIndex + resultColumns.[gid] <- columnIndex + + resultBitmap.[gid] <- 1 + | None -> resultBitmap.[gid] <- 0 @> + + let kernel = clContext.Compile <| preparePositions op + + fun (processor: MailboxProcessor<_>) rowCount columnCount (values: ClArray<'a>) (rowPointers: ClArray) (columns: ClArray) -> + + let (resultLength: int) = columnCount * rowCount + + let resultBitmap = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let resultRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let resultColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'b>(DeviceOnly, resultLength) + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + rowCount + columnCount + values + rowPointers + columns + resultBitmap + resultValues + resultRows + resultColumns) + ) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + resultBitmap, resultValues, resultRows, resultColumns + + let runToCOO<'a, 'b when 'a: struct and 'b: struct and 'b: equality> + (clContext: ClContext) + (opAdd: Expr<'a option -> 'b option>) + workGroupSize + = + + let map = + preparePositions clContext workGroupSize opAdd + + let setPositions = + Common.setPositions<'b> clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + + let bitmap, values, rows, columns = + map queue matrix.RowCount matrix.ColumnCount matrix.Values matrix.RowPointers matrix.Columns + + let resultRows, resultColumns, resultValues, _ = + setPositions queue allocationMode rows columns values bitmap + + queue.Post(Msg.CreateFreeMsg<_>(bitmap)) + queue.Post(Msg.CreateFreeMsg<_>(values)) + queue.Post(Msg.CreateFreeMsg<_>(rows)) + queue.Post(Msg.CreateFreeMsg<_>(columns)) + + { Context = clContext + RowCount = matrix.RowCount + ColumnCount = matrix.ColumnCount + Rows = resultRows + Columns = resultColumns + Values = resultValues } + + let run<'a, 'b when 'a: struct and 'b: struct and 'b: equality> + (clContext: ClContext) + (opAdd: Expr<'a option -> 'b option>) + workGroupSize + = + + let mapToCOO = runToCOO clContext opAdd workGroupSize + + let toCSRInplace = + Matrix.toCSRInplace clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrix: ClMatrix.CSR<'a>) -> + mapToCOO queue allocationMode matrix + |> toCSRInplace queue allocationMode diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs new file mode 100644 index 00000000..b189da13 --- /dev/null +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Map2.fs @@ -0,0 +1,151 @@ +namespace GraphBLAS.FSharp.Backend.Matrix.CSR + +open Brahma.FSharp +open Microsoft.FSharp.Quotations +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClMatrix +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Backend.Matrix.COO + +module internal Map2 = + let preparePositions<'a, 'b, 'c> (clContext: ClContext) workGroupSize opAdd = + + let preparePositions (op: Expr<'a option -> 'b option -> 'c option>) = + <@ fun (ndRange: Range1D) rowCount columnCount (leftValues: ClArray<'a>) (leftRowPointers: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRowPointers: ClArray) (rightColumn: ClArray) (resultBitmap: ClArray) (resultValues: ClArray<'c>) (resultRows: ClArray) (resultColumns: ClArray) -> + + let gid = ndRange.GlobalID0 + + if gid < rowCount * columnCount then + + let columnIndex = gid % columnCount + let rowIndex = gid / columnCount + + let leftStartIndex = leftRowPointers.[rowIndex] + let leftLastIndex = leftRowPointers.[rowIndex + 1] - 1 + + let rightStartIndex = rightRowPointers.[rowIndex] + let rightLastIndex = rightRowPointers.[rowIndex + 1] - 1 + + let leftValue = + (%Search.Bin.inRange) leftStartIndex leftLastIndex columnIndex leftColumns leftValues + + let rightValue = + (%Search.Bin.inRange) rightStartIndex rightLastIndex columnIndex rightColumn rightValues + + match (%op) leftValue rightValue with + | Some value -> + resultValues.[gid] <- value + resultRows.[gid] <- rowIndex + resultColumns.[gid] <- columnIndex + + resultBitmap.[gid] <- 1 + | None -> resultBitmap.[gid] <- 0 @> + + let kernel = + clContext.Compile <| preparePositions opAdd + + fun (processor: MailboxProcessor<_>) rowCount columnCount (leftValues: ClArray<'a>) (leftRows: ClArray) (leftColumns: ClArray) (rightValues: ClArray<'b>) (rightRows: ClArray) (rightColumns: ClArray) -> + + let (resultLength: int) = columnCount * rowCount + + let resultBitmap = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let resultRows = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let resultColumns = + clContext.CreateClArrayWithSpecificAllocationMode(DeviceOnly, resultLength) + + let resultValues = + clContext.CreateClArrayWithSpecificAllocationMode<'c>(DeviceOnly, resultLength) + + let ndRange = + Range1D.CreateValid(resultLength, workGroupSize) + + let kernel = kernel.GetKernel() + + processor.Post( + Msg.MsgSetArguments + (fun () -> + kernel.KernelFunc + ndRange + rowCount + columnCount + leftValues + leftRows + leftColumns + rightValues + rightRows + rightColumns + resultBitmap + resultValues + resultRows + resultColumns) + ) + + processor.Post(Msg.CreateRunMsg<_, _> kernel) + + resultBitmap, resultValues, resultRows, resultColumns + + ///. + ///. + ///Should be a power of 2 and greater than 1. + let runToCOO<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + (clContext: ClContext) + (opAdd: Expr<'a option -> 'b option -> 'c option>) + workGroupSize + = + + let map2 = + preparePositions clContext workGroupSize opAdd + + let setPositions = + Common.setPositions<'c> clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> + + let bitmap, values, rows, columns = + map2 + queue + matrixLeft.RowCount + matrixLeft.ColumnCount + matrixLeft.Values + matrixLeft.RowPointers + matrixLeft.Columns + matrixRight.Values + matrixRight.RowPointers + matrixRight.Columns + + let resultRows, resultColumns, resultValues, _ = + setPositions queue allocationMode rows columns values bitmap + + queue.Post(Msg.CreateFreeMsg<_>(bitmap)) + queue.Post(Msg.CreateFreeMsg<_>(values)) + queue.Post(Msg.CreateFreeMsg<_>(rows)) + queue.Post(Msg.CreateFreeMsg<_>(columns)) + + { Context = clContext + RowCount = matrixLeft.RowCount + ColumnCount = matrixLeft.ColumnCount + Rows = resultRows + Columns = resultColumns + Values = resultValues } + + let run<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> + (clContext: ClContext) + (opAdd: Expr<'a option -> 'b option -> 'c option>) + workGroupSize + = + + let map2ToCOO = runToCOO clContext opAdd workGroupSize + + let toCSRInplace = + Matrix.toCSRInplace clContext workGroupSize + + fun (queue: MailboxProcessor<_>) allocationMode (matrixLeft: ClMatrix.CSR<'a>) (matrixRight: ClMatrix.CSR<'b>) -> + map2ToCOO queue allocationMode matrixLeft matrixRight + |> toCSRInplace queue allocationMode diff --git a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs index c639135b..d9c96445 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/CSRMatrix/Matrix.fs @@ -90,31 +90,9 @@ module Matrix = Columns = matrix.Columns Values = matrix.Values } - let map2<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> - (clContext: ClContext) - (opAdd: Expr<'a option -> 'b option -> 'c option>) - workGroupSize - = - - let firstToCOO = toCOO clContext workGroupSize - - let secondToCOO = toCOO clContext workGroupSize - - let COOMap2 = - COO.Matrix.map2 clContext opAdd workGroupSize - - let toCSR = - COO.Matrix.toCSRInplace clContext workGroupSize - - fun (processor: MailboxProcessor<_>) allocationMode (leftMatrix: ClMatrix.CSR<'a>) (rightMatrix: ClMatrix.CSR<'b>) -> - let leftCOOMatrix = - firstToCOO processor DeviceOnly leftMatrix - - let rightCOOMatrix = - secondToCOO processor DeviceOnly rightMatrix + let map = CSR.Map.run - COOMap2 processor DeviceOnly leftCOOMatrix rightCOOMatrix - |> toCSR processor allocationMode + let map2 = Map2.run let map2AtLeastOneToCOO<'a, 'b, 'c when 'a: struct and 'b: struct and 'c: struct and 'c: equality> (clContext: ClContext) diff --git a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs index 5adc3cd1..3fac746a 100644 --- a/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs +++ b/src/GraphBLAS-sharp.Backend/Matrix/Matrix.fs @@ -191,6 +191,21 @@ module Matrix = .ToCSC |> ClMatrix.CSC + let map (clContext: ClContext) (opAdd: Expr<'a option -> 'b option>) workGroupSize = + let mapCOO = + COO.Matrix.map clContext opAdd workGroupSize + + let mapCSR = + CSR.Matrix.map clContext opAdd workGroupSize + + fun (processor: MailboxProcessor<_>) allocationMode matrix -> + match matrix with + | ClMatrix.COO m -> mapCOO processor allocationMode m |> ClMatrix.COO + | ClMatrix.CSR m -> mapCSR processor allocationMode m |> ClMatrix.CSR + | ClMatrix.CSC m -> + (mapCSR processor allocationMode m.ToCSR).ToCSC + |> ClMatrix.CSC + let map2 (clContext: ClContext) (opAdd: Expr<'a option -> 'b option -> 'c option>) workGroupSize = // TODO() let map2COO = COO.Matrix.map2 clContext opAdd workGroupSize diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs index 1432510f..8aa72db5 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Arithmetic.fs @@ -3,6 +3,16 @@ open GraphBLAS.FSharp.Backend.Objects module ArithmeticOperations = + let inline mkUnaryOp zero unaryOp = + <@ fun x -> + let mutable res = zero + + match x with + | Some v -> res <- (%unaryOp) v + | None -> res <- (%unaryOp) zero + + if res = zero then None else Some res @> + let inline mkNumericSum zero = <@ fun (x: 't option) (y: 't option) -> let mutable res = zero @@ -56,6 +66,12 @@ module ArithmeticOperations = if res then Some true else None @> + let inline addLeftConst zero constant = + mkUnaryOp zero <@ fun x -> constant + x @> + + let inline addRightConst zero constant = + mkUnaryOp zero <@ fun x -> x + constant @> + let intSum = mkNumericSum 0 let byteSum = mkNumericSum 0uy let floatSum = mkNumericSum 0.0 @@ -79,6 +95,12 @@ module ArithmeticOperations = if res then Some true else None @> + let inline mulLeftConst zero constant = + mkUnaryOp zero <@ fun x -> constant * x @> + + let inline mulRightConst zero constant = + mkUnaryOp zero <@ fun x -> x * constant @> + let intMul = mkNumericMul 0 let byteMul = mkNumericMul 0uy let floatMul = mkNumericMul 0.0 @@ -98,3 +120,9 @@ module ArithmeticOperations = let byteMulAtLeastOne = mkNumericMulAtLeastOne 0uy let floatMulAtLeastOne = mkNumericMulAtLeastOne 0.0 let float32MulAtLeastOne = mkNumericMulAtLeastOne 0f + + let notQ = + <@ fun x -> + match x with + | Some true -> None + | _ -> Some true @> diff --git a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs index a61d4fd1..5d958986 100644 --- a/src/GraphBLAS-sharp.Backend/Quotes/Search.fs +++ b/src/GraphBLAS-sharp.Backend/Quotes/Search.fs @@ -4,6 +4,39 @@ open Brahma.FSharp module Search = module Bin = + /// + /// Searches a section of the array of indices, bounded by the given left and right edges, for an index, using a binary search algorithm. + /// In case searched section contains source index, the value at the same position in the array of values is returned. + /// + /// + /// Searched section of index array should be sorted in ascending order. + /// The index array should have the same length as the array of values. + /// left edge and right edge should be less than the length of the index array. + /// + let inRange<'a> = + <@ fun leftEdge rightEdge sourceIndex (indices: ClArray) (values: ClArray<'a>) -> + + let mutable leftEdge = leftEdge + let mutable rightEdge = rightEdge + + let mutable result = None + + while leftEdge <= rightEdge do + let middleIdx = (leftEdge + rightEdge) / 2 + + let currentColumn = indices.[middleIdx] + + if sourceIndex = currentColumn then + result <- Some values.[middleIdx] + + rightEdge <- -1 // TODO() break + elif sourceIndex < currentColumn then + rightEdge <- middleIdx - 1 + else + leftEdge <- middleIdx + 1 + + result @> + /// /// Searches value in array by key. /// In case there is a value at the given key position, it is returned. diff --git a/tests/GraphBLAS-sharp.Tests/Generators.fs b/tests/GraphBLAS-sharp.Tests/Generators.fs index 2183d0b9..4182b57a 100644 --- a/tests/GraphBLAS-sharp.Tests/Generators.fs +++ b/tests/GraphBLAS-sharp.Tests/Generators.fs @@ -47,12 +47,15 @@ module Generators = let rec normalFloat32Generator (random: System.Random) = gen { - let result = random.NextSingle() + let rawValue = random.NextSingle() - if System.Single.IsNormal result then - return result + if System.Single.IsNormal rawValue then + let sign = float32 <| sign rawValue + let processedValue = ((+) 1.0f) <| (abs <| rawValue) + + return processedValue * sign else - return! normalFloat32Generator random + return 0.0f } let genericSparseGenerator zero valuesGen handler = diff --git a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj index e36c1ceb..8687885a 100644 --- a/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj +++ b/tests/GraphBLAS-sharp.Tests/GraphBLAS-sharp.Tests.fsproj @@ -46,6 +46,7 @@ + diff --git a/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs new file mode 100644 index 00000000..229271b7 --- /dev/null +++ b/tests/GraphBLAS-sharp.Tests/Matrix/Map.fs @@ -0,0 +1,148 @@ +module GraphBLAS.FSharp.Tests.Backend.Matrix.Map + +open Expecto +open Expecto.Logging +open Expecto.Logging.Message +open Microsoft.FSharp.Collections +open GraphBLAS.FSharp.Backend +open GraphBLAS.FSharp.Backend.Quotes +open GraphBLAS.FSharp.Backend.Matrix +open GraphBLAS.FSharp.Backend.Objects +open GraphBLAS.FSharp.Backend.Objects.ClContext +open GraphBLAS.FSharp.Tests +open GraphBLAS.FSharp.Tests.Backend +open GraphBLAS.FSharp.Tests.TestCases +open GraphBLAS.FSharp.Objects +open GraphBLAS.FSharp.Objects.MatrixExtensions + +let logger = Log.create "Map.Tests" + +let config = Utils.defaultConfig +let wgSize = Utils.defaultWorkGroupSize + +let getCorrectnessTestName case datatype = + $"Correctness on %s{datatype}, %A{case}" + +let checkResult isEqual op zero (baseMtx: 'a [,]) (actual: Matrix<'a>) = + let rows = Array2D.length1 baseMtx + let columns = Array2D.length2 baseMtx + Expect.equal columns actual.ColumnCount "The number of columns should be the same." + Expect.equal rows actual.RowCount "The number of rows should be the same." + + let expected2D = Array2D.create rows columns zero + + for i in 0 .. rows - 1 do + for j in 0 .. columns - 1 do + expected2D.[i, j] <- op baseMtx.[i, j] + + let actual2D = Array2D.create rows columns zero + + match actual with + | Matrix.COO actual -> + for i in 0 .. actual.Columns.Length - 1 do + if isEqual zero actual.Values.[i] then + failwith "Resulting zeroes should be filtered." + + actual2D.[actual.Rows.[i], actual.Columns.[i]] <- actual.Values.[i] + | _ -> failwith "Resulting matrix should be converted to COO format." + + "Arrays must be the same" + |> Utils.compare2DArrays isEqual actual2D expected2D + +let correctnessGenericTest + zero + op + (addFun: MailboxProcessor<_> -> AllocationFlag -> ClMatrix<'a> -> ClMatrix<'b>) + toCOOFun + (isEqual: 'a -> 'a -> bool) + q + (case: OperationCase) + (matrix: 'a [,]) + = + + let mtx = + Utils.createMatrixFromArray2D case.Format matrix (isEqual zero) + + if mtx.NNZ > 0 then + try + let m = mtx.ToDevice case.TestContext.ClContext + + let res = addFun q HostInterop m + + m.Dispose q + + let (cooRes: ClMatrix<'a>) = toCOOFun q HostInterop res + let actual = cooRes.ToHost q + + cooRes.Dispose q + res.Dispose q + + logger.debug ( + eventX "Actual is {actual}" + >> setField "actual" (sprintf "%A" actual) + ) + + checkResult isEqual op zero matrix actual + with + | ex when ex.Message = "InvalidBufferSize" -> () + | ex -> raise ex + +let createTestMap case (zero: 'a) (constant: 'a) binOp isEqual opQ = + let getCorrectnessTestName = getCorrectnessTestName case + + let context = case.TestContext.ClContext + let q = case.TestContext.Queue + + let unaryOp = binOp constant + let unaryOpQ = opQ zero constant + + let map = Matrix.map context unaryOpQ wgSize + + let toCOO = Matrix.toCOO context wgSize + + case + |> correctnessGenericTest zero unaryOp map toCOO isEqual q + |> testPropertyWithConfig config (getCorrectnessTestName $"{typeof<'a>}") + +let testFixturesMapNot case = + [ let q = case.TestContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) + + createTestMap case false true (fun _ -> not) (=) (fun _ _ -> ArithmeticOperations.notQ) ] + +let notTests = + operationGPUTests "Backend.Matrix.map not tests" testFixturesMapNot + +let testFixturesMapAdd case = + [ let context = case.TestContext.ClContext + let q = case.TestContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) + + createTestMap case 0 10 (+) (=) ArithmeticOperations.addLeftConst + + if Utils.isFloat64Available context.ClDevice then + createTestMap case 0.0 10.0 (+) Utils.floatIsEqual ArithmeticOperations.addLeftConst + + createTestMap case 0.0f 10.0f (+) Utils.float32IsEqual ArithmeticOperations.addLeftConst + + createTestMap case 0uy 10uy (+) (=) ArithmeticOperations.addLeftConst ] + +let addTests = + operationGPUTests "Backend.Matrix.map add tests" testFixturesMapAdd + +let testFixturesMapMul case = + [ let context = case.TestContext.ClContext + let q = case.TestContext.Queue + q.Error.Add(fun e -> failwithf "%A" e) + + createTestMap case 0 10 (*) (=) ArithmeticOperations.mulLeftConst + + if Utils.isFloat64Available context.ClDevice then + createTestMap case 0.0 10.0 (*) Utils.floatIsEqual ArithmeticOperations.mulLeftConst + + createTestMap case 0.0f 10.0f (*) Utils.float32IsEqual ArithmeticOperations.mulLeftConst + + createTestMap case 0uy 10uy (*) (=) ArithmeticOperations.mulLeftConst ] + +let mulTests = + operationGPUTests "Backend.Matrix.map mul tests" testFixturesMapMul diff --git a/tests/GraphBLAS-sharp.Tests/Program.fs b/tests/GraphBLAS-sharp.Tests/Program.fs index 11b8ee87..85671f2d 100644 --- a/tests/GraphBLAS-sharp.Tests/Program.fs +++ b/tests/GraphBLAS-sharp.Tests/Program.fs @@ -9,6 +9,9 @@ let matrixTests = Matrix.Map2.addAtLeastOneTests Matrix.Map2.mulAtLeastOneTests Matrix.Map2.addAtLeastOneToCOOTests + Matrix.Map.notTests + Matrix.Map.addTests + Matrix.Map.mulTests Matrix.Mxm.tests Matrix.Transpose.tests ] |> testSequenced